{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE NumericUnderscores #-}
module Convex.MockChain.Defaults(
  eraHistory,
  epochSize,
  slotLength,
  protocolParameters,
  bundledProtocolParameters,
  ledgerProtocolParameters,
  networkId,
  systemStart,
  globals,
  genesisDefaultsFromParams,
  pParams,
  protVer,
  nodeParams
) where

import qualified Cardano.Api                          as C
import           Cardano.Api.Shelley                  (AnyPlutusScriptVersion (..),
                                                       CardanoMode,
                                                       ConsensusMode (..),
                                                       EpochNo (..),
                                                       EraHistory (EraHistory),
                                                       ExecutionUnitPrices (..),
                                                       ExecutionUnits (..),
                                                       Lovelace (..),
                                                       NetworkId (..),
                                                       NetworkMagic (..),
                                                       PlutusScriptVersion (..),
                                                       ProtocolParameters (..),
                                                       ShelleyBasedEra (..),
                                                       shelleyGenesisDefaults,
                                                       toLedgerPParams)
import           Cardano.Ledger.Alonzo.PParams        (DowngradeAlonzoPParams (..))
import           Cardano.Ledger.Babbage               (Babbage)
import           Cardano.Ledger.Babbage.Core          (CoinPerByte (..),
                                                       CoinPerWord (..))
import           Cardano.Ledger.Babbage.PParams       (DowngradeBabbagePParams (..),
                                                       coinsPerUTxOWordToCoinsPerUTxOByte)
import           Cardano.Ledger.BaseTypes             (ProtVer, boundRational)
import qualified Cardano.Ledger.Binary.Version        as Version
import           Cardano.Ledger.Core                  (PParams,
                                                       downgradePParams)
import           Cardano.Ledger.Crypto                (StandardCrypto)
import           Cardano.Ledger.Shelley.API           (Coin (..), Globals,
                                                       ShelleyGenesis (..),
                                                       mkShelleyGlobals)
import qualified Cardano.Ledger.Shelley.API           as C.Ledger
import           Cardano.Ledger.Slot                  (EpochSize (..))
import           Cardano.Slotting.EpochInfo           (fixedEpochInfo)
import           Cardano.Slotting.Time                (SlotLength,
                                                       SystemStart (..),
                                                       mkSlotLength)
import           Convex.NodeParams                    (NodeParams (..))
import           Data.Map                             (fromList)
import           Data.Maybe                           (fromMaybe)
import           Data.Ratio                           ((%))
import           Data.SOP.Counting                    (Exactly (..),
                                                       nonEmptyHead)
import           Data.SOP.Strict                      (K (K), NP (..))
import           Data.Time.Calendar                   (fromGregorian)
import           Data.Time.Clock                      (UTCTime (..))
import qualified Ouroboros.Consensus.HardFork.History as Ouroboros
import           Ouroboros.Consensus.Shelley.Eras     (StandardBabbage)

networkId :: NetworkId
networkId :: NetworkId
networkId = NetworkMagic -> NetworkId
Testnet (Word32 -> NetworkMagic
NetworkMagic Word32
0)

startTime :: UTCTime
startTime :: UTCTime
startTime = Day -> DiffTime -> UTCTime
UTCTime (Integer -> MonthOfYear -> MonthOfYear -> Day
fromGregorian Integer
2022 MonthOfYear
01 MonthOfYear
01) DiffTime
0

systemStart :: SystemStart
systemStart :: SystemStart
systemStart = UTCTime -> SystemStart
SystemStart UTCTime
startTime

-- Defaults are from plutus-apps/plutus-ledger/Ledger.Params

eraHistory :: EraHistory CardanoMode
eraHistory :: EraHistory CardanoMode
eraHistory =
  forall mode (xs :: [*]).
(ConsensusBlockForMode mode ~ HardForkBlock xs) =>
ConsensusMode mode -> Interpreter xs -> EraHistory mode
EraHistory ConsensusMode CardanoMode
CardanoMode (forall (xs :: [*]). Summary xs -> Interpreter xs
Ouroboros.mkInterpreter forall a b. (a -> b) -> a -> b
$ forall x (xs :: [*]).
Exactly (x : xs) EraSummary -> Summary (x : xs)
Ouroboros.summaryWithExactly forall {x} {x} {x} {x} {x} {x} {x}.
Exactly '[x, x, x, x, x, x, x] EraSummary
list) -- $ Ouroboros.summaryWithExactly list)
    where
      one :: EraSummary
one = forall (xs :: [*]) a. NonEmpty xs a -> a
nonEmptyHead forall a b. (a -> b) -> a -> b
$ forall (xs :: [*]). Summary xs -> NonEmpty xs EraSummary
Ouroboros.getSummary forall a b. (a -> b) -> a -> b
$ forall x. EpochSize -> SlotLength -> Summary '[x]
Ouroboros.neverForksSummary EpochSize
epochSize SlotLength
slotLength
      list :: Exactly '[x, x, x, x, x, x, x] EraSummary
list = forall (xs :: [*]) a. NP (K a) xs -> Exactly xs a
Exactly forall a b. (a -> b) -> a -> b
$ forall k a (b :: k). a -> K a b
K EraSummary
one forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall k a (b :: k). a -> K a b
K EraSummary
one forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall k a (b :: k). a -> K a b
K EraSummary
one forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall k a (b :: k). a -> K a b
K EraSummary
one forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall k a (b :: k). a -> K a b
K EraSummary
one forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall k a (b :: k). a -> K a b
K EraSummary
one forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall k a (b :: k). a -> K a b
K EraSummary
one forall {k} (a :: k -> *) (x :: k) (xs :: [k]).
a x -> NP a xs -> NP a (x : xs)
:* forall {k} (a :: k -> *). NP a '[]
Nil

-- | A sensible default 'EpochSize' value for the emulator
epochSize :: EpochSize
epochSize :: EpochSize
epochSize = Word64 -> EpochSize
EpochSize Word64
432000

-- | Slot length of 1 second
slotLength :: SlotLength
slotLength :: SlotLength
slotLength = NominalDiffTime -> SlotLength
mkSlotLength NominalDiffTime
1 -- 1 second

protocolParameters :: ProtocolParameters
protocolParameters :: ProtocolParameters
protocolParameters =

  -- cost models from https://github.com/input-output-hk/cardano-node/blob/master/cardano-testnet/src/Testnet/Defaults.hs
  let defaultV1CostModel :: CostModel
defaultV1CostModel = [Integer] -> CostModel
C.CostModel
                            [ Integer
205665, Integer
812, Integer
1, Integer
1, Integer
1000, Integer
571, Integer
0, Integer
1, Integer
1000, Integer
24177, Integer
4, Integer
1, Integer
1000, Integer
32, Integer
117366, Integer
10475, Integer
4
                            , Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
100, Integer
100
                            , Integer
23000, Integer
100, Integer
19537, Integer
32, Integer
175354, Integer
32, Integer
46417, Integer
4, Integer
221973, Integer
511, Integer
0, Integer
1, Integer
89141, Integer
32, Integer
497525
                            , Integer
14068, Integer
4, Integer
2, Integer
196500, Integer
453240, Integer
220, Integer
0, Integer
1, Integer
1, Integer
1000, Integer
28662, Integer
4, Integer
2, Integer
245000, Integer
216773, Integer
62
                            , Integer
1, Integer
1060367, Integer
12586, Integer
1, Integer
208512, Integer
421, Integer
1, Integer
187000, Integer
1000, Integer
52998, Integer
1, Integer
80436, Integer
32, Integer
43249, Integer
32
                            , Integer
1000, Integer
32, Integer
80556, Integer
1, Integer
57667, Integer
4, Integer
1000, Integer
10, Integer
197145, Integer
156, Integer
1, Integer
197145, Integer
156, Integer
1, Integer
204924, Integer
473
                            , Integer
1, Integer
208896, Integer
511, Integer
1, Integer
52467, Integer
32, Integer
64832, Integer
32, Integer
65493, Integer
32, Integer
22558, Integer
32, Integer
16563, Integer
32, Integer
76511, Integer
32
                            , Integer
196500, Integer
453240, Integer
220, Integer
0, Integer
1, Integer
1, Integer
69522, Integer
11687, Integer
0, Integer
1, Integer
60091, Integer
32, Integer
196500, Integer
453240, Integer
220, Integer
0
                            , Integer
1, Integer
1, Integer
196500, Integer
453240, Integer
220, Integer
0, Integer
1, Integer
1, Integer
806990, Integer
30482, Integer
4, Integer
1927926, Integer
82523, Integer
4, Integer
265318, Integer
0
                            , Integer
4, Integer
0, Integer
85931, Integer
32, Integer
205665, Integer
812, Integer
1, Integer
1, Integer
41182, Integer
32, Integer
212342, Integer
32, Integer
31220, Integer
32, Integer
32696, Integer
32, Integer
43357
                            , Integer
32, Integer
32247, Integer
32, Integer
38314, Integer
32, Integer
57996947, Integer
18975, Integer
10
                            ]
      defaultV2CostModel :: CostModel
defaultV2CostModel = [Integer] -> CostModel
C.CostModel
                            [ Integer
205665, Integer
812, Integer
1, Integer
1, Integer
1000, Integer
571, Integer
0, Integer
1, Integer
1000, Integer
24177, Integer
4, Integer
1, Integer
1000, Integer
32, Integer
117366, Integer
10475, Integer
4
                            , Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
23000, Integer
100, Integer
100, Integer
100
                            , Integer
23000, Integer
100, Integer
19537, Integer
32, Integer
175354, Integer
32, Integer
46417, Integer
4, Integer
221973, Integer
511, Integer
0, Integer
1, Integer
89141, Integer
32, Integer
497525
                            , Integer
14068, Integer
4, Integer
2, Integer
196500, Integer
453240, Integer
220, Integer
0, Integer
1, Integer
1, Integer
1000, Integer
28662, Integer
4, Integer
2, Integer
245000, Integer
216773, Integer
62
                            , Integer
1, Integer
1060367, Integer
12586, Integer
1, Integer
208512, Integer
421, Integer
1, Integer
187000, Integer
1000, Integer
52998, Integer
1, Integer
80436, Integer
32, Integer
43249, Integer
32
                            , Integer
1000, Integer
32, Integer
80556, Integer
1, Integer
57667, Integer
4, Integer
1000, Integer
10, Integer
197145, Integer
156, Integer
1, Integer
197145, Integer
156, Integer
1, Integer
204924, Integer
473
                            , Integer
1, Integer
208896, Integer
511, Integer
1, Integer
52467, Integer
32, Integer
64832, Integer
32, Integer
65493, Integer
32, Integer
22558, Integer
32, Integer
16563, Integer
32, Integer
76511, Integer
32
                            , Integer
196500, Integer
453240, Integer
220, Integer
0, Integer
1, Integer
1, Integer
69522, Integer
11687, Integer
0, Integer
1, Integer
60091, Integer
32, Integer
196500, Integer
453240, Integer
220, Integer
0
                            , Integer
1, Integer
1, Integer
196500, Integer
453240, Integer
220, Integer
0, Integer
1, Integer
1, Integer
1159724, Integer
392670, Integer
0, Integer
2, Integer
806990, Integer
30482, Integer
4, Integer
1927926
                            , Integer
82523, Integer
4, Integer
265318, Integer
0, Integer
4, Integer
0, Integer
85931, Integer
32, Integer
205665, Integer
812, Integer
1, Integer
1, Integer
41182, Integer
32, Integer
212342, Integer
32, Integer
31220
                            , Integer
32, Integer
32696, Integer
32, Integer
43357, Integer
32, Integer
32247, Integer
32, Integer
38314, Integer
32, Integer
35892428, Integer
10, Integer
9462713, Integer
1021, Integer
10, Integer
38887044
                            , Integer
32947, Integer
10
                            ]

  in ProtocolParameters
      { protocolParamProtocolVersion :: (Natural, Natural)
protocolParamProtocolVersion = (Natural
7,Natural
0)
      , protocolParamDecentralization :: Maybe Rational
protocolParamDecentralization = forall a. a -> Maybe a
Just (Integer
3 forall a. Integral a => a -> a -> Ratio a
% Integer
5)
      , protocolParamExtraPraosEntropy :: Maybe PraosNonce
protocolParamExtraPraosEntropy = forall a. Maybe a
Nothing
      , protocolParamMaxBlockHeaderSize :: Natural
protocolParamMaxBlockHeaderSize = Natural
1_100
      , protocolParamMaxBlockBodySize :: Natural
protocolParamMaxBlockBodySize = Natural
65_536
      , protocolParamMaxTxSize :: Natural
protocolParamMaxTxSize = Natural
16_384
      , protocolParamTxFeeFixed :: Lovelace
protocolParamTxFeeFixed = Lovelace
155_381
      , protocolParamTxFeePerByte :: Lovelace
protocolParamTxFeePerByte = Lovelace
44
      , protocolParamMinUTxOValue :: Maybe Lovelace
protocolParamMinUTxOValue = forall a. a -> Maybe a
Just (Integer -> Lovelace
Lovelace Integer
1_500_000)
      , protocolParamStakeAddressDeposit :: Lovelace
protocolParamStakeAddressDeposit = Integer -> Lovelace
Lovelace Integer
2_000_000
      , protocolParamStakePoolDeposit :: Lovelace
protocolParamStakePoolDeposit = Integer -> Lovelace
Lovelace Integer
500_000_000
      , protocolParamMinPoolCost :: Lovelace
protocolParamMinPoolCost = Integer -> Lovelace
Lovelace Integer
340_000_000
      , protocolParamPoolRetireMaxEpoch :: EpochNo
protocolParamPoolRetireMaxEpoch = Word64 -> EpochNo
EpochNo Word64
18
      , protocolParamStakePoolTargetNum :: Natural
protocolParamStakePoolTargetNum = Natural
150
      , protocolParamPoolPledgeInfluence :: Rational
protocolParamPoolPledgeInfluence = Integer
3 forall a. Integral a => a -> a -> Ratio a
% Integer
10
      , protocolParamMonetaryExpansion :: Rational
protocolParamMonetaryExpansion = Integer
3 forall a. Integral a => a -> a -> Ratio a
% Integer
1_000
      , protocolParamTreasuryCut :: Rational
protocolParamTreasuryCut = Integer
1 forall a. Integral a => a -> a -> Ratio a
% Integer
5
      , protocolParamUTxOCostPerWord :: Maybe Lovelace
protocolParamUTxOCostPerWord = forall a. Maybe a
Nothing -- Obsolete from babbage onwards
      , protocolParamCostModels :: Map AnyPlutusScriptVersion CostModel
protocolParamCostModels = forall k a. Ord k => [(k, a)] -> Map k a
fromList
        [ (forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV1
PlutusScriptV1, CostModel
defaultV1CostModel)
        , (forall lang. PlutusScriptVersion lang -> AnyPlutusScriptVersion
AnyPlutusScriptVersion PlutusScriptVersion PlutusScriptV2
PlutusScriptV2, CostModel
defaultV2CostModel) ]
      , protocolParamPrices :: Maybe ExecutionUnitPrices
protocolParamPrices = forall a. a -> Maybe a
Just (ExecutionUnitPrices {priceExecutionSteps :: Rational
priceExecutionSteps = Integer
721 forall a. Integral a => a -> a -> Ratio a
% Integer
10_000_000, priceExecutionMemory :: Rational
priceExecutionMemory = Integer
577 forall a. Integral a => a -> a -> Ratio a
% Integer
10_000})
      , protocolParamMaxTxExUnits :: Maybe ExecutionUnits
protocolParamMaxTxExUnits = forall a. a -> Maybe a
Just (ExecutionUnits {executionSteps :: Natural
executionSteps = Natural
1_0000_000_000, executionMemory :: Natural
executionMemory = Natural
16_000_000})
      , protocolParamMaxBlockExUnits :: Maybe ExecutionUnits
protocolParamMaxBlockExUnits = forall a. a -> Maybe a
Just (ExecutionUnits {executionSteps :: Natural
executionSteps = Natural
4_0000_000_000, executionMemory :: Natural
executionMemory = Natural
80_000_000})
      , protocolParamMaxValueSize :: Maybe Natural
protocolParamMaxValueSize = forall a. a -> Maybe a
Just Natural
5_000
      , protocolParamCollateralPercent :: Maybe Natural
protocolParamCollateralPercent = forall a. a -> Maybe a
Just Natural
150
      , protocolParamMaxCollateralInputs :: Maybe Natural
protocolParamMaxCollateralInputs = forall a. a -> Maybe a
Just Natural
3
      , protocolParamUTxOCostPerByte :: Maybe Lovelace
protocolParamUTxOCostPerByte =
          let (CoinPerByte (Coin Integer
coinsPerUTxOByte)) = CoinPerWord -> CoinPerByte
coinsPerUTxOWordToCoinsPerUTxOByte forall a b. (a -> b) -> a -> b
$ Coin -> CoinPerWord
CoinPerWord forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
34_482
          in forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Integer -> Lovelace
Lovelace Integer
coinsPerUTxOByte
      }

ledgerProtocolParameters :: PParams StandardBabbage
ledgerProtocolParameters :: PParams (BabbageEra StandardCrypto)
ledgerProtocolParameters =
  forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Semigroup a => a -> a -> a
(<>) [Char]
"ledgerProtocolParameters: toLedgerPParams failed with " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall era.
ShelleyBasedEra era
-> ProtocolParameters
-> Either
     ProtocolParametersConversionError (PParams (ShelleyLedgerEra era))
toLedgerPParams ShelleyBasedEra BabbageEra
ShelleyBasedEraBabbage ProtocolParameters
protocolParameters

globals :: NodeParams -> Globals
globals :: NodeParams -> Globals
globals params :: NodeParams
params@NodeParams { BundledProtocolParameters BabbageEra
npProtocolParameters :: NodeParams -> BundledProtocolParameters BabbageEra
npProtocolParameters :: BundledProtocolParameters BabbageEra
npProtocolParameters, SlotLength
npSlotLength :: NodeParams -> SlotLength
npSlotLength :: SlotLength
npSlotLength } = forall c.
ShelleyGenesis c -> EpochInfo (Either Text) -> Version -> Globals
mkShelleyGlobals
  (NodeParams -> ShelleyGenesis StandardCrypto
genesisDefaultsFromParams NodeParams
params)
  (forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo EpochSize
epochSize SlotLength
npSlotLength)
  (forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"globals: Invalid version") forall a b. (a -> b) -> a -> b
$ forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
Version.mkVersion forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ ProtocolParameters -> (Natural, Natural)
protocolParamProtocolVersion forall a b. (a -> b) -> a -> b
$ forall era. BundledProtocolParameters era -> ProtocolParameters
C.unbundleProtocolParams BundledProtocolParameters BabbageEra
npProtocolParameters)

protVer :: NodeParams -> ProtVer
protVer :: NodeParams -> ProtVer
protVer = ProtocolParameters -> ProtVer
lederPPProtVer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. BundledProtocolParameters era -> ProtocolParameters
C.unbundleProtocolParams forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeParams -> BundledProtocolParameters BabbageEra
npProtocolParameters

lederPPProtVer :: ProtocolParameters -> ProtVer
lederPPProtVer :: ProtocolParameters -> ProtVer
lederPPProtVer ProtocolParameters
k =
  let (Natural
majorProtVer, Natural
minorProtVer) = ProtocolParameters -> (Natural, Natural)
protocolParamProtocolVersion ProtocolParameters
k
  in forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"globals: Invalid major protocol version: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> [Char]
show Natural
majorProtVer) forall a b. (a -> b) -> a -> b
$
      (Version -> Natural -> ProtVer
`C.Ledger.ProtVer` Natural
minorProtVer) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall i (m :: * -> *). (Integral i, MonadFail m) => i -> m Version
Version.mkVersion Natural
majorProtVer

genesisDefaultsFromParams :: NodeParams -> ShelleyGenesis StandardCrypto
genesisDefaultsFromParams :: NodeParams -> ShelleyGenesis StandardCrypto
genesisDefaultsFromParams params :: NodeParams
params@NodeParams { NetworkId
npNetworkId :: NodeParams -> NetworkId
npNetworkId :: NetworkId
npNetworkId } = ShelleyGenesis StandardCrypto
shelleyGenesisDefaults
  { sgSystemStart :: UTCTime
sgSystemStart = UTCTime
startTime
  , sgNetworkMagic :: Word32
sgNetworkMagic = case NetworkId
npNetworkId of Testnet (NetworkMagic Word32
nm) -> Word32
nm; NetworkId
_ -> Word32
0
  , sgNetworkId :: Network
sgNetworkId = case NetworkId
npNetworkId of Testnet NetworkMagic
_ -> Network
C.Ledger.Testnet; NetworkId
Mainnet -> Network
C.Ledger.Mainnet
  , sgProtocolParams :: PParams (ShelleyEra StandardCrypto)
sgProtocolParams =
      forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
DowngradePParams Identity era
-> PParams era -> PParams (PreviousEra era)
downgradePParams ()
      forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
DowngradePParams Identity era
-> PParams era -> PParams (PreviousEra era)
downgradePParams ()
      forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
DowngradePParams Identity era
-> PParams era -> PParams (PreviousEra era)
downgradePParams DowngradeAlonzoPParams{dappMinUTxOValue :: HKD Identity Coin
dappMinUTxOValue=Integer -> Coin
Coin Integer
0}
      forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, EraPParams (PreviousEra era)) =>
DowngradePParams Identity era
-> PParams era -> PParams (PreviousEra era)
downgradePParams DowngradeBabbagePParams{dbppD :: HKD Identity UnitInterval
dbppD=HKD Identity UnitInterval
d, dbppExtraEntropy :: HKD Identity Nonce
dbppExtraEntropy=Nonce
C.Ledger.NeutralNonce}
      forall a b. (a -> b) -> a -> b
$ NodeParams -> PParams (BabbageEra StandardCrypto)
pParams NodeParams
params
  }
  where
    d :: HKD Identity UnitInterval
d = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"3 % 5 should be valid UnitInterval") forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => Rational -> Maybe r
boundRational (Integer
3 forall a. Integral a => a -> a -> Ratio a
% Integer
5)

-- | Convert `Params` to cardano-ledger `PParams`
pParams :: NodeParams -> PParams Babbage
pParams :: NodeParams -> PParams (BabbageEra StandardCrypto)
pParams NodeParams { BundledProtocolParameters BabbageEra
npProtocolParameters :: BundledProtocolParameters BabbageEra
npProtocolParameters :: NodeParams -> BundledProtocolParameters BabbageEra
npProtocolParameters } = case BundledProtocolParameters BabbageEra
npProtocolParameters of
  C.BundleAsShelleyBasedProtocolParameters ShelleyBasedEra BabbageEra
_ ProtocolParameters
_ PParams (ShelleyLedgerEra BabbageEra)
p -> PParams (ShelleyLedgerEra BabbageEra)
p

{-| 'NodeParams' with default values for testing
-}
nodeParams :: NodeParams
nodeParams :: NodeParams
nodeParams =
  NodeParams
    { npNetworkId :: NetworkId
npNetworkId = NetworkId
networkId
    , npProtocolParameters :: BundledProtocolParameters BabbageEra
npProtocolParameters = BundledProtocolParameters BabbageEra
bundledProtocolParameters
    , npSystemStart :: SystemStart
npSystemStart = SystemStart
systemStart
    , npEraHistory :: EraHistory CardanoMode
npEraHistory = EraHistory CardanoMode
eraHistory
    , npStakePools :: Set PoolId
npStakePools = forall a. Monoid a => a
mempty
    , npSlotLength :: SlotLength
npSlotLength = SlotLength
slotLength
    }

bundledProtocolParameters :: C.BundledProtocolParameters C.BabbageEra
bundledProtocolParameters :: BundledProtocolParameters BabbageEra
bundledProtocolParameters = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => [Char] -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Semigroup a => a -> a -> a
(<>) [Char]
"nodeParams: bundleProtocolParams failed: " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a. a -> a
id (forall era.
CardanoEra era
-> ProtocolParameters
-> Either
     ProtocolParametersConversionError (BundledProtocolParameters era)
C.bundleProtocolParams CardanoEra BabbageEra
C.BabbageEra ProtocolParameters
protocolParameters)