{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.Api.Genesis.Internal
  ( ShelleyGenesis (..)
  , shelleyGenesisDefaults
  , alonzoGenesisDefaults
  , conwayGenesisDefaults
  , dijkstraGenesisDefaults

    -- ** Configuration
  , ByronGenesisConfig
  , ShelleyGenesisConfig
  , AlonzoGenesisConfig
  , ConwayGenesisConfig
  , ShelleyConfig (..)
  , GenesisHashByron (..)
  , GenesisHashShelley (..)
  , GenesisHashAlonzo (..)
  , GenesisHashConway (..)

    -- ** Files
  , ByronGenesisFile
  , ShelleyGenesisFile
  , AlonzoGenesisFile
  , ConwayGenesisFile

    -- * Utilities
  , unsafeBoundedRational
  )
where

import Cardano.Api.IO

import Cardano.Chain.Genesis qualified
import Cardano.Crypto.Hash.Blake2b qualified
import Cardano.Crypto.Hash.Class qualified
import Cardano.Ledger.Alonzo.Genesis (AlonzoGenesis (..))
import Cardano.Ledger.Alonzo.Scripts (ExUnits (..), Prices (..))
import Cardano.Ledger.Api (CoinPerWord (..))
import Cardano.Ledger.BaseTypes as Ledger
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Coin qualified as L
import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
import Cardano.Ledger.Conway.PParams
  ( DRepVotingThresholds (..)
  , PoolVotingThresholds (..)
  , UpgradeConwayPParams (..)
  )
import Cardano.Ledger.Dijkstra.Genesis (DijkstraGenesis (..))
import Cardano.Ledger.Dijkstra.PParams (UpgradeDijkstraPParams (..))
import Cardano.Ledger.Plutus (Language (..))
import Cardano.Ledger.Plutus qualified as L
import Cardano.Ledger.Plutus.CostModels (mkCostModelsLenient)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Genesis
  ( NominalDiffTimeMicro
  , ShelleyGenesis (..)
  , emptyGenesisStaking
  )
import Cardano.Ledger.Shelley.Genesis qualified as Ledger
import PlutusCore.Evaluation.Machine.BuiltinCostModel
import PlutusCore.Evaluation.Machine.CostModelInterface
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
import PlutusCore.Evaluation.Machine.MachineParameters
import PlutusLedgerApi.Common (IsParamName, readParamName)
import PlutusLedgerApi.V3 qualified as V3

import Control.Monad
import Control.Monad.Trans.Fail.String (errorFail)
import Data.ByteString (ByteString)
import Data.Default.Class qualified as DefaultClass
import Data.Functor.Identity
import Data.Int (Int64)
import Data.ListMap qualified as ListMap
import Data.Map.Strict qualified as M
import Data.Map.Strict qualified as Map
import Data.Maybe
import Data.Ratio
import Data.Text (Text)
import Data.Time qualified as Time
import Data.Typeable
import GHC.Exts (IsList (..))
import GHC.Stack (HasCallStack)
import Lens.Micro

import Barbies (bmap)
import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts

data ShelleyConfig = ShelleyConfig
  { ShelleyConfig -> ShelleyGenesis
scConfig :: !Ledger.ShelleyGenesis
  , ShelleyConfig -> GenesisHashShelley
scGenesisHash :: !GenesisHashShelley
  }

newtype GenesisHashByron = GenesisHashByron
  { GenesisHashByron -> Text
unGenesisHashByron :: Text
  }
  deriving newtype (GenesisHashByron -> GenesisHashByron -> Bool
(GenesisHashByron -> GenesisHashByron -> Bool)
-> (GenesisHashByron -> GenesisHashByron -> Bool)
-> Eq GenesisHashByron
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisHashByron -> GenesisHashByron -> Bool
== :: GenesisHashByron -> GenesisHashByron -> Bool
$c/= :: GenesisHashByron -> GenesisHashByron -> Bool
/= :: GenesisHashByron -> GenesisHashByron -> Bool
Eq, Int -> GenesisHashByron -> ShowS
[GenesisHashByron] -> ShowS
GenesisHashByron -> String
(Int -> GenesisHashByron -> ShowS)
-> (GenesisHashByron -> String)
-> ([GenesisHashByron] -> ShowS)
-> Show GenesisHashByron
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisHashByron -> ShowS
showsPrec :: Int -> GenesisHashByron -> ShowS
$cshow :: GenesisHashByron -> String
show :: GenesisHashByron -> String
$cshowList :: [GenesisHashByron] -> ShowS
showList :: [GenesisHashByron] -> ShowS
Show)

newtype GenesisHashShelley = GenesisHashShelley
  { GenesisHashShelley -> Hash Blake2b_256 ByteString
unGenesisHashShelley
      :: Cardano.Crypto.Hash.Class.Hash Cardano.Crypto.Hash.Blake2b.Blake2b_256 ByteString
  }
  deriving newtype (GenesisHashShelley -> GenesisHashShelley -> Bool
(GenesisHashShelley -> GenesisHashShelley -> Bool)
-> (GenesisHashShelley -> GenesisHashShelley -> Bool)
-> Eq GenesisHashShelley
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisHashShelley -> GenesisHashShelley -> Bool
== :: GenesisHashShelley -> GenesisHashShelley -> Bool
$c/= :: GenesisHashShelley -> GenesisHashShelley -> Bool
/= :: GenesisHashShelley -> GenesisHashShelley -> Bool
Eq, Int -> GenesisHashShelley -> ShowS
[GenesisHashShelley] -> ShowS
GenesisHashShelley -> String
(Int -> GenesisHashShelley -> ShowS)
-> (GenesisHashShelley -> String)
-> ([GenesisHashShelley] -> ShowS)
-> Show GenesisHashShelley
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisHashShelley -> ShowS
showsPrec :: Int -> GenesisHashShelley -> ShowS
$cshow :: GenesisHashShelley -> String
show :: GenesisHashShelley -> String
$cshowList :: [GenesisHashShelley] -> ShowS
showList :: [GenesisHashShelley] -> ShowS
Show)

newtype GenesisHashAlonzo = GenesisHashAlonzo
  { GenesisHashAlonzo -> Hash Blake2b_256 ByteString
unGenesisHashAlonzo
      :: Cardano.Crypto.Hash.Class.Hash Cardano.Crypto.Hash.Blake2b.Blake2b_256 ByteString
  }
  deriving newtype (GenesisHashAlonzo -> GenesisHashAlonzo -> Bool
(GenesisHashAlonzo -> GenesisHashAlonzo -> Bool)
-> (GenesisHashAlonzo -> GenesisHashAlonzo -> Bool)
-> Eq GenesisHashAlonzo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisHashAlonzo -> GenesisHashAlonzo -> Bool
== :: GenesisHashAlonzo -> GenesisHashAlonzo -> Bool
$c/= :: GenesisHashAlonzo -> GenesisHashAlonzo -> Bool
/= :: GenesisHashAlonzo -> GenesisHashAlonzo -> Bool
Eq, Int -> GenesisHashAlonzo -> ShowS
[GenesisHashAlonzo] -> ShowS
GenesisHashAlonzo -> String
(Int -> GenesisHashAlonzo -> ShowS)
-> (GenesisHashAlonzo -> String)
-> ([GenesisHashAlonzo] -> ShowS)
-> Show GenesisHashAlonzo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisHashAlonzo -> ShowS
showsPrec :: Int -> GenesisHashAlonzo -> ShowS
$cshow :: GenesisHashAlonzo -> String
show :: GenesisHashAlonzo -> String
$cshowList :: [GenesisHashAlonzo] -> ShowS
showList :: [GenesisHashAlonzo] -> ShowS
Show)

newtype GenesisHashConway = GenesisHashConway
  { GenesisHashConway -> Hash Blake2b_256 ByteString
unGenesisHashConway
      :: Cardano.Crypto.Hash.Class.Hash Cardano.Crypto.Hash.Blake2b.Blake2b_256 ByteString
  }
  deriving newtype (GenesisHashConway -> GenesisHashConway -> Bool
(GenesisHashConway -> GenesisHashConway -> Bool)
-> (GenesisHashConway -> GenesisHashConway -> Bool)
-> Eq GenesisHashConway
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenesisHashConway -> GenesisHashConway -> Bool
== :: GenesisHashConway -> GenesisHashConway -> Bool
$c/= :: GenesisHashConway -> GenesisHashConway -> Bool
/= :: GenesisHashConway -> GenesisHashConway -> Bool
Eq, Int -> GenesisHashConway -> ShowS
[GenesisHashConway] -> ShowS
GenesisHashConway -> String
(Int -> GenesisHashConway -> ShowS)
-> (GenesisHashConway -> String)
-> ([GenesisHashConway] -> ShowS)
-> Show GenesisHashConway
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisHashConway -> ShowS
showsPrec :: Int -> GenesisHashConway -> ShowS
$cshow :: GenesisHashConway -> String
show :: GenesisHashConway -> String
$cshowList :: [GenesisHashConway] -> ShowS
showList :: [GenesisHashConway] -> ShowS
Show)

type ByronGenesisConfig = Cardano.Chain.Genesis.Config

type ShelleyGenesisConfig = ShelleyConfig

type AlonzoGenesisConfig = AlonzoGenesis

type ConwayGenesisConfig = ConwayGenesis

type ByronGenesisFile = File ByronGenesisConfig

type ShelleyGenesisFile = File ShelleyGenesisConfig

type AlonzoGenesisFile = File AlonzoGenesisConfig

type ConwayGenesisFile = File ConwayGenesisConfig

-- | Some reasonable starting defaults for constructing a 'ShelleyGenesis'.
--
-- You must override at least the following fields for this to be useful:
--
-- * 'sgSystemStart' the time of the first block
-- * 'sgNetworkMagic' to a suitable testnet or mainnet network magic number.
-- * 'sgGenDelegs' to have some initial nodes
-- * 'sgInitialFunds' to have any money in the system
-- * 'sgMaxLovelaceSupply' must be at least the sum of the 'sgInitialFunds'
--   but more if you want to allow for rewards.
shelleyGenesisDefaults :: ShelleyGenesis
shelleyGenesisDefaults :: ShelleyGenesis
shelleyGenesisDefaults =
  ShelleyGenesis
    { -- parameters for this specific chain
      sgSystemStart :: UTCTime
sgSystemStart = UTCTime
zeroTime
    , sgNetworkMagic :: Word32
sgNetworkMagic = Word32
42
    , sgNetworkId :: Network
sgNetworkId = Network
Ledger.Testnet
    , -- consensus protocol parameters
      sgSlotLength :: NominalDiffTimeMicro
sgSlotLength = NominalDiffTimeMicro
1.0 :: NominalDiffTimeMicro -- 1s slots
    , sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff = Rational -> PositiveUnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBR (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
20) -- f ; 1/f = 20s block times on average
    , sgSecurityParam :: NonZero Word64
sgSecurityParam = NonZero Word64
k
    , sgEpochLength :: EpochSize
sgEpochLength = Word64 -> EpochSize
Ledger.EpochSize (NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
10 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
20) -- 10k/f
    , sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod = Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
60 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
36 -- 1.5 days with 1s slots
    , sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions = Word64
60 -- 90 days
    , sgUpdateQuorum :: Word64
sgUpdateQuorum = Word64
5 -- assuming 7 genesis keys
    , -- ledger protocol parameters
      sgProtocolParams :: PParams ShelleyEra
sgProtocolParams =
        PParams ShelleyEra
forall era. EraPParams era => PParams era
emptyPParams
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era.
(EraPParams era, AtMostEra "Alonzo" era) =>
Lens' (PParams era) UnitInterval
Lens' (PParams ShelleyEra) UnitInterval
ppDL ((UnitInterval -> Identity UnitInterval)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> UnitInterval -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
forall a. Bounded a => a
maxBound
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams ShelleyEra) Word16
ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Word16 -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
1100 -- TODO: compute from crypto
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ShelleyEra) Word32
ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Word32 -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
64 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024 -- max 64kb blocks
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams ShelleyEra) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Word32 -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32
16 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024 -- max 16kb txs
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams ShelleyEra) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> EpochInterval -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
18
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ShelleyEra) Coin
ppMinFeeAL ((Coin -> Identity Coin)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Coin -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
1 -- The linear factor for the minimum fee calculation
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ShelleyEra) Coin
ppMinFeeBL ((Coin -> Identity Coin)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Coin -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0 -- The constant factor for the minimum fee calculation
          -- pot = tx_fees + ρ * remaining_reserves
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams ShelleyEra) UnitInterval
ppRhoL ((UnitInterval -> Identity UnitInterval)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> UnitInterval -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBR (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10) -- How much of reserves goes into pot
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams ShelleyEra) UnitInterval
ppTauL ((UnitInterval -> Identity UnitInterval)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> UnitInterval -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBR (Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10) -- τ * remaining_reserves is sent to treasury every epoch
          PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams ShelleyEra) Coin
ppKeyDepositL ((Coin -> Identity Coin)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> Coin -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
L.Coin Integer
400000 -- require a non-zero deposit when registering keys
    , -- genesis keys and initial funds
      sgGenDelegs :: Map (KeyHash 'Genesis) GenDelegPair
sgGenDelegs = Map (KeyHash 'Genesis) GenDelegPair
forall k a. Map k a
M.empty
    , sgStaking :: ShelleyGenesisStaking
sgStaking = ShelleyGenesisStaking
emptyGenesisStaking
    , sgInitialFunds :: ListMap Addr Coin
sgInitialFunds = ListMap Addr Coin
forall k a. ListMap k a
ListMap.empty
    , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = Word64
0
    }
 where
  k :: NonZero Word64
k = forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @2160
  zeroTime :: UTCTime
zeroTime = Day -> DiffTime -> UTCTime
Time.UTCTime (Integer -> Int -> Int -> Day
Time.fromGregorian Integer
1970 Int
1 Int
1) DiffTime
0 -- tradition
  unsafeBR :: (HasCallStack, Typeable r, BoundedRational r) => Rational -> r
  unsafeBR :: forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBR = Rational -> r
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundedRational

dijkstraGenesisDefaults :: DijkstraGenesis
dijkstraGenesisDefaults :: DijkstraGenesis
dijkstraGenesisDefaults =
  -- copied from: https://github.com/IntersectMBO/cardano-ledger/blob/232511b0fa01cd848cd7a569d1acc322124cf9b8/eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/ImpTest.hs#L121
  DijkstraGenesis
    { dgUpgradePParams :: UpgradeDijkstraPParams Identity DijkstraEra
dgUpgradePParams =
        UpgradeDijkstraPParams
          { udppMaxRefScriptSizePerBlock :: HKD Identity Word32
udppMaxRefScriptSizePerBlock = Word32
1024 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024 -- 1MiB
          , udppMaxRefScriptSizePerTx :: HKD Identity Word32
udppMaxRefScriptSizePerTx = Word32
200 Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1024 -- 200KiB
          , udppRefScriptCostStride :: HKD Identity (NonZero Word32)
udppRefScriptCostStride = forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @25600 -- 25 KiB
          , udppRefScriptCostMultiplier :: HKD Identity PositiveInterval
udppRefScriptCostMultiplier = Maybe (HKD Identity PositiveInterval)
-> HKD Identity PositiveInterval
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (HKD Identity PositiveInterval)
 -> HKD Identity PositiveInterval)
-> Maybe (HKD Identity PositiveInterval)
-> HKD Identity PositiveInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe PositiveInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
1.2
          }
    }

-- | Some reasonable starting defaults for constructing a 'ConwayGenesis'.
-- Based on https://github.com/IntersectMBO/cardano-node/blob/master/cardano-testnet/src/Testnet/Defaults.hs
conwayGenesisDefaults :: ConwayGenesis
conwayGenesisDefaults :: ConwayGenesis
conwayGenesisDefaults =
  ConwayGenesis
    { cgUpgradePParams :: UpgradeConwayPParams Identity
cgUpgradePParams = UpgradeConwayPParams Identity
defaultUpgradeConwayParams
    , cgConstitution :: Constitution ConwayEra
cgConstitution = Constitution ConwayEra
forall a. Default a => a
DefaultClass.def
    , cgCommittee :: Committee ConwayEra
cgCommittee = Committee ConwayEra
forall a. Default a => a
DefaultClass.def
    , cgDelegs :: ListMap (Credential 'Staking) Delegatee
cgDelegs = ListMap (Credential 'Staking) Delegatee
forall a. Monoid a => a
mempty
    , cgInitialDReps :: ListMap (Credential 'DRepRole) DRepState
cgInitialDReps = ListMap (Credential 'DRepRole) DRepState
forall a. Monoid a => a
mempty
    }
 where
  defaultUpgradeConwayParams :: UpgradeConwayPParams Identity
  defaultUpgradeConwayParams :: UpgradeConwayPParams Identity
defaultUpgradeConwayParams =
    UpgradeConwayPParams
      { ucppPoolVotingThresholds :: HKD Identity PoolVotingThresholds
ucppPoolVotingThresholds = PoolVotingThresholds
HKD Identity PoolVotingThresholds
defaultPoolVotingThresholds
      , ucppGovActionLifetime :: HKD Identity EpochInterval
ucppGovActionLifetime = Word32 -> EpochInterval
EpochInterval Word32
1
      , ucppGovActionDeposit :: HKD Identity Coin
ucppGovActionDeposit = Integer -> Coin
Coin Integer
1000000
      , ucppDRepVotingThresholds :: HKD Identity DRepVotingThresholds
ucppDRepVotingThresholds = DRepVotingThresholds
HKD Identity DRepVotingThresholds
defaultDRepVotingThresholds
      , ucppDRepDeposit :: HKD Identity Coin
ucppDRepDeposit = Integer -> Coin
Coin Integer
1000000
      , ucppDRepActivity :: HKD Identity EpochInterval
ucppDRepActivity = Word32 -> EpochInterval
EpochInterval Word32
100
      , ucppCommitteeMinSize :: HKD Identity Word16
ucppCommitteeMinSize = Word16
HKD Identity Word16
0
      , ucppCommitteeMaxTermLength :: HKD Identity EpochInterval
ucppCommitteeMaxTermLength = Word32 -> EpochInterval
EpochInterval Word32
200
      , ucppMinFeeRefScriptCostPerByte :: HKD Identity NonNegativeInterval
ucppMinFeeRefScriptCostPerByte = Integer
0 Integer -> Integer -> NonNegativeInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
1 -- TODO: set to correct value after benchmarking
      , ucppPlutusV3CostModel :: HKD Identity CostModel
ucppPlutusV3CostModel = CostModel
HKD Identity CostModel
HasCallStack => CostModel
testingCostModelV3
      }
   where
    defaultPoolVotingThresholds :: PoolVotingThresholds
    defaultPoolVotingThresholds :: PoolVotingThresholds
defaultPoolVotingThresholds =
      PoolVotingThresholds
        { pvtPPSecurityGroup :: UnitInterval
pvtPPSecurityGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , pvtMotionNoConfidence :: UnitInterval
pvtMotionNoConfidence = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , pvtHardForkInitiation :: UnitInterval
pvtHardForkInitiation = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , pvtCommitteeNormal :: UnitInterval
pvtCommitteeNormal = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , pvtCommitteeNoConfidence :: UnitInterval
pvtCommitteeNoConfidence = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        }

    defaultDRepVotingThresholds :: DRepVotingThresholds
    defaultDRepVotingThresholds :: DRepVotingThresholds
defaultDRepVotingThresholds =
      DRepVotingThresholds
        { dvtUpdateToConstitution :: UnitInterval
dvtUpdateToConstitution = Integer
0 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
1
        , dvtTreasuryWithdrawal :: UnitInterval
dvtTreasuryWithdrawal = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , dvtPPTechnicalGroup :: UnitInterval
dvtPPTechnicalGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , dvtPPNetworkGroup :: UnitInterval
dvtPPNetworkGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , dvtPPGovGroup :: UnitInterval
dvtPPGovGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , dvtPPEconomicGroup :: UnitInterval
dvtPPEconomicGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , dvtMotionNoConfidence :: UnitInterval
dvtMotionNoConfidence = Integer
0 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
1
        , dvtHardForkInitiation :: UnitInterval
dvtHardForkInitiation = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , dvtCommitteeNormal :: UnitInterval
dvtCommitteeNormal = Integer
1 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
2
        , dvtCommitteeNoConfidence :: UnitInterval
dvtCommitteeNoConfidence = Integer
0 Integer -> Integer -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
1
        }
    testingCostModelV3 :: HasCallStack => L.CostModel
    testingCostModelV3 :: HasCallStack => CostModel
testingCostModelV3 = Language -> [Int64] -> CostModel
forall i.
(Integral i, Show i, HasCallStack) =>
Language -> [i] -> CostModel
mkCostModel' Language
PlutusV3 ([Int64] -> CostModel) -> [Int64] -> CostModel
forall a b. (a -> b) -> a -> b
$ (ParamName, Int64) -> Int64
forall a b. (a, b) -> b
snd ((ParamName, Int64) -> Int64) -> [(ParamName, Int64)] -> [Int64]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ParamName, Int64)]
HasCallStack => [(ParamName, Int64)]
costModelParamsForTesting

    mkCostModel' :: (Integral i, Show i, HasCallStack) => Language -> [i] -> L.CostModel
    mkCostModel' :: forall i.
(Integral i, Show i, HasCallStack) =>
Language -> [i] -> CostModel
mkCostModel' Language
lang [i]
params =
      case Language -> [Int64] -> Either CostModelApplyError CostModel
L.mkCostModel Language
lang ([Int64] -> Either CostModelApplyError CostModel)
-> [Int64] -> Either CostModelApplyError CostModel
forall a b. (a -> b) -> a -> b
$ (i -> Int64) -> [i] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map i -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral [i]
params of
        Left CostModelApplyError
err ->
          String -> CostModel
forall a. HasCallStack => String -> a
error (String -> CostModel) -> String -> CostModel
forall a b. (a -> b) -> a -> b
$
            String
"CostModel parameters are not well-formed for "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ Language -> String
forall a. Show a => a -> String
show Language
lang
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": "
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ CostModelApplyError -> String
forall a. Show a => a -> String
show CostModelApplyError
err
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"
              String -> ShowS
forall a. [a] -> [a] -> [a]
++ [i] -> String
forall a. Show a => a -> String
show [i]
params
        Right CostModel
costModel -> CostModel
costModel

    costModelParamsForTesting :: HasCallStack => [(V3.ParamName, Int64)]
    costModelParamsForTesting :: HasCallStack => [(ParamName, Int64)]
costModelParamsForTesting =
      -- all geneses should have exactly the number of cost model params equal to the initial number
      -- initial number - a number of parameters for the language, when the plutus language was introduced
      Int -> [(ParamName, Int64)] -> [(ParamName, Int64)]
forall a. Int -> [a] -> [a]
take (Language -> Int
L.costModelInitParamCount Language
PlutusV3)
        ([(ParamName, Int64)] -> [(ParamName, Int64)])
-> (Maybe (Map ParamName Int64) -> [(ParamName, Int64)])
-> Maybe (Map ParamName Int64)
-> [(ParamName, Int64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ParamName Int64 -> [(ParamName, Int64)]
forall k a. Map k a -> [(k, a)]
Map.toList
        (Map ParamName Int64 -> [(ParamName, Int64)])
-> (Maybe (Map ParamName Int64) -> Map ParamName Int64)
-> Maybe (Map ParamName Int64)
-> [(ParamName, Int64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Map ParamName Int64) -> Map ParamName Int64
forall a. HasCallStack => Maybe a -> a
fromJust
        (Maybe (Map ParamName Int64) -> [(ParamName, Int64)])
-> Maybe (Map ParamName Int64) -> [(ParamName, Int64)]
forall a b. (a -> b) -> a -> b
$ MCostModel -> Maybe (Map ParamName Int64)
forall p.
(IsParamName p, Ord p) =>
MCostModel -> Maybe (Map p Int64)
extractCostModelParamsLedgerOrder MCostModel
mCostModel

    mCostModel :: MCostModel
    mCostModel :: MCostModel
mCostModel =
      -- nothing to clear because v4 does not exist (yet).
      CostModel CekMachineCosts BuiltinCostModel -> MCostModel
toMCostModel CostModel CekMachineCosts BuiltinCostModel
defaultCekCostModelForTesting MCostModel -> (MCostModel -> MCostModel) -> MCostModel
forall a b. a -> (a -> b) -> b
& (MBuiltinCostModel -> Identity MBuiltinCostModel)
-> MCostModel -> Identity MCostModel
forall machinecosts builtincosts1 builtincosts2 (f :: * -> *).
Functor f =>
(builtincosts1 -> f builtincosts2)
-> CostModel machinecosts builtincosts1
-> f (CostModel machinecosts builtincosts2)
builtinCostModel ((MBuiltinCostModel -> Identity MBuiltinCostModel)
 -> MCostModel -> Identity MCostModel)
-> (MBuiltinCostModel -> MBuiltinCostModel)
-> MCostModel
-> MCostModel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MBuiltinCostModel -> MBuiltinCostModel
forall m. (m ~ MBuiltinCostModel) => m -> m
clearBuiltinCostModel'

    -- \*** FIXME!!! ***
    -- This is temporary to get the tests to pass
    clearBuiltinCostModel' :: m ~ MBuiltinCostModel => m -> m
    clearBuiltinCostModel' :: forall m. (m ~ MBuiltinCostModel) => m -> m
clearBuiltinCostModel' m
r =
      m
r
        { -- , paramIntegerToByteString = mempty -- Required for V2
          -- , paramByteStringToInteger = mempty -- Required for V2
          paramExpModInteger = mempty
        , paramDropList = mempty
        , paramLengthOfArray = mempty
        , paramListToArray = mempty
        , paramIndexArray = mempty
        }

    -- A helper function to lift to a "full" `MCostModel`, by mapping *all* of its fields to `Just`.
    -- The fields can be later on cleared, by assigning them to `Nothing`.
    toMCostModel
      :: CostModel CekMachineCosts BuiltinCostModel
      -> MCostModel
    toMCostModel :: CostModel CekMachineCosts BuiltinCostModel -> MCostModel
toMCostModel CostModel CekMachineCosts BuiltinCostModel
cm =
      CostModel CekMachineCosts BuiltinCostModel
cm
        CostModel CekMachineCosts BuiltinCostModel
-> (CostModel CekMachineCosts BuiltinCostModel
    -> CostModel (CekMachineCostsBase Maybe) BuiltinCostModel)
-> CostModel (CekMachineCostsBase Maybe) BuiltinCostModel
forall a b. a -> (a -> b) -> b
& (CekMachineCosts -> Identity (CekMachineCostsBase Maybe))
-> CostModel CekMachineCosts BuiltinCostModel
-> Identity
     (CostModel (CekMachineCostsBase Maybe) BuiltinCostModel)
forall machinecosts1 builtincosts machinecosts2 (f :: * -> *).
Functor f =>
(machinecosts1 -> f machinecosts2)
-> CostModel machinecosts1 builtincosts
-> f (CostModel machinecosts2 builtincosts)
machineCostModel
          ((CekMachineCosts -> Identity (CekMachineCostsBase Maybe))
 -> CostModel CekMachineCosts BuiltinCostModel
 -> Identity
      (CostModel (CekMachineCostsBase Maybe) BuiltinCostModel))
-> (CekMachineCosts -> CekMachineCostsBase Maybe)
-> CostModel CekMachineCosts BuiltinCostModel
-> CostModel (CekMachineCostsBase Maybe) BuiltinCostModel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. Identity a -> Maybe a)
-> CekMachineCosts -> CekMachineCostsBase Maybe
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a)
-> CekMachineCostsBase f -> CekMachineCostsBase g
bmap (a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> (Identity a -> a) -> Identity a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identity a -> a
forall a. Identity a -> a
runIdentity)
        CostModel (CekMachineCostsBase Maybe) BuiltinCostModel
-> (CostModel (CekMachineCostsBase Maybe) BuiltinCostModel
    -> MCostModel)
-> MCostModel
forall a b. a -> (a -> b) -> b
& (BuiltinCostModel -> Identity MBuiltinCostModel)
-> CostModel (CekMachineCostsBase Maybe) BuiltinCostModel
-> Identity MCostModel
forall machinecosts builtincosts1 builtincosts2 (f :: * -> *).
Functor f =>
(builtincosts1 -> f builtincosts2)
-> CostModel machinecosts builtincosts1
-> f (CostModel machinecosts builtincosts2)
builtinCostModel
          ((BuiltinCostModel -> Identity MBuiltinCostModel)
 -> CostModel (CekMachineCostsBase Maybe) BuiltinCostModel
 -> Identity MCostModel)
-> (BuiltinCostModel -> MBuiltinCostModel)
-> CostModel (CekMachineCostsBase Maybe) BuiltinCostModel
-> MCostModel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (forall a. CostingFun a -> MCostingFun a)
-> BuiltinCostModel -> MBuiltinCostModel
forall k (b :: (k -> *) -> *) (f :: k -> *) (g :: k -> *).
FunctorB b =>
(forall (a :: k). f a -> g a) -> b f -> b g
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a)
-> BuiltinCostModelBase f -> BuiltinCostModelBase g
bmap (Maybe (CostingFun a) -> MCostingFun a
forall a. Maybe (CostingFun a) -> MCostingFun a
MCostingFun (Maybe (CostingFun a) -> MCostingFun a)
-> (CostingFun a -> Maybe (CostingFun a))
-> CostingFun a
-> MCostingFun a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostingFun a -> Maybe (CostingFun a)
forall a. a -> Maybe a
Just)

    extractCostModelParamsLedgerOrder
      :: (IsParamName p, Ord p)
      => MCostModel
      -> Maybe (Map.Map p Int64)
    extractCostModelParamsLedgerOrder :: forall p.
(IsParamName p, Ord p) =>
MCostModel -> Maybe (Map p Int64)
extractCostModelParamsLedgerOrder =
      MCostModel -> Maybe CostModelParams
extractInAlphaOrder
        (MCostModel -> Maybe CostModelParams)
-> (CostModelParams -> Maybe (Map p Int64))
-> MCostModel
-> Maybe (Map p Int64)
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> CostModelParams -> Maybe (Map p Int64)
forall {a}. Map Text a -> Maybe (Map p a)
toLedgerOrder
     where
      extractInAlphaOrder :: MCostModel -> Maybe CostModelParams
extractInAlphaOrder = MCostModel -> Maybe CostModelParams
forall machinecosts builtincosts.
(ToJSON machinecosts, ToJSON builtincosts) =>
CostModel machinecosts builtincosts -> Maybe CostModelParams
extractCostModelParams
      toLedgerOrder :: Map Text a -> Maybe (Map p a)
toLedgerOrder = (Text -> Maybe p) -> Map Text a -> Maybe (Map p a)
forall (m :: * -> *) k2 k1 a.
(Monad m, Ord k2) =>
(k1 -> m k2) -> Map k1 a -> m (Map k2 a)
mapKeysM Text -> Maybe p
forall a. IsParamName a => Text -> Maybe a
readParamName

      mapKeysM :: (Monad m, Ord k2) => (k1 -> m k2) -> Map.Map k1 a -> m (Map.Map k2 a)
      mapKeysM :: forall (m :: * -> *) k2 k1 a.
(Monad m, Ord k2) =>
(k1 -> m k2) -> Map k1 a -> m (Map k2 a)
mapKeysM = ([(k1, a)] -> m [(k2, a)]) -> Map k1 a -> m (Map k2 a)
forall {f :: * -> *} {k} {k} {a} {a}.
(Functor f, Ord k) =>
([(k, a)] -> f [(k, a)]) -> Map k a -> f (Map k a)
viaListM (([(k1, a)] -> m [(k2, a)]) -> Map k1 a -> m (Map k2 a))
-> ((k1 -> m k2) -> [(k1, a)] -> m [(k2, a)])
-> (k1 -> m k2)
-> Map k1 a
-> m (Map k2 a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k1, a) -> m (k2, a)) -> [(k1, a)] -> m [(k2, a)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (((k1, a) -> m (k2, a)) -> [(k1, a)] -> m [(k2, a)])
-> ((k1 -> m k2) -> (k1, a) -> m (k2, a))
-> (k1 -> m k2)
-> [(k1, a)]
-> m [(k2, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k1 -> m k2) -> (k1, a) -> m (k2, a)
forall {f :: * -> *} {t} {a} {t}.
Functor f =>
(t -> f a) -> (t, t) -> f (a, t)
firstM

      viaListM :: ([(k, a)] -> f [(k, a)]) -> Map k a -> f (Map k a)
viaListM [(k, a)] -> f [(k, a)]
op = ([(k, a)] -> Map k a) -> f [(k, a)] -> f (Map k a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, a)] -> Map k a
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList (f [(k, a)] -> f (Map k a))
-> (Map k a -> f [(k, a)]) -> Map k a -> f (Map k a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, a)] -> f [(k, a)]
op ([(k, a)] -> f [(k, a)])
-> (Map k a -> [(k, a)]) -> Map k a -> f [(k, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toList
      firstM :: (t -> f a) -> (t, t) -> f (a, t)
firstM t -> f a
f (t
k, t
v) = (,t
v) (a -> (a, t)) -> f a -> f (a, t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t -> f a
f t
k

type MCostModel = CostModel MCekMachineCosts MBuiltinCostModel

type MCekMachineCosts = CekMachineCostsBase Maybe

type MBuiltinCostModel = BuiltinCostModelBase MCostingFun

(%!) :: forall r. (HasCallStack, Typeable r, BoundedRational r) => Integer -> Integer -> r
Integer
n %! :: forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
d = Rational -> r
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundedRational (Rational -> r) -> Rational -> r
forall a b. (a -> b) -> a -> b
$ Integer
n Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
Data.Ratio.% Integer
d

-- | Some reasonable starting defaults for constructing a 'AlonzoGenesis'.
-- Based on https://github.com/IntersectMBO/cardano-node/blob/master/cardano-testnet/src/Testnet/Defaults.hs
alonzoGenesisDefaults
  :: AlonzoGenesis
alonzoGenesisDefaults :: AlonzoGenesis
alonzoGenesisDefaults =
  AlonzoGenesis
    { agPrices :: Prices
agPrices =
        Prices
          { prSteps :: NonNegativeInterval
prSteps = Integer
721 Integer -> Integer -> NonNegativeInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
10000000
          , prMem :: NonNegativeInterval
prMem = Integer
577 Integer -> Integer -> NonNegativeInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Integer -> Integer -> r
%! Integer
10000
          }
    , agMaxValSize :: Natural
agMaxValSize = Natural
5000
    , agMaxTxExUnits :: ExUnits
agMaxTxExUnits =
        ExUnits
          { exUnitsMem :: Natural
exUnitsMem = Natural
140000000
          , exUnitsSteps :: Natural
exUnitsSteps = Natural
10000000000
          }
    , agMaxCollateralInputs :: Natural
agMaxCollateralInputs = Natural
3
    , agMaxBlockExUnits :: ExUnits
agMaxBlockExUnits =
        ExUnits
          { exUnitsMem :: Natural
exUnitsMem = Natural
62000000
          , exUnitsSteps :: Natural
exUnitsSteps = Natural
20000000000
          }
    , agCostModels :: CostModels
agCostModels = Fail CostModels -> CostModels
forall a. HasCallStack => Fail a -> a
errorFail Fail CostModels
apiCostModels
    , agCollateralPercentage :: Natural
agCollateralPercentage = Natural
150
    , agCoinsPerUTxOWord :: CoinPerWord
agCoinsPerUTxOWord = Coin -> CoinPerWord
CoinPerWord (Coin -> CoinPerWord) -> Coin -> CoinPerWord
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
Coin Integer
34482
    }
 where
  apiCostModels :: Fail CostModels
apiCostModels =
    Map Word8 [Int64] -> Fail CostModels
forall (m :: * -> *).
MonadFail m =>
Map Word8 [Int64] -> m CostModels
mkCostModelsLenient (Map Word8 [Int64] -> Fail CostModels)
-> Map Word8 [Int64] -> Fail CostModels
forall a b. (a -> b) -> a -> b
$
      [Item (Map Word8 [Int64])] -> Map Word8 [Int64]
forall l. IsList l => [Item l] -> l
fromList
        [ (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Language -> Int
forall a. Enum a => a -> Int
fromEnum Language
PlutusV1, [Int64]
defaultV1CostModel)
        , (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Language -> Int
forall a. Enum a => a -> Int
fromEnum Language
PlutusV2, [Int64]
defaultV2CostModel)
        ]
   where
    defaultV1CostModel :: [Int64]
defaultV1CostModel =
      [ Int64
205665
      , Int64
812
      , Int64
1
      , Int64
1
      , Int64
1000
      , Int64
571
      , Int64
0
      , Int64
1
      , Int64
1000
      , Int64
24177
      , Int64
4
      , Int64
1
      , Int64
1000
      , Int64
32
      , Int64
117366
      , Int64
10475
      , Int64
4
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
100
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
19537
      , Int64
32
      , Int64
175354
      , Int64
32
      , Int64
46417
      , Int64
4
      , Int64
221973
      , Int64
511
      , Int64
0
      , Int64
1
      , Int64
89141
      , Int64
32
      , Int64
497525
      , Int64
14068
      , Int64
4
      , Int64
2
      , Int64
196500
      , Int64
453240
      , Int64
220
      , Int64
0
      , Int64
1
      , Int64
1
      , Int64
1000
      , Int64
28662
      , Int64
4
      , Int64
2
      , Int64
245000
      , Int64
216773
      , Int64
62
      , Int64
1
      , Int64
1060367
      , Int64
12586
      , Int64
1
      , Int64
208512
      , Int64
421
      , Int64
1
      , Int64
187000
      , Int64
1000
      , Int64
52998
      , Int64
1
      , Int64
80436
      , Int64
32
      , Int64
43249
      , Int64
32
      , Int64
1000
      , Int64
32
      , Int64
80556
      , Int64
1
      , Int64
57667
      , Int64
4
      , Int64
1000
      , Int64
10
      , Int64
197145
      , Int64
156
      , Int64
1
      , Int64
197145
      , Int64
156
      , Int64
1
      , Int64
204924
      , Int64
473
      , Int64
1
      , Int64
208896
      , Int64
511
      , Int64
1
      , Int64
52467
      , Int64
32
      , Int64
64832
      , Int64
32
      , Int64
65493
      , Int64
32
      , Int64
22558
      , Int64
32
      , Int64
16563
      , Int64
32
      , Int64
76511
      , Int64
32
      , Int64
196500
      , Int64
453240
      , Int64
220
      , Int64
0
      , Int64
1
      , Int64
1
      , Int64
69522
      , Int64
11687
      , Int64
0
      , Int64
1
      , Int64
60091
      , Int64
32
      , Int64
196500
      , Int64
453240
      , Int64
220
      , Int64
0
      , Int64
1
      , Int64
1
      , Int64
196500
      , Int64
453240
      , Int64
220
      , Int64
0
      , Int64
1
      , Int64
1
      , Int64
806990
      , Int64
30482
      , Int64
4
      , Int64
1927926
      , Int64
82523
      , Int64
4
      , Int64
265318
      , Int64
0
      , Int64
4
      , Int64
0
      , Int64
85931
      , Int64
32
      , Int64
205665
      , Int64
812
      , Int64
1
      , Int64
1
      , Int64
41182
      , Int64
32
      , Int64
212342
      , Int64
32
      , Int64
31220
      , Int64
32
      , Int64
32696
      , Int64
32
      , Int64
43357
      , Int64
32
      , Int64
32247
      , Int64
32
      , Int64
38314
      , Int64
32
      , Int64
57996947
      , Int64
18975
      , Int64
10
      ]
    defaultV2CostModel :: [Int64]
defaultV2CostModel =
      [ Int64
205665
      , Int64
812
      , Int64
1
      , Int64
1
      , Int64
1000
      , Int64
571
      , Int64
0
      , Int64
1
      , Int64
1000
      , Int64
24177
      , Int64
4
      , Int64
1
      , Int64
1000
      , Int64
32
      , Int64
117366
      , Int64
10475
      , Int64
4
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
100
      , Int64
100
      , Int64
23000
      , Int64
100
      , Int64
19537
      , Int64
32
      , Int64
175354
      , Int64
32
      , Int64
46417
      , Int64
4
      , Int64
221973
      , Int64
511
      , Int64
0
      , Int64
1
      , Int64
89141
      , Int64
32
      , Int64
497525
      , Int64
14068
      , Int64
4
      , Int64
2
      , Int64
196500
      , Int64
453240
      , Int64
220
      , Int64
0
      , Int64
1
      , Int64
1
      , Int64
1000
      , Int64
28662
      , Int64
4
      , Int64
2
      , Int64
245000
      , Int64
216773
      , Int64
62
      , Int64
1
      , Int64
1060367
      , Int64
12586
      , Int64
1
      , Int64
208512
      , Int64
421
      , Int64
1
      , Int64
187000
      , Int64
1000
      , Int64
52998
      , Int64
1
      , Int64
80436
      , Int64
32
      , Int64
43249
      , Int64
32
      , Int64
1000
      , Int64
32
      , Int64
80556
      , Int64
1
      , Int64
57667
      , Int64
4
      , Int64
1000
      , Int64
10
      , Int64
197145
      , Int64
156
      , Int64
1
      , Int64
197145
      , Int64
156
      , Int64
1
      , Int64
204924
      , Int64
473
      , Int64
1
      , Int64
208896
      , Int64
511
      , Int64
1
      , Int64
52467
      , Int64
32
      , Int64
64832
      , Int64
32
      , Int64
65493
      , Int64
32
      , Int64
22558
      , Int64
32
      , Int64
16563
      , Int64
32
      , Int64
76511
      , Int64
32
      , Int64
196500
      , Int64
453240
      , Int64
220
      , Int64
0
      , Int64
1
      , Int64
1
      , Int64
69522
      , Int64
11687
      , Int64
0
      , Int64
1
      , Int64
60091
      , Int64
32
      , Int64
196500
      , Int64
453240
      , Int64
220
      , Int64
0
      , Int64
1
      , Int64
1
      , Int64
196500
      , Int64
453240
      , Int64
220
      , Int64
0
      , Int64
1
      , Int64
1
      , Int64
1159724
      , Int64
392670
      , Int64
0
      , Int64
2
      , Int64
806990
      , Int64
30482
      , Int64
4
      , Int64
1927926
      , Int64
82523
      , Int64
4
      , Int64
265318
      , Int64
0
      , Int64
4
      , Int64
0
      , Int64
85931
      , Int64
32
      , Int64
205665
      , Int64
812
      , Int64
1
      , Int64
1
      , Int64
41182
      , Int64
32
      , Int64
212342
      , Int64
32
      , Int64
31220
      , Int64
32
      , Int64
32696
      , Int64
32
      , Int64
43357
      , Int64
32
      , Int64
32247
      , Int64
32
      , Int64
38314
      , Int64
32
      , Int64
35892428
      , Int64
10
      , Int64
9462713
      , Int64
1021
      , Int64
10
      , Int64
38887044
      , Int64
32947
      , Int64
10
      ]

-- | Convert Rational to a bounded rational. Throw an exception when the rational is out of bounds.
unsafeBoundedRational
  :: forall r
   . (HasCallStack, Typeable r, BoundedRational r)
  => Rational
  -> r
unsafeBoundedRational :: forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundedRational Rational
x = r -> Maybe r -> r
forall a. a -> Maybe a -> a
fromMaybe (String -> r
forall a. HasCallStack => String -> a
error String
errMessage) (Maybe r -> r) -> Maybe r -> r
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe r
forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
x
 where
  errMessage :: String
errMessage = TypeRep -> String
forall a. Show a => a -> String
show (Proxy r -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @r)) String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is out of bounds: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Rational -> String
forall a. Show a => a -> String
show Rational
x