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

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

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

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

import           Cardano.Api.Eon.ConwayEraOnwards
import           Cardano.Api.Eras.Core
import           Cardano.Api.IO
import           Cardano.Api.Monad.Error
import           Cardano.Api.Utils (unsafeBoundedRational)

import qualified Cardano.Chain.Genesis
import qualified Cardano.Crypto.Hash.Blake2b
import qualified Cardano.Crypto.Hash.Class
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.Conway.Genesis (ConwayGenesis (..))
import           Cardano.Ledger.Conway.PParams (DRepVotingThresholds (..),
                   PoolVotingThresholds (..), UpgradeConwayPParams (..))
import           Cardano.Ledger.Crypto (StandardCrypto)
import           Cardano.Ledger.Plutus (Language (..))
import qualified Cardano.Ledger.Plutus as L
import           Cardano.Ledger.Plutus.CostModels (mkCostModelsLenient)
import           Cardano.Ledger.Shelley.Core
import           Cardano.Ledger.Shelley.Genesis (NominalDiffTimeMicro, ShelleyGenesis (..),
                   emptyGenesisStaking)
import qualified Cardano.Ledger.Shelley.Genesis as Ledger
import qualified Ouroboros.Consensus.Shelley.Eras as Shelley
import qualified PlutusLedgerApi.V2 as V2

import           Control.Monad
import           Control.Monad.Trans.Fail.String (errorFail)
import qualified Data.Aeson as A
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as LBS
import qualified Data.Default.Class as DefaultClass
import           Data.Functor.Identity (Identity)
import           Data.Int (Int64)
import           Data.List (sortOn)
import qualified Data.ListMap as ListMap
import           Data.Map (Map)
import qualified Data.Map.Strict as M
import           Data.Maybe
import           Data.Ratio
import qualified Data.Set as S
import           Data.Text (Text)
import qualified Data.Time as Time
import           Data.Typeable
import qualified Data.Vector as V
import           GHC.Exts (IsList (..))
import           GHC.Stack (HasCallStack)
import           Lens.Micro
import qualified Lens.Micro.Aeson as AL

import           Test.Cardano.Ledger.Core.Rational ((%!))
import           Test.Cardano.Ledger.Plutus (testingCostModelV3)

data ShelleyConfig = ShelleyConfig
  { ShelleyConfig -> ShelleyGenesis StandardCrypto
scConfig :: !(Ledger.ShelleyGenesis Shelley.StandardCrypto)
  , 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 Shelley.StandardCrypto

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 StandardCrypto
shelleyGenesisDefaults :: ShelleyGenesis StandardCrypto
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 :: Word64
sgSecurityParam = Word64
k
    , sgEpochLength :: EpochSize
sgEpochLength = Word64 -> EpochSize
Ledger.EpochSize (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 StandardCrypto)
sgProtocolParams =
        PParams (ShelleyEra StandardCrypto)
forall era. EraPParams era => PParams era
emptyPParams
          PParams (ShelleyEra StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
Lens' (PParams (ShelleyEra StandardCrypto)) UnitInterval
ppDL ((UnitInterval -> Identity UnitInterval)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> UnitInterval
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ UnitInterval
forall a. Bounded a => a
maxBound
          PParams (ShelleyEra StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Word16 -> Identity Word16)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) Word16
Lens' (PParams (ShelleyEra StandardCrypto)) Word16
ppMaxBHSizeL ((Word16 -> Identity Word16)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> Word16
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word16
1100 -- TODO: compute from crypto
          PParams (ShelleyEra StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams (ShelleyEra StandardCrypto)) Word32
ppMaxBBSizeL ((Word32 -> Identity Word32)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> Word32
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
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 StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Word32 -> Identity Word32)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) Word32
Lens' (PParams (ShelleyEra StandardCrypto)) Word32
ppMaxTxSizeL ((Word32 -> Identity Word32)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> Word32
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
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 StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (EpochInterval -> Identity EpochInterval)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams (ShelleyEra StandardCrypto)) EpochInterval
ppEMaxL ((EpochInterval -> Identity EpochInterval)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> EpochInterval
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Word32 -> EpochInterval
EpochInterval Word32
18
          PParams (ShelleyEra StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyEra StandardCrypto)) Coin
ppMinFeeAL ((Coin -> Identity Coin)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> Coin
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
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 StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyEra StandardCrypto)) Coin
ppMinFeeBL ((Coin -> Identity Coin)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> Coin
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
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 StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams (ShelleyEra StandardCrypto)) UnitInterval
ppRhoL ((UnitInterval -> Identity UnitInterval)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> UnitInterval
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
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 StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (UnitInterval -> Identity UnitInterval)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) UnitInterval
Lens' (PParams (ShelleyEra StandardCrypto)) UnitInterval
ppTauL ((UnitInterval -> Identity UnitInterval)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> UnitInterval
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
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 StandardCrypto)
-> (PParams (ShelleyEra StandardCrypto)
    -> PParams (ShelleyEra StandardCrypto))
-> PParams (ShelleyEra StandardCrypto)
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams (ShelleyEra StandardCrypto)
-> Identity (PParams (ShelleyEra StandardCrypto))
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams (ShelleyEra StandardCrypto)) Coin
ppKeyDepositL ((Coin -> Identity Coin)
 -> PParams (ShelleyEra StandardCrypto)
 -> Identity (PParams (ShelleyEra StandardCrypto)))
-> Coin
-> PParams (ShelleyEra StandardCrypto)
-> PParams (ShelleyEra StandardCrypto)
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
400000 -- require a non-zero deposit when registering keys
    , -- genesis keys and initial funds
      sgGenDelegs :: Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
sgGenDelegs = Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
forall k a. Map k a
M.empty
    , sgStaking :: ShelleyGenesisStaking StandardCrypto
sgStaking = ShelleyGenesisStaking StandardCrypto
forall c. ShelleyGenesisStaking c
emptyGenesisStaking
    , sgInitialFunds :: ListMap (Addr StandardCrypto) Coin
sgInitialFunds = ListMap (Addr StandardCrypto) Coin
forall k a. ListMap k a
ListMap.empty
    , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = Word64
0
    }
 where
  k :: Word64
k = Word64
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

-- | 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 StandardCrypto
conwayGenesisDefaults :: ConwayGenesis StandardCrypto
conwayGenesisDefaults =
  ConwayGenesis
    { cgUpgradePParams :: UpgradeConwayPParams Identity
cgUpgradePParams = UpgradeConwayPParams Identity
defaultUpgradeConwayParams
    , cgConstitution :: Constitution (ConwayEra StandardCrypto)
cgConstitution = Constitution (ConwayEra StandardCrypto)
forall a. Default a => a
DefaultClass.def
    , cgCommittee :: Committee (ConwayEra StandardCrypto)
cgCommittee = Committee (ConwayEra StandardCrypto)
forall a. Default a => a
DefaultClass.def
    , cgDelegs :: ListMap
  (Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
cgDelegs = ListMap
  (Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
forall a. Monoid a => a
mempty
    , cgInitialDReps :: ListMap
  (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
cgInitialDReps = ListMap
  (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
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. (IsRatio r, HasCallStack) => 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. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , pvtMotionNoConfidence :: UnitInterval
pvtMotionNoConfidence = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , pvtHardForkInitiation :: UnitInterval
pvtHardForkInitiation = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , pvtCommitteeNormal :: UnitInterval
pvtCommitteeNormal = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , pvtCommitteeNoConfidence :: UnitInterval
pvtCommitteeNoConfidence = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        }

    defaultDRepVotingThresholds :: DRepVotingThresholds
    defaultDRepVotingThresholds :: DRepVotingThresholds
defaultDRepVotingThresholds =
      DRepVotingThresholds
        { dvtUpdateToConstitution :: UnitInterval
dvtUpdateToConstitution = Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
        , dvtTreasuryWithdrawal :: UnitInterval
dvtTreasuryWithdrawal = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , dvtPPTechnicalGroup :: UnitInterval
dvtPPTechnicalGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , dvtPPNetworkGroup :: UnitInterval
dvtPPNetworkGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , dvtPPGovGroup :: UnitInterval
dvtPPGovGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , dvtPPEconomicGroup :: UnitInterval
dvtPPEconomicGroup = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , dvtMotionNoConfidence :: UnitInterval
dvtMotionNoConfidence = Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
        , dvtHardForkInitiation :: UnitInterval
dvtHardForkInitiation = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , dvtCommitteeNormal :: UnitInterval
dvtCommitteeNormal = Integer
1 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
2
        , dvtCommitteeNoConfidence :: UnitInterval
dvtCommitteeNoConfidence = Integer
0 Integer -> Integer -> UnitInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1
        }

-- | Decode Alonzo genesis in an optionally era sensitive way.
--
-- Because the Plutus V2 cost model has changed between Babbage and Conway era, we need to know the era if we
-- want to decde Alonzo Genesis with a cost model baked in. If the V2 cost model is present in genesis, you
-- need to provide an era witness.
--
-- When an era witness is provided, for Plutus V2 model the function additionally:
-- 1. Does extra cost model parameters name validation: Checks for mandatory 175 parameters if provided in
--    a map form.
-- 2. If >= Conway: adds defaults for new 10 parameters, if they were not provided (maxBound)
-- 3. Removes extra parameters above the max count: Babbage - 175, Conway - 185.
decodeAlonzoGenesis
  :: forall era t m
   . MonadTransError String t m
  => Maybe (CardanoEra era)
  -- ^ An optional era witness in which we're reading the genesis
  -> LBS.ByteString
  -- ^ Genesis JSON
  -> t m AlonzoGenesis
decodeAlonzoGenesis :: forall era (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadTransError String t m =>
Maybe (CardanoEra era) -> ByteString -> t m AlonzoGenesis
decodeAlonzoGenesis Maybe (CardanoEra era)
Nothing ByteString
genesisBs =
  ShowS -> ExceptT String m AlonzoGenesis -> t m AlonzoGenesis
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError (String
"Cannot decode Alonzo genesis: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (ExceptT String m AlonzoGenesis -> t m AlonzoGenesis)
-> ExceptT String m AlonzoGenesis -> t m AlonzoGenesis
forall a b. (a -> b) -> a -> b
$
    Either String AlonzoGenesis -> ExceptT String m AlonzoGenesis
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String AlonzoGenesis -> ExceptT String m AlonzoGenesis)
-> Either String AlonzoGenesis -> ExceptT String m AlonzoGenesis
forall a b. (a -> b) -> a -> b
$
      ByteString -> Either String AlonzoGenesis
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
genesisBs
decodeAlonzoGenesis (Just CardanoEra era
era) ByteString
genesisBs = ShowS -> ExceptT String m AlonzoGenesis -> t m AlonzoGenesis
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError (String
"Cannot decode era-sensitive Alonzo genesis: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (ExceptT String m AlonzoGenesis -> t m AlonzoGenesis)
-> ExceptT String m AlonzoGenesis -> t m AlonzoGenesis
forall a b. (a -> b) -> a -> b
$ do
  Value
genesisValue :: A.Value <- Either String Value -> ExceptT String m Value
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either String Value -> ExceptT String m Value)
-> Either String Value -> ExceptT String m Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
A.eitherDecode ByteString
genesisBs
  -- Making a fixup of a costmodel is easier before JSON deserialization. This also saves us from building
  -- plutus' EvaluationContext one more time after cost model update.
  Value
genesisValue' <-
    (Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
AL.key Key
"costModels" ((Value -> ExceptT String m Value)
 -> Value -> ExceptT String m Value)
-> ((Value -> ExceptT String m Value)
    -> Value -> ExceptT String m Value)
-> (Value -> ExceptT String m Value)
-> Value
-> ExceptT String m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Traversal' Value Value
forall t. AsValue t => Key -> Traversal' t Value
AL.key Key
"PlutusV2" ((Value -> ExceptT String m Value)
 -> Value -> ExceptT String m Value)
-> ((Value -> ExceptT String m Value)
    -> Value -> ExceptT String m Value)
-> (Value -> ExceptT String m Value)
-> Value
-> ExceptT String m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> ExceptT String m Value)
-> Value -> ExceptT String m Value
forall t. AsValue t => Traversal' t Value
Traversal' Value Value
AL._Value) Value -> ExceptT String m Value
setCostModelDefaultValues Value
genesisValue
  Value -> ExceptT String m AlonzoGenesis
forall a. FromJSON a => Value -> ExceptT String m a
fromJsonE Value
genesisValue'
 where
  setCostModelDefaultValues :: A.Value -> ExceptT String m A.Value
  setCostModelDefaultValues :: Value -> ExceptT String m Value
setCostModelDefaultValues = \case
    obj :: Value
obj@(A.Object Object
_) -> do
      -- decode cost model into a map first
      Map ParamName Int64
costModel :: Map V2.ParamName Int64 <-
        ShowS
-> ExceptT String m (Map ParamName Int64)
-> ExceptT String m (Map ParamName Int64)
forall e' (t :: (* -> *) -> * -> *) (m :: * -> *) e a.
MonadTransError e' t m =>
(e -> e') -> ExceptT e m a -> t m a
modifyError (String
"Decoding cost model object: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<>) (ExceptT String m (Map ParamName Int64)
 -> ExceptT String m (Map ParamName Int64))
-> ExceptT String m (Map ParamName Int64)
-> ExceptT String m (Map ParamName Int64)
forall a b. (a -> b) -> a -> b
$ Value -> ExceptT String m (Map ParamName Int64)
forall a. FromJSON a => Value -> ExceptT String m a
fromJsonE Value
obj

      let costModelWithDefaults :: [(ParamName, Int64)]
costModelWithDefaults =
            ((ParamName, Int64) -> ParamName)
-> [(ParamName, Int64)] -> [(ParamName, Int64)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (ParamName, Int64) -> ParamName
forall a b. (a, b) -> a
fst
              ([(ParamName, Int64)] -> [(ParamName, Int64)])
-> (Map ParamName Int64 -> [(ParamName, Int64)])
-> Map ParamName Int64
-> [(ParamName, Int64)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map ParamName Int64 -> [(ParamName, Int64)]
Map ParamName Int64 -> [Item (Map ParamName Int64)]
forall l. IsList l => l -> [Item l]
toList
              (Map ParamName Int64 -> [(ParamName, Int64)])
-> Map ParamName Int64 -> [(ParamName, Int64)]
forall a b. (a -> b) -> a -> b
$ Map ParamName Int64 -> Map ParamName Int64 -> Map ParamName Int64
forall k a. Ord k => Map k a -> Map k a -> Map k a
M.union Map ParamName Int64
costModel Map ParamName Int64
forall l. (Item l ~ (ParamName, Int64), IsList l) => l
optionalCostModelDefaultValues

      -- check that we have all required params
      Bool -> ExceptT String m () -> ExceptT String m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([ParamName]
allCostModelParams [ParamName] -> [ParamName] -> Bool
forall a. Eq a => a -> a -> Bool
== ((ParamName, Int64) -> ParamName
forall a b. (a, b) -> a
fst ((ParamName, Int64) -> ParamName)
-> [(ParamName, Int64)] -> [ParamName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ParamName, Int64)]
costModelWithDefaults)) (ExceptT String m () -> ExceptT String m ())
-> ExceptT String m () -> ExceptT String m ()
forall a b. (a -> b) -> a -> b
$ do
        let allCostModelParamsSet :: Set ParamName
allCostModelParamsSet = [Item (Set ParamName)] -> Set ParamName
forall l. IsList l => [Item l] -> l
fromList [Item (Set ParamName)]
[ParamName]
allCostModelParams
            providedCostModelParamsSet :: Set ParamName
providedCostModelParamsSet = [Item (Set ParamName)] -> Set ParamName
forall l. IsList l => [Item l] -> l
fromList ([Item (Set ParamName)] -> Set ParamName)
-> [Item (Set ParamName)] -> Set ParamName
forall a b. (a -> b) -> a -> b
$ (ParamName, Int64) -> ParamName
forall a b. (a, b) -> a
fst ((ParamName, Int64) -> ParamName)
-> [(ParamName, Int64)] -> [ParamName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(ParamName, Int64)]
costModelWithDefaults
        String -> ExceptT String m ()
forall a. String -> ExceptT String m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> ExceptT String m ()) -> String -> ExceptT String m ()
forall a b. (a -> b) -> a -> b
$
          String
"Missing V2 Plutus cost model parameters: "
            String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [ParamName] -> String
forall a. Show a => a -> String
show (Set ParamName -> [Item (Set ParamName)]
forall l. IsList l => l -> [Item l]
toList (Set ParamName -> [Item (Set ParamName)])
-> Set ParamName -> [Item (Set ParamName)]
forall a b. (a -> b) -> a -> b
$ Set ParamName -> Set ParamName -> Set ParamName
forall a. Ord a => Set a -> Set a -> Set a
S.difference Set ParamName
allCostModelParamsSet Set ParamName
providedCostModelParamsSet)

      -- We have already have required params, we already added optional ones (which are trimmed later
      -- if required). Continue processing further in array representation.
      Value -> ExceptT String m Value
setCostModelDefaultValues (Value -> ExceptT String m Value)
-> ([Int64] -> Value) -> [Int64] -> ExceptT String m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int64] -> Value
forall a. ToJSON a => a -> Value
A.toJSON ([Int64] -> ExceptT String m Value)
-> [Int64] -> ExceptT String m Value
forall a b. (a -> b) -> a -> b
$ ((ParamName, Int64) -> Int64) -> [(ParamName, Int64)] -> [Int64]
forall a b. (a -> b) -> [a] -> [b]
map (ParamName, Int64) -> Int64
forall a b. (a, b) -> b
snd [(ParamName, Int64)]
costModelWithDefaults
    A.Array Vector Value
vec
      -- here we rely on an assumption that params are in correct order, so that we can take only the
      -- required ones for an era
      | Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
vec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
costModelExpectedCount ->
          Value -> ExceptT String m Value
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ExceptT String m Value)
-> (Vector Value -> Value)
-> Vector Value
-> ExceptT String m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> Value
A.Array (Vector Value -> Value)
-> (Vector Value -> Vector Value) -> Vector Value -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Vector Value -> Vector Value
forall a. Int -> Vector a -> Vector a
V.take Int
costModelExpectedCount (Vector Value -> ExceptT String m Value)
-> Vector Value -> ExceptT String m Value
forall a b. (a -> b) -> a -> b
$
            Vector Value
vec Vector Value -> Vector Value -> Vector Value
forall a. Semigroup a => a -> a -> a
<> (Int64 -> Value
forall a. ToJSON a => a -> Value
A.toJSON (Int64 -> Value)
-> ((ParamName, Int64) -> Int64) -> (ParamName, Int64) -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ParamName, Int64) -> Int64
forall a b. (a, b) -> b
snd ((ParamName, Int64) -> Value)
-> Vector (ParamName, Int64) -> Vector Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector (ParamName, Int64)
forall l. (Item l ~ (ParamName, Int64), IsList l) => l
optionalCostModelDefaultValues)
      | Vector Value -> Int
forall a. Vector a -> Int
V.length Vector Value
vec Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
costModelExpectedCount -> Value -> ExceptT String m Value
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> ExceptT String m Value)
-> (Vector Value -> Value)
-> Vector Value
-> ExceptT String m Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> Value
A.Array (Vector Value -> ExceptT String m Value)
-> Vector Value -> ExceptT String m Value
forall a b. (a -> b) -> a -> b
$ Int -> Vector Value -> Vector Value
forall a. Int -> Vector a -> Vector a
V.take Int
costModelExpectedCount Vector Value
vec
    Value
other -> Value -> ExceptT String m Value
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
other

  -- Plutus V2 params expected count depending on an era
  costModelExpectedCount :: Int
  costModelExpectedCount :: Int
costModelExpectedCount
    -- use all available parameters >= conway
    | Bool
isConwayOnwards = [ParamName] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [ParamName]
allCostModelParams
    -- use only required params in < conway
    | Bool
otherwise = Language -> Int
L.costModelParamsCount Language
L.PlutusV2 -- Babbage

  -- A list-like of tuples (param name, value) with default maxBound value
  optionalCostModelDefaultValues :: (Item l ~ (V2.ParamName, Int64), IsList l) => l
  optionalCostModelDefaultValues :: forall l. (Item l ~ (ParamName, Int64), IsList l) => l
optionalCostModelDefaultValues = [Item l] -> l
forall l. IsList l => [Item l] -> l
fromList ([Item l] -> l) -> [Item l] -> l
forall a b. (a -> b) -> a -> b
$ (ParamName -> (ParamName, Int64))
-> [ParamName] -> [(ParamName, Int64)]
forall a b. (a -> b) -> [a] -> [b]
map (,Int64
forall a. Bounded a => a
maxBound) [ParamName]
optionalV2costModelParams

  allCostModelParams :: [V2.ParamName]
  allCostModelParams :: [ParamName]
allCostModelParams = [ParamName
forall a. Bounded a => a
minBound .. ParamName
forall a. Bounded a => a
maxBound]

  -- The new V2 cost model params introduced in Conway
  optionalV2costModelParams :: [V2.ParamName]
  optionalV2costModelParams :: [ParamName]
optionalV2costModelParams =
    [ ParamName
V2.IntegerToByteString'cpu'arguments'c0
    , ParamName
V2.IntegerToByteString'cpu'arguments'c1
    , ParamName
V2.IntegerToByteString'cpu'arguments'c2
    , ParamName
V2.IntegerToByteString'memory'arguments'intercept
    , ParamName
V2.IntegerToByteString'memory'arguments'slope
    , ParamName
V2.ByteStringToInteger'cpu'arguments'c0
    , ParamName
V2.ByteStringToInteger'cpu'arguments'c1
    , ParamName
V2.ByteStringToInteger'cpu'arguments'c2
    , ParamName
V2.ByteStringToInteger'memory'arguments'intercept
    , ParamName
V2.ByteStringToInteger'memory'arguments'slope
    ]

  fromJsonE :: A.FromJSON a => A.Value -> ExceptT String m a
  fromJsonE :: forall a. FromJSON a => Value -> ExceptT String m a
fromJsonE Value
v =
    case Value -> Result a
forall a. FromJSON a => Value -> Result a
A.fromJSON Value
v of
      A.Success a
a -> a -> ExceptT String m a
forall a. a -> ExceptT String m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a
      A.Error String
e -> String -> ExceptT String m a
forall a. String -> ExceptT String m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError String
e

  isConwayOnwards :: Bool
isConwayOnwards = Maybe (ConwayEraOnwards era) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (ConwayEraOnwards era) -> Bool)
-> Maybe (ConwayEraOnwards era) -> Bool
forall a b. (a -> b) -> a -> b
$ forall (eon :: * -> *) era.
Eon eon =>
CardanoEra era -> Maybe (eon era)
forEraMaybeEon @ConwayEraOnwards CardanoEra era
era

-- | Some reasonable starting defaults for constructing a 'AlonzoGenesis'.
-- Based on https://github.com/IntersectMBO/cardano-node/blob/master/cardano-testnet/src/Testnet/Defaults.hs
-- The era determines Plutus V2 cost model parameters:
-- * Conway: 185
-- * <= Babbage: 175
alonzoGenesisDefaults
  :: CardanoEra era
  -> AlonzoGenesis
alonzoGenesisDefaults :: forall era. CardanoEra era -> AlonzoGenesis
alonzoGenesisDefaults CardanoEra era
era =
  AlonzoGenesis
    { agPrices :: Prices
agPrices =
        Prices
          { prSteps :: NonNegativeInterval
prSteps = Integer
721 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
10000000
          , prMem :: NonNegativeInterval
prMem = Integer
577 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => 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
      ]
        [Int64] -> [Int64] -> [Int64]
forall a. Semigroup a => a -> a -> a
<> [Int64]
defaultV2CostModelNewConwayParams

    -- New Conway cost model parameters
    defaultV2CostModelNewConwayParams :: [Int64]
defaultV2CostModelNewConwayParams =
      forall (eon :: * -> *) a era.
(Eon eon, Monoid a) =>
CardanoEra era -> (eon era -> a) -> a
monoidForEraInEon @ConwayEraOnwards CardanoEra era
era ((ConwayEraOnwards era -> [Int64]) -> [Int64])
-> (ConwayEraOnwards era -> [Int64]) -> [Int64]
forall a b. (a -> b) -> a -> b
$
        [Int64] -> ConwayEraOnwards era -> [Int64]
forall a b. a -> b -> a
const
          [ Int64
1292075
          , Int64
24469
          , Int64
74
          , Int64
0
          , Int64
1
          , Int64
936157
          , Int64
49601
          , Int64
237
          , Int64
0
          , Int64
1
          ]