{-# LANGUAGE DataKinds #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module Test.Cardano.Ledger.Conway.Genesis (expectedConwayGenesis) where import Cardano.Ledger.BaseTypes (EpochInterval (..), textToUrl) import Cardano.Ledger.Coin (Coin (..)) import Cardano.Ledger.Conway import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..)) import Cardano.Ledger.Conway.Governance (Anchor (..), Committee (..)) import Cardano.Ledger.Conway.PParams import Cardano.Ledger.Conway.TxCert (Delegatee (..)) import Cardano.Ledger.Core import Cardano.Ledger.Credential import Cardano.Ledger.Slot (EpochNo (..)) import Cardano.Ledger.State (DRep (..), DRepState (..)) import Data.Default (Default (def)) import qualified Data.ListMap as ListMap import Data.Map as Map import Data.Maybe (fromJust) import Data.Maybe.Strict (StrictMaybe (..)) import Data.Ratio ((%)) import Test.Cardano.Ledger.Conway.Arbitrary () import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational) import Test.Cardano.Ledger.Plutus (zeroTestingCostModelV3) credMember :: Credential 'ColdCommitteeRole credMember :: Credential 'ColdCommitteeRole credMember = KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'ColdCommitteeRole forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a") scriptMember :: Credential 'ColdCommitteeRole scriptMember :: Credential 'ColdCommitteeRole scriptMember = ScriptHash -> Credential 'ColdCommitteeRole forall (kr :: KeyRole). ScriptHash -> Credential kr ScriptHashObj (Hash ADDRHASH EraIndependentScript -> ScriptHash ScriptHash Hash ADDRHASH EraIndependentScript "4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a") comm :: Committee ConwayEra comm :: Committee ConwayEra comm = Map (Credential 'ColdCommitteeRole) EpochNo -> UnitInterval -> Committee ConwayEra forall era. Map (Credential 'ColdCommitteeRole) EpochNo -> UnitInterval -> Committee era Committee ( [(Credential 'ColdCommitteeRole, EpochNo)] -> Map (Credential 'ColdCommitteeRole) EpochNo forall k a. Ord k => [(k, a)] -> Map k a Map.fromList [ ( Credential 'ColdCommitteeRole credMember , Word64 -> EpochNo EpochNo Word64 1 ) , ( Credential 'ColdCommitteeRole scriptMember , Word64 -> EpochNo EpochNo Word64 2 ) ] ) (Rational -> UnitInterval forall r. (HasCallStack, Typeable r, BoundedRational r) => Rational -> r unsafeBoundRational (Integer 1 Integer -> Integer -> Rational forall a. Integral a => a -> a -> Ratio a % Integer 2)) expectedConwayGenesis :: ConwayGenesis expectedConwayGenesis :: ConwayGenesis expectedConwayGenesis = ConwayGenesis { cgCommittee :: Committee ConwayEra cgCommittee = Committee ConwayEra comm , cgInitialDReps :: ListMap (Credential 'DRepRole) DRepState cgInitialDReps = [(Credential 'DRepRole, DRepState)] -> ListMap (Credential 'DRepRole) DRepState forall k v. [(k, v)] -> ListMap k v ListMap.fromList [ ( KeyHash 'DRepRole -> Credential 'DRepRole forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'DRepRole forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "78301005df84ba67fa1f12f95f8ee10335bc5e86c42afbc593ab4cdd") , DRepState { drepExpiry :: EpochNo drepExpiry = Word64 -> EpochNo EpochNo Word64 1000 , drepAnchor :: StrictMaybe Anchor drepAnchor = StrictMaybe Anchor forall a. StrictMaybe a SNothing , drepDeposit :: Coin drepDeposit = Integer -> Coin Coin Integer 5000 , drepDelegs :: Set (Credential 'Staking) drepDelegs = Set (Credential 'Staking) forall a. Monoid a => a mempty } ) , ( ScriptHash -> Credential 'DRepRole forall (kr :: KeyRole). ScriptHash -> Credential kr ScriptHashObj (Hash ADDRHASH EraIndependentScript -> ScriptHash ScriptHash Hash ADDRHASH EraIndependentScript "01305df84b078ac5e86c42afbc593ab4cdd67fa1f12f95f8ee10335b") , DRepState { drepExpiry :: EpochNo drepExpiry = Word64 -> EpochNo EpochNo Word64 300 , drepAnchor :: StrictMaybe Anchor drepAnchor = Anchor -> StrictMaybe Anchor forall a. a -> StrictMaybe a SJust (Anchor -> StrictMaybe Anchor) -> Anchor -> StrictMaybe Anchor forall a b. (a -> b) -> a -> b $ Anchor { anchorUrl :: Url anchorUrl = Maybe Url -> Url forall a. HasCallStack => Maybe a -> a fromJust (Maybe Url -> Url) -> Maybe Url -> Url forall a b. (a -> b) -> a -> b $ Int -> Text -> Maybe Url forall (m :: * -> *). MonadFail m => Int -> Text -> m Url textToUrl Int 99 Text "example.com" , anchorDataHash :: SafeHash AnchorData anchorDataHash = SafeHash AnchorData forall a. Default a => a def } , drepDeposit :: Coin drepDeposit = Integer -> Coin Coin Integer 6000 , drepDelegs :: Set (Credential 'Staking) drepDelegs = Set (Credential 'Staking) forall a. Monoid a => a mempty } ) ] , cgDelegs :: ListMap (Credential 'Staking) Delegatee cgDelegs = [(Credential 'Staking, Delegatee)] -> ListMap (Credential 'Staking) Delegatee forall k v. [(k, v)] -> ListMap k v ListMap.fromList [ ( KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Staking forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "35bc5e86c42afbc593ab4cdd78301005df84ba67fa1f12f95f8ee103") , DRep -> Delegatee DelegVote DRep DRepAlwaysNoConfidence ) , ( KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Staking forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "4e88cc2d27c364aaf90648a87dfb95f8ee103ba67fa1f12f5e86c42a") , DRep -> Delegatee DelegVote DRep DRepAlwaysAbstain ) , ( KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Staking forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "5df84bcdd7a5f8ee93aafbc500b435bc5e83067fa1f12f9110386c42") , KeyHash 'StakePool -> Delegatee DelegStake (KeyHash 'StakePool -> Delegatee) -> KeyHash 'StakePool -> Delegatee forall a b. (a -> b) -> a -> b $ Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'StakePool forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "0335bc5e86c42afbc578301005df84ba67fa1f12f95f8ee193ab4cdd" ) , ( KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Staking forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "8ee93a5df84bc42cdd7a5fafbc500b435bc5e83067fa1f12f9110386") , KeyHash 'StakePool -> DRep -> Delegatee DelegStakeVote (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'StakePool forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "086c42afbc578301005df84ba67fa1f12f95f8ee193ab4cdd335bc5e") DRep DRepAlwaysAbstain ) , ( KeyHash 'Staking -> Credential 'Staking forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'Staking forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "df93ab435bc5eafbc500583067fa1f12f9110386c42cdd784ba5f8ee") , DRep -> Delegatee DelegVote (DRep -> Delegatee) -> DRep -> Delegatee forall a b. (a -> b) -> a -> b $ Credential 'DRepRole -> DRep DRepCredential (ScriptHash -> Credential 'DRepRole forall (kr :: KeyRole). ScriptHash -> Credential kr ScriptHashObj (Hash ADDRHASH EraIndependentScript -> ScriptHash ScriptHash Hash ADDRHASH EraIndependentScript "01305df84b078ac5e86c42afbc593ab4cdd67fa1f12f95f8ee10335b")) ) , ( ScriptHash -> Credential 'Staking forall (kr :: KeyRole). ScriptHash -> Credential kr ScriptHashObj (Hash ADDRHASH EraIndependentScript -> ScriptHash ScriptHash Hash ADDRHASH EraIndependentScript "afbc5005df84ba5f8ee93ab435bc5e83067fa1f12f9c42cdd7110386") , DRep -> Delegatee DelegVote (DRep -> Delegatee) -> DRep -> Delegatee forall a b. (a -> b) -> a -> b $ Credential 'DRepRole -> DRep DRepCredential (KeyHash 'DRepRole -> Credential 'DRepRole forall (kr :: KeyRole). KeyHash kr -> Credential kr KeyHashObj (Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash 'DRepRole forall (r :: KeyRole). Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN) "78301005df84ba67fa1f12f95f8ee10335bc5e86c42afbc593ab4cdd")) ) ] , cgConstitution :: Constitution ConwayEra cgConstitution = Constitution ConwayEra forall a. Default a => a def , cgUpgradePParams :: UpgradeConwayPParams Identity cgUpgradePParams = UpgradeConwayPParams { ucppPoolVotingThresholds :: HKD Identity PoolVotingThresholds ucppPoolVotingThresholds = PoolVotingThresholds HKD Identity PoolVotingThresholds forall a. Default a => a def , ucppDRepVotingThresholds :: HKD Identity DRepVotingThresholds ucppDRepVotingThresholds = DRepVotingThresholds HKD Identity DRepVotingThresholds forall a. Default a => a def , ucppCommitteeMinSize :: HKD Identity Word16 ucppCommitteeMinSize = Word16 HKD Identity Word16 0 , ucppCommitteeMaxTermLength :: HKD Identity EpochInterval ucppCommitteeMaxTermLength = Word32 -> EpochInterval EpochInterval Word32 0 , ucppGovActionLifetime :: HKD Identity EpochInterval ucppGovActionLifetime = Word32 -> EpochInterval EpochInterval Word32 0 , ucppGovActionDeposit :: HKD Identity Coin ucppGovActionDeposit = Integer -> Coin Coin Integer 0 , ucppDRepDeposit :: HKD Identity Coin ucppDRepDeposit = Integer -> Coin Coin Integer 0 , ucppDRepActivity :: HKD Identity EpochInterval ucppDRepActivity = Word32 -> EpochInterval EpochInterval Word32 0 , ucppMinFeeRefScriptCostPerByte :: HKD Identity NonNegativeInterval ucppMinFeeRefScriptCostPerByte = HKD Identity NonNegativeInterval NonNegativeInterval forall a. Bounded a => a minBound , ucppPlutusV3CostModel :: HKD Identity CostModel ucppPlutusV3CostModel = CostModel HKD Identity CostModel HasCallStack => CostModel zeroTestingCostModelV3 } }