{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DisambiguateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

module Test.ThreadNet.Infra.Shelley
  ( CoreNode (..)
  , CoreNodeKeyInfo (..)
  , DecentralizationParam (..)
  , KesConfig (..)
  , coreNodeKeys
  , genCoreNode
  , incrementMinorProtVer
  , initialLovelacePerCoreNode
  , mkCredential
  , mkEpochSize
  , mkGenesisConfig
  , mkKesConfig
  , mkKeyHash
  , mkKeyHashVrf
  , mkKeyPair
  , mkLeaderCredentials
  , mkMASetDecentralizationParamTxs
  , mkProtocolShelley
  , mkSetDecentralizationParamTxs
  , mkVerKey
  , networkId
  , tpraosSlotLength
  ) where

import Cardano.Crypto.DSIGN
  ( DSIGNAlgorithm (..)
  , SignKeyDSIGN
  , seedSizeDSIGN
  )
import Cardano.Crypto.KES
  ( KESAlgorithm (..)
  , UnsoundPureKESAlgorithm (..)
  , UnsoundPureSignKeyKES
  , seedSizeKES
  , unsoundPureDeriveVerKeyKES
  , unsoundPureGenKeyKES
  )
import Cardano.Crypto.Seed (mkSeedFromBytes)
import qualified Cardano.Crypto.Seed as Cardano.Crypto
import Cardano.Crypto.VRF
  ( SignKeyVRF
  , deriveVerKeyVRF
  , genKeyVRF
  , seedSizeVRF
  )
import qualified Cardano.Ledger.Allegra.Scripts as SL
import Cardano.Ledger.BaseTypes (boundRational, unNonZero)
import Cardano.Ledger.Hashes
  ( EraIndependentTxBody
  , HashAnnotated (..)
  , SafeHash
  , hashAnnotated
  )
import qualified Cardano.Ledger.Keys as LK
import qualified Cardano.Ledger.Mary.Core as SL
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Ledger.Val as SL
import Cardano.Protocol.Crypto (Crypto, KES, VRF, hashVerKeyVRF)
import Cardano.Protocol.TPraos.OCert
  ( OCert (ocertKESPeriod, ocertN, ocertSigma, ocertVkHot)
  )
import qualified Cardano.Protocol.TPraos.OCert as SL
  ( KESPeriod
  , OCert (OCert)
  , OCertSignable (..)
  )
import Control.Monad.Except (throwError)
import qualified Control.Tracer as Tracer
import qualified Data.ByteString as BS
import Data.Coerce (coerce)
import Data.ListMap (ListMap (ListMap))
import qualified Data.ListMap as ListMap
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (maybeToStrictMaybe)
import Data.Ratio (denominator, numerator)
import qualified Data.Sequence.Strict as Seq
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Word (Word64)
import GHC.Generics (Generic)
import Lens.Micro
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.BlockchainTime
import Ouroboros.Consensus.Config.SecurityParam
import Ouroboros.Consensus.Node.ProtocolInfo
import Ouroboros.Consensus.Protocol.Praos.AgentClient
  ( KESAgentClientTrace
  , KESAgentContext
  )
import Ouroboros.Consensus.Protocol.Praos.Common
  ( PraosCanBeLeader (PraosCanBeLeader)
  , PraosCredentialsSource (..)
  , praosCanBeLeaderColdVerKey
  , praosCanBeLeaderCredentialsSource
  , praosCanBeLeaderSignKeyVRF
  )
import Ouroboros.Consensus.Protocol.TPraos
import Ouroboros.Consensus.Shelley.Eras (ShelleyEra)
import Ouroboros.Consensus.Shelley.Ledger
  ( GenTx (..)
  , ShelleyBasedEra
  , ShelleyBlock
  , ShelleyCompatible
  , mkShelleyTx
  )
import Ouroboros.Consensus.Shelley.Node
import Ouroboros.Consensus.Shelley.Protocol.Abstract (ProtoCrypto)
import Ouroboros.Consensus.Util.Assert
import Quiet (Quiet (..))
import qualified Test.Cardano.Ledger.Core.KeyPair as TL
  ( KeyPair (..)
  , mkWitnessesVKey
  )
import qualified Test.Cardano.Ledger.Shelley.Generator.Core as Gen
import Test.Cardano.Ledger.Shelley.Utils (unsafeBoundRational)
import Test.QuickCheck
import Test.Util.Orphans.Arbitrary ()
import Test.Util.Slots (NumSlots (..))
import Test.Util.Time (dawnOfTime)

{-------------------------------------------------------------------------------
  The decentralization parameter
-------------------------------------------------------------------------------}

-- | A suitable value for the @d@ protocol parameter
--
-- In the range @0@ to @1@, inclusive. Beware the misnomer: @0@ means fully
-- decentralized, and @1@ means fully centralized.
newtype DecentralizationParam
  = DecentralizationParam {DecentralizationParam -> Rational
decentralizationParamToRational :: Rational}
  deriving (DecentralizationParam -> DecentralizationParam -> Bool
(DecentralizationParam -> DecentralizationParam -> Bool)
-> (DecentralizationParam -> DecentralizationParam -> Bool)
-> Eq DecentralizationParam
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DecentralizationParam -> DecentralizationParam -> Bool
== :: DecentralizationParam -> DecentralizationParam -> Bool
$c/= :: DecentralizationParam -> DecentralizationParam -> Bool
/= :: DecentralizationParam -> DecentralizationParam -> Bool
Eq, (forall x. DecentralizationParam -> Rep DecentralizationParam x)
-> (forall x. Rep DecentralizationParam x -> DecentralizationParam)
-> Generic DecentralizationParam
forall x. Rep DecentralizationParam x -> DecentralizationParam
forall x. DecentralizationParam -> Rep DecentralizationParam x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DecentralizationParam -> Rep DecentralizationParam x
from :: forall x. DecentralizationParam -> Rep DecentralizationParam x
$cto :: forall x. Rep DecentralizationParam x -> DecentralizationParam
to :: forall x. Rep DecentralizationParam x -> DecentralizationParam
Generic, Eq DecentralizationParam
Eq DecentralizationParam =>
(DecentralizationParam -> DecentralizationParam -> Ordering)
-> (DecentralizationParam -> DecentralizationParam -> Bool)
-> (DecentralizationParam -> DecentralizationParam -> Bool)
-> (DecentralizationParam -> DecentralizationParam -> Bool)
-> (DecentralizationParam -> DecentralizationParam -> Bool)
-> (DecentralizationParam
    -> DecentralizationParam -> DecentralizationParam)
-> (DecentralizationParam
    -> DecentralizationParam -> DecentralizationParam)
-> Ord DecentralizationParam
DecentralizationParam -> DecentralizationParam -> Bool
DecentralizationParam -> DecentralizationParam -> Ordering
DecentralizationParam
-> DecentralizationParam -> DecentralizationParam
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: DecentralizationParam -> DecentralizationParam -> Ordering
compare :: DecentralizationParam -> DecentralizationParam -> Ordering
$c< :: DecentralizationParam -> DecentralizationParam -> Bool
< :: DecentralizationParam -> DecentralizationParam -> Bool
$c<= :: DecentralizationParam -> DecentralizationParam -> Bool
<= :: DecentralizationParam -> DecentralizationParam -> Bool
$c> :: DecentralizationParam -> DecentralizationParam -> Bool
> :: DecentralizationParam -> DecentralizationParam -> Bool
$c>= :: DecentralizationParam -> DecentralizationParam -> Bool
>= :: DecentralizationParam -> DecentralizationParam -> Bool
$cmax :: DecentralizationParam
-> DecentralizationParam -> DecentralizationParam
max :: DecentralizationParam
-> DecentralizationParam -> DecentralizationParam
$cmin :: DecentralizationParam
-> DecentralizationParam -> DecentralizationParam
min :: DecentralizationParam
-> DecentralizationParam -> DecentralizationParam
Ord)
  deriving Int -> DecentralizationParam -> ShowS
[DecentralizationParam] -> ShowS
DecentralizationParam -> String
(Int -> DecentralizationParam -> ShowS)
-> (DecentralizationParam -> String)
-> ([DecentralizationParam] -> ShowS)
-> Show DecentralizationParam
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DecentralizationParam -> ShowS
showsPrec :: Int -> DecentralizationParam -> ShowS
$cshow :: DecentralizationParam -> String
show :: DecentralizationParam -> String
$cshowList :: [DecentralizationParam] -> ShowS
showList :: [DecentralizationParam] -> ShowS
Show via (Quiet DecentralizationParam)

-- | A fraction with denominator @10@ and numerator @0@ to @10@ inclusive
instance Arbitrary DecentralizationParam where
  arbitrary :: Gen DecentralizationParam
arbitrary = do
    let d :: Integer
d = Integer
10
    n <- (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
d)
    pure $ DecentralizationParam $ fromInteger n / fromInteger d

{-------------------------------------------------------------------------------
  Important constants
-------------------------------------------------------------------------------}

tpraosSlotLength :: SlotLength
tpraosSlotLength :: SlotLength
tpraosSlotLength = Integer -> SlotLength
slotLengthFromSec Integer
2

{-------------------------------------------------------------------------------
  CoreNode secrets/etc
-------------------------------------------------------------------------------}

data CoreNode c = CoreNode
  { forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnGenesisKey :: !(SignKeyDSIGN LK.DSIGN)
  , forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey :: !(SignKeyDSIGN LK.DSIGN)
  -- ^ Cold delegate key. The hash of the corresponding verification
  -- (public) key will be used as the payment credential.
  , forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnStakingKey :: !(SignKeyDSIGN LK.DSIGN)
  -- ^ The hash of the corresponding verification (public) key will be
  -- used as the staking credential.
  , forall c. CoreNode c -> SignKeyVRF (VRF c)
cnVRF :: !(SignKeyVRF (VRF c))
  , forall c. CoreNode c -> UnsoundPureSignKeyKES (KES c)
cnKES :: !(UnsoundPureSignKeyKES (KES c))
  , forall c. CoreNode c -> OCert c
cnOCert :: !(SL.OCert c)
  }

data CoreNodeKeyInfo c = CoreNodeKeyInfo
  { forall c. CoreNodeKeyInfo c -> (KeyPair Payment, KeyPair Staking)
cnkiKeyPair ::
      ( TL.KeyPair SL.Payment
      , TL.KeyPair SL.Staking
      )
  , forall c.
CoreNodeKeyInfo c
-> (KeyPair GenesisRole, AllIssuerKeys c GenesisDelegate)
cnkiCoreNode ::
      ( TL.KeyPair SL.GenesisRole
      , Gen.AllIssuerKeys c SL.GenesisDelegate
      )
  }

coreNodeKeys :: CoreNode c -> CoreNodeKeyInfo c
coreNodeKeys :: forall c. CoreNode c -> CoreNodeKeyInfo c
coreNodeKeys CoreNode{SignKeyDSIGN DSIGN
cnGenesisKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnGenesisKey :: SignKeyDSIGN DSIGN
cnGenesisKey, SignKeyDSIGN DSIGN
cnDelegateKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey :: SignKeyDSIGN DSIGN
cnDelegateKey, SignKeyDSIGN DSIGN
cnStakingKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnStakingKey :: SignKeyDSIGN DSIGN
cnStakingKey} =
  CoreNodeKeyInfo
    { cnkiCoreNode :: (KeyPair GenesisRole, AllIssuerKeys c GenesisDelegate)
cnkiCoreNode =
        ( SignKeyDSIGN DSIGN -> KeyPair GenesisRole
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyPair r
mkKeyPair SignKeyDSIGN DSIGN
cnGenesisKey
        , Gen.AllIssuerKeys
            { aikCold :: KeyPair GenesisDelegate
Gen.aikCold = SignKeyDSIGN DSIGN -> KeyPair GenesisDelegate
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyPair r
mkKeyPair SignKeyDSIGN DSIGN
cnDelegateKey
            , -- 'CoreNodeKeyInfo' is used for all sorts of generators, not
              -- only transaction generators. To generate transactions we
              -- don't need all these keys, hence the 'error's.
              aikVrf :: VRFKeyPair c
Gen.aikVrf = String -> VRFKeyPair c
forall a. HasCallStack => String -> a
error String
"vrf used while generating transactions"
            , aikHot :: NonEmpty (KESPeriod, KESKeyPair c)
Gen.aikHot = String -> NonEmpty (KESPeriod, KESKeyPair c)
forall a. HasCallStack => String -> a
error String
"hot used while generating transactions"
            , aikColdKeyHash :: KeyHash GenesisDelegate
Gen.aikColdKeyHash = String -> KeyHash GenesisDelegate
forall a. HasCallStack => String -> a
error String
"hk used while generating transactions"
            }
        )
    , cnkiKeyPair :: (KeyPair Payment, KeyPair Staking)
cnkiKeyPair = (SignKeyDSIGN DSIGN -> KeyPair Payment
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyPair r
mkKeyPair SignKeyDSIGN DSIGN
cnDelegateKey, SignKeyDSIGN DSIGN -> KeyPair Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyPair r
mkKeyPair SignKeyDSIGN DSIGN
cnStakingKey)
    }

genCoreNode ::
  forall c.
  Crypto c =>
  SL.KESPeriod ->
  Gen (CoreNode c)
genCoreNode :: forall c. Crypto c => KESPeriod -> Gen (CoreNode c)
genCoreNode KESPeriod
startKESPeriod = do
  genKey <- Seed -> SignKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => Seed -> SignKeyDSIGN v
genKeyDSIGN (Seed -> SignKeyDSIGN DSIGN)
-> Gen Seed -> Gen (SignKeyDSIGN DSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Gen Seed
forall a. Integral a => a -> Gen Seed
genSeed (Proxy DSIGN -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
seedSizeDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @LK.DSIGN))
  delKey <- genKeyDSIGN <$> genSeed (seedSizeDSIGN (Proxy @LK.DSIGN))
  stkKey <- genKeyDSIGN <$> genSeed (seedSizeDSIGN (Proxy @LK.DSIGN))
  vrfKey <- genKeyVRF <$> genSeed (seedSizeVRF (Proxy @(VRF c)))
  kesKey <- unsoundPureGenKeyKES <$> genSeed (seedSizeKES (Proxy @(KES c)))
  let kesPub = UnsoundPureSignKeyKES (KES c) -> VerKeyKES (KES c)
forall v.
UnsoundPureKESAlgorithm v =>
UnsoundPureSignKeyKES v -> VerKeyKES v
unsoundPureDeriveVerKeyKES UnsoundPureSignKeyKES (KES c)
kesKey
      sigma =
        SignKeyDSIGN DSIGN
-> OCertSignable c -> SignedDSIGN DSIGN (OCertSignable c)
forall a.
Signable DSIGN a =>
SignKeyDSIGN DSIGN -> a -> SignedDSIGN DSIGN a
LK.signedDSIGN
          SignKeyDSIGN DSIGN
delKey
          (VerKeyKES (KES c) -> Word64 -> KESPeriod -> OCertSignable c
forall c.
VerKeyKES (KES c) -> Word64 -> KESPeriod -> OCertSignable c
SL.OCertSignable VerKeyKES (KES c)
kesPub Word64
certificateIssueNumber KESPeriod
startKESPeriod)
  let ocert =
        SL.OCert
          { ocertVkHot :: VerKeyKES (KES c)
ocertVkHot = VerKeyKES (KES c)
kesPub
          , ocertN :: Word64
ocertN = Word64
certificateIssueNumber
          , ocertKESPeriod :: KESPeriod
ocertKESPeriod = KESPeriod
startKESPeriod
          , ocertSigma :: SignedDSIGN DSIGN (OCertSignable c)
ocertSigma = SignedDSIGN DSIGN (OCertSignable c)
sigma
          }
  return
    CoreNode
      { cnGenesisKey = genKey
      , cnDelegateKey = delKey
      , cnStakingKey = stkKey
      , cnVRF = vrfKey
      , cnKES = kesKey
      , cnOCert = ocert
      }
 where
  certificateIssueNumber :: Word64
certificateIssueNumber = Word64
0

  genBytes :: Integral a => a -> Gen BS.ByteString
  genBytes :: forall a. Integral a => a -> Gen ByteString
genBytes a
nbBytes = [Word8] -> ByteString
BS.pack ([Word8] -> ByteString) -> Gen [Word8] -> Gen ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf (a -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral a
nbBytes) Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

  genSeed :: Integral a => a -> Gen Cardano.Crypto.Seed
  genSeed :: forall a. Integral a => a -> Gen Seed
genSeed = (ByteString -> Seed) -> Gen ByteString -> Gen Seed
forall a b. (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Seed
mkSeedFromBytes (Gen ByteString -> Gen Seed)
-> (a -> Gen ByteString) -> a -> Gen Seed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Gen ByteString
forall a. Integral a => a -> Gen ByteString
genBytes

mkLeaderCredentials :: CoreNode c -> ShelleyLeaderCredentials c
mkLeaderCredentials :: forall c. CoreNode c -> ShelleyLeaderCredentials c
mkLeaderCredentials CoreNode{SignKeyDSIGN DSIGN
cnDelegateKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey :: SignKeyDSIGN DSIGN
cnDelegateKey, SignKeyVRF (VRF c)
cnVRF :: forall c. CoreNode c -> SignKeyVRF (VRF c)
cnVRF :: SignKeyVRF (VRF c)
cnVRF, UnsoundPureSignKeyKES (KES c)
cnKES :: forall c. CoreNode c -> UnsoundPureSignKeyKES (KES c)
cnKES :: UnsoundPureSignKeyKES (KES c)
cnKES, OCert c
cnOCert :: forall c. CoreNode c -> OCert c
cnOCert :: OCert c
cnOCert} =
  ShelleyLeaderCredentials
    { shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader =
        PraosCanBeLeader
          { praosCanBeLeaderCredentialsSource :: PraosCredentialsSource c
praosCanBeLeaderCredentialsSource = OCert c
-> UnsoundPureSignKeyKES (KES c) -> PraosCredentialsSource c
forall c.
OCert c
-> UnsoundPureSignKeyKES (KES c) -> PraosCredentialsSource c
PraosCredentialsUnsound OCert c
cnOCert UnsoundPureSignKeyKES (KES c)
cnKES
          , praosCanBeLeaderColdVerKey :: VKey BlockIssuer
praosCanBeLeaderColdVerKey = VerKeyDSIGN DSIGN -> VKey BlockIssuer
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> VKey BlockIssuer)
-> VerKeyDSIGN DSIGN -> VKey BlockIssuer
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
cnDelegateKey
          , praosCanBeLeaderSignKeyVRF :: SignKeyVRF (VRF c)
praosCanBeLeaderSignKeyVRF = SignKeyVRF (VRF c)
cnVRF
          }
    , shelleyLeaderCredentialsLabel :: Text
shelleyLeaderCredentialsLabel = Text
"ThreadNet"
    }

{-------------------------------------------------------------------------------
  KES configuration
-------------------------------------------------------------------------------}

-- | Currently @'maxEvolutions' * 'slotsPerEvolution'@ is the max number of
-- slots the test can run without needing new ocerts.
--
-- TODO This limitation may be lifted by PR #2107, see
-- <https://github.com/IntersectMBO/ouroboros-network/issues/2107>.
data KesConfig = KesConfig
  { KesConfig -> Word64
maxEvolutions :: Word64
  , KesConfig -> Word64
slotsPerEvolution :: Word64
  }

-- | A 'KesConfig' that will not require more evolutions than this test's crypto
-- allows.
mkKesConfig ::
  forall proxy c.
  Crypto c =>
  proxy c -> NumSlots -> KesConfig
mkKesConfig :: forall (proxy :: * -> *) c.
Crypto c =>
proxy c -> NumSlots -> KesConfig
mkKesConfig proxy c
_ (NumSlots Word64
t) =
  KesConfig
    { Word64
maxEvolutions :: Word64
maxEvolutions :: Word64
maxEvolutions
    , slotsPerEvolution :: Word64
slotsPerEvolution = Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
divCeiling Word64
t Word64
maxEvolutions
    }
 where
  maxEvolutions :: Word64
maxEvolutions = Word -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word64) -> Word -> Word64
forall a b. (a -> b) -> a -> b
$ Proxy (KES c) -> Word
forall v (proxy :: * -> *). KESAlgorithm v => proxy v -> Word
forall (proxy :: * -> *). proxy (KES c) -> Word
totalPeriodsKES (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(KES c))

  -- \| Like 'div', but rounds-up.
  divCeiling :: Integral a => a -> a -> a
  divCeiling :: forall a. Integral a => a -> a -> a
divCeiling a
n a
d = a
q a -> a -> a
forall a. Num a => a -> a -> a
+ a -> a -> a
forall a. Ord a => a -> a -> a
min a
1 a
r
   where
    (a
q, a
r) = a -> a -> (a, a)
forall a. Integral a => a -> a -> (a, a)
quotRem a
n a
d

{-------------------------------------------------------------------------------
  TPraos node configuration
-------------------------------------------------------------------------------}

-- | The epoch size, given @k@ and @f@.
--
-- INVARIANT: @10 * k / f@ must be a whole number.
mkEpochSize :: SecurityParam -> Rational -> EpochSize
mkEpochSize :: SecurityParam -> Rational -> EpochSize
mkEpochSize (SecurityParam NonZero Word64
k) Rational
f =
  if Word64
r Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word64
0
    then String -> EpochSize
forall a. HasCallStack => String -> a
error String
"10 * k / f must be a whole number"
    else
      Word64 -> EpochSize
EpochSize Word64
q
 where
  n :: Integer
n = Rational -> Integer
forall a. Ratio a -> a
numerator Rational
f
  d :: Integer
d = Rational -> Integer
forall a. Ratio a -> a
denominator Rational
f

  (Word64
q, Word64
r) = Word64 -> Word64 -> (Word64, Word64)
forall a. Integral a => a -> a -> (a, a)
quotRem (Word64
10 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
k Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
d) (Integer -> Word64
forall a. Num a => Integer -> a
fromInteger Integer
n)

-- | Note: a KES algorithm supports a particular max number of KES evolutions,
-- but we can configure a potentially lower maximum for the ledger, that's why
-- we take it as an argument.
mkGenesisConfig ::
  forall c.
  PraosCrypto c =>
  -- | Initial protocol version
  ProtVer ->
  SecurityParam ->
  -- | Initial active slot coefficient
  Rational ->
  DecentralizationParam ->
  -- | Max Lovelace supply, must be >= #coreNodes * initialLovelacePerCoreNode
  Word64 ->
  SlotLength ->
  KesConfig ->
  [CoreNode c] ->
  ShelleyGenesis
mkGenesisConfig :: forall c.
PraosCrypto c =>
ProtVer
-> SecurityParam
-> Rational
-> DecentralizationParam
-> Word64
-> SlotLength
-> KesConfig
-> [CoreNode c]
-> ShelleyGenesis
mkGenesisConfig ProtVer
pVer SecurityParam
k Rational
f DecentralizationParam
d Word64
maxLovelaceSupply SlotLength
slotLength KesConfig
kesCfg [CoreNode c]
coreNodes =
  Either String () -> ShelleyGenesis -> ShelleyGenesis
forall a. HasCallStack => Either String () -> a -> a
assertWithMsg Either String ()
checkMaxLovelaceSupply (ShelleyGenesis -> ShelleyGenesis)
-> ShelleyGenesis -> ShelleyGenesis
forall a b. (a -> b) -> a -> b
$
    ShelleyGenesis
      { -- Matches the start of the ThreadNet tests
        sgSystemStart :: UTCTime
sgSystemStart = UTCTime
dawnOfTime
      , sgNetworkMagic :: Word32
sgNetworkMagic = Word32
0
      , sgNetworkId :: Network
sgNetworkId = Network
networkId
      , sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff = Rational -> PositiveUnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational Rational
f
      , sgSecurityParam :: NonZero Word64
sgSecurityParam = SecurityParam -> NonZero Word64
maxRollbacks SecurityParam
k
      , sgEpochLength :: EpochSize
sgEpochLength = SecurityParam -> Rational -> EpochSize
mkEpochSize SecurityParam
k Rational
f
      , sgSlotsPerKESPeriod :: Word64
sgSlotsPerKESPeriod = KesConfig -> Word64
slotsPerEvolution KesConfig
kesCfg
      , sgMaxKESEvolutions :: Word64
sgMaxKESEvolutions = KesConfig -> Word64
maxEvolutions KesConfig
kesCfg
      , sgSlotLength :: NominalDiffTimeMicro
sgSlotLength = NominalDiffTime -> NominalDiffTimeMicro
SL.toNominalDiffTimeMicroWithRounding (NominalDiffTime -> NominalDiffTimeMicro)
-> NominalDiffTime -> NominalDiffTimeMicro
forall a b. (a -> b) -> a -> b
$ SlotLength -> NominalDiffTime
getSlotLength SlotLength
slotLength
      , sgUpdateQuorum :: Word64
sgUpdateQuorum = Word64
quorum
      , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = Word64
maxLovelaceSupply
      , sgProtocolParams :: PParams ShelleyEra
sgProtocolParams = PParams ShelleyEra
pparams
      , sgGenDelegs :: Map (KeyHash GenesisRole) GenDelegPair
sgGenDelegs = Map (KeyHash GenesisRole) GenDelegPair
coreNodesToGenesisMapping
      , sgInitialFunds :: ListMap Addr Coin
sgInitialFunds = Map Addr Coin -> ListMap Addr Coin
forall k v. Map k v -> ListMap k v
ListMap.fromMap Map Addr Coin
initialFunds
      , sgStaking :: ShelleyGenesisStaking
sgStaking = ShelleyGenesisStaking
initialStake
      }
 where
  checkMaxLovelaceSupply :: Either String ()
  checkMaxLovelaceSupply :: Either String ()
checkMaxLovelaceSupply
    | Word64
maxLovelaceSupply
        Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CoreNode c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreNode c]
coreNodes) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
initialLovelacePerCoreNode =
        () -> Either String ()
forall a. a -> Either String a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    | Bool
otherwise =
        String -> Either String ()
forall a. String -> Either String a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
          [String] -> String
unwords
            [ String
"Lovelace supply ="
            , Word64 -> String
forall a. Show a => a -> String
show Word64
maxLovelaceSupply
            , String
"but must be at least"
            , Word64 -> String
forall a. Show a => a -> String
show (Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CoreNode c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreNode c]
coreNodes) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
initialLovelacePerCoreNode)
            ]

  quorum :: Word64
  quorum :: Word64
quorum = Word64
nbCoreNodes Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
`min` ((Word64
nbCoreNodes Word64 -> Word64 -> Word64
forall a. Integral a => a -> a -> a
`div` Word64
2) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1)
   where
    nbCoreNodes :: Word64
nbCoreNodes = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([CoreNode c] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [CoreNode c]
coreNodes)

  pparams :: SL.PParams ShelleyEra
  pparams :: PParams ShelleyEra
pparams =
    PParams ShelleyEra
forall era. EraPParams era => PParams era
SL.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
SL.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
.~ Rational -> UnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (DecentralizationParam -> Rational
decentralizationParamToRational DecentralizationParam
d)
      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
SL.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
10000 -- TODO
      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
SL.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
1000 -- TODO
      PParams ShelleyEra
-> (PParams ShelleyEra -> PParams ShelleyEra) -> PParams ShelleyEra
forall a b. a -> (a -> b) -> b
& (ProtVer -> Identity ProtVer)
-> PParams ShelleyEra -> Identity (PParams ShelleyEra)
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams ShelleyEra) ProtVer
SL.ppProtocolVersionL ((ProtVer -> Identity ProtVer)
 -> PParams ShelleyEra -> Identity (PParams ShelleyEra))
-> ProtVer -> PParams ShelleyEra -> PParams ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer
pVer

  coreNodesToGenesisMapping ::
    Map (SL.KeyHash SL.GenesisRole) SL.GenDelegPair
  coreNodesToGenesisMapping :: Map (KeyHash GenesisRole) GenDelegPair
coreNodesToGenesisMapping =
    [(KeyHash GenesisRole, GenDelegPair)]
-> Map (KeyHash GenesisRole) GenDelegPair
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ let
          gkh :: SL.KeyHash SL.GenesisRole
          gkh :: KeyHash GenesisRole
gkh = VKey GenesisRole -> KeyHash GenesisRole
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey GenesisRole -> KeyHash GenesisRole)
-> (VerKeyDSIGN DSIGN -> VKey GenesisRole)
-> VerKeyDSIGN DSIGN
-> KeyHash GenesisRole
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN DSIGN -> VKey GenesisRole
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> KeyHash GenesisRole)
-> VerKeyDSIGN DSIGN -> KeyHash GenesisRole
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
cnGenesisKey

          gdpair :: SL.GenDelegPair
          gdpair :: GenDelegPair
gdpair =
            KeyHash GenesisDelegate
-> VRFVerKeyHash GenDelegVRF -> GenDelegPair
SL.GenDelegPair
              (VKey GenesisDelegate -> KeyHash GenesisDelegate
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey GenesisDelegate -> KeyHash GenesisDelegate)
-> (VerKeyDSIGN DSIGN -> VKey GenesisDelegate)
-> VerKeyDSIGN DSIGN
-> KeyHash GenesisDelegate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN DSIGN -> VKey GenesisDelegate
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> KeyHash GenesisDelegate)
-> VerKeyDSIGN DSIGN -> KeyHash GenesisDelegate
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
cnDelegateKey)
              (forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @c (VerKeyVRF (VRF c) -> VRFVerKeyHash GenDelegVRF)
-> VerKeyVRF (VRF c) -> VRFVerKeyHash GenDelegVRF
forall a b. (a -> b) -> a -> b
$ SignKeyVRF (VRF c) -> VerKeyVRF (VRF c)
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF (VRF c)
cnVRF)
         in
          (KeyHash GenesisRole
gkh, GenDelegPair
gdpair)
      | CoreNode{SignKeyDSIGN DSIGN
cnGenesisKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnGenesisKey :: SignKeyDSIGN DSIGN
cnGenesisKey, SignKeyDSIGN DSIGN
cnDelegateKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey :: SignKeyDSIGN DSIGN
cnDelegateKey, SignKeyVRF (VRF c)
cnVRF :: forall c. CoreNode c -> SignKeyVRF (VRF c)
cnVRF :: SignKeyVRF (VRF c)
cnVRF} <- [CoreNode c]
coreNodes
      ]

  initialFunds :: Map SL.Addr SL.Coin
  initialFunds :: Map Addr Coin
initialFunds =
    [(Addr, Coin)] -> Map Addr Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (Addr
addr, Coin
coin)
      | CoreNode{SignKeyDSIGN DSIGN
cnDelegateKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey :: SignKeyDSIGN DSIGN
cnDelegateKey, SignKeyDSIGN DSIGN
cnStakingKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnStakingKey :: SignKeyDSIGN DSIGN
cnStakingKey} <- [CoreNode c]
coreNodes
      , let addr :: Addr
addr =
              Network -> Credential Payment -> StakeReference -> Addr
SL.Addr
                Network
networkId
                (SignKeyDSIGN DSIGN -> Credential Payment
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential SignKeyDSIGN DSIGN
cnDelegateKey)
                (Credential Staking -> StakeReference
SL.StakeRefBase (SignKeyDSIGN DSIGN -> Credential Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential SignKeyDSIGN DSIGN
cnStakingKey))
            coin :: Coin
coin = Integer -> Coin
SL.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
initialLovelacePerCoreNode
      ]

  -- In this initial stake, each core node delegates its stake to itself.
  initialStake :: ShelleyGenesisStaking
  initialStake :: ShelleyGenesisStaking
initialStake =
    ShelleyGenesisStaking
      { sgsPools :: ListMap (KeyHash StakePool) StakePoolParams
sgsPools =
          [(KeyHash StakePool, StakePoolParams)]
-> ListMap (KeyHash StakePool) StakePoolParams
forall k v. [(k, v)] -> ListMap k v
ListMap
            [ (KeyHash StakePool
pk, StakePoolParams
pp)
            | pp :: StakePoolParams
pp@SL.StakePoolParams{sppId :: StakePoolParams -> KeyHash StakePool
sppId = KeyHash StakePool
pk} <- Map (KeyHash StakePool) StakePoolParams -> [StakePoolParams]
forall k a. Map k a -> [a]
Map.elems Map (KeyHash StakePool) StakePoolParams
coreNodeToPoolMapping
            ]
      , -- The staking key maps to the key hash of the pool, which is set to the
        -- "delegate key" in order that nodes may issue blocks both as delegates
        -- and as stake pools.
        sgsStake :: ListMap (KeyHash Staking) (KeyHash StakePool)
sgsStake =
          [(KeyHash Staking, KeyHash StakePool)]
-> ListMap (KeyHash Staking) (KeyHash StakePool)
forall k v. [(k, v)] -> ListMap k v
ListMap
            [ ( VKey Staking -> KeyHash Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey Staking -> KeyHash Staking)
-> (VerKeyDSIGN DSIGN -> VKey Staking)
-> VerKeyDSIGN DSIGN
-> KeyHash Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN DSIGN -> VKey Staking
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> KeyHash Staking)
-> VerKeyDSIGN DSIGN -> KeyHash Staking
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
cnStakingKey
              , VKey StakePool -> KeyHash StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey StakePool -> KeyHash StakePool)
-> (VerKeyDSIGN DSIGN -> VKey StakePool)
-> VerKeyDSIGN DSIGN
-> KeyHash StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN DSIGN -> VKey StakePool
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> KeyHash StakePool)
-> VerKeyDSIGN DSIGN -> KeyHash StakePool
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
cnDelegateKey
              )
            | CoreNode{SignKeyDSIGN DSIGN
cnDelegateKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey :: SignKeyDSIGN DSIGN
cnDelegateKey, SignKeyDSIGN DSIGN
cnStakingKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnStakingKey :: SignKeyDSIGN DSIGN
cnStakingKey} <- [CoreNode c]
coreNodes
            ]
      }
   where
    coreNodeToPoolMapping ::
      Map (SL.KeyHash SL.StakePool) SL.StakePoolParams
    coreNodeToPoolMapping :: Map (KeyHash StakePool) StakePoolParams
coreNodeToPoolMapping =
      [(KeyHash StakePool, StakePoolParams)]
-> Map (KeyHash StakePool) StakePoolParams
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ ( VKey StakePool -> KeyHash StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey StakePool -> KeyHash StakePool)
-> (SignKeyDSIGN DSIGN -> VKey StakePool)
-> SignKeyDSIGN DSIGN
-> KeyHash StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN DSIGN -> VKey StakePool
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> VKey StakePool)
-> (SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN)
-> SignKeyDSIGN DSIGN
-> VKey StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (SignKeyDSIGN DSIGN -> KeyHash StakePool)
-> SignKeyDSIGN DSIGN -> KeyHash StakePool
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN
cnStakingKey
          , SL.StakePoolParams
              { sppId :: KeyHash StakePool
SL.sppId = KeyHash StakePool
poolHash
              , sppVrf :: VRFVerKeyHash StakePoolVRF
SL.sppVrf = VRFVerKeyHash StakePoolVRF
vrfHash
              , -- Each core node pledges its full stake to the pool.
                sppPledge :: Coin
SL.sppPledge = Integer -> Coin
SL.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
initialLovelacePerCoreNode
              , sppCost :: Coin
SL.sppCost = Integer -> Coin
SL.Coin Integer
1
              , sppMargin :: UnitInterval
SL.sppMargin = UnitInterval
forall a. Bounded a => a
minBound
              , -- Reward accounts live in a separate "namespace" to other
                -- accounts, so it should be fine to use the same address.
                sppAccountAddress :: AccountAddress
SL.sppAccountAddress = Network -> AccountId -> AccountAddress
SL.AccountAddress Network
networkId (AccountId -> AccountAddress) -> AccountId -> AccountAddress
forall a b. (a -> b) -> a -> b
$ Credential Staking -> AccountId
SL.AccountId (SignKeyDSIGN DSIGN -> Credential Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential SignKeyDSIGN DSIGN
cnDelegateKey)
              , sppOwners :: Set (KeyHash Staking)
SL.sppOwners = KeyHash Staking -> Set (KeyHash Staking)
forall a. a -> Set a
Set.singleton KeyHash Staking
poolOwnerHash
              , sppRelays :: StrictSeq StakePoolRelay
SL.sppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
Seq.empty
              , sppMetadata :: StrictMaybe PoolMetadata
SL.sppMetadata = StrictMaybe PoolMetadata
forall a. StrictMaybe a
SL.SNothing
              }
          )
        | CoreNode{SignKeyDSIGN DSIGN
cnDelegateKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey :: SignKeyDSIGN DSIGN
cnDelegateKey, SignKeyDSIGN DSIGN
cnStakingKey :: forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnStakingKey :: SignKeyDSIGN DSIGN
cnStakingKey, SignKeyVRF (VRF c)
cnVRF :: forall c. CoreNode c -> SignKeyVRF (VRF c)
cnVRF :: SignKeyVRF (VRF c)
cnVRF} <- [CoreNode c]
coreNodes
        , -- The pool and owner hashes are derived from the same key, but
        -- use different hashing schemes
        let poolHash :: KeyHash StakePool
poolHash = VKey StakePool -> KeyHash StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey StakePool -> KeyHash StakePool)
-> (VerKeyDSIGN DSIGN -> VKey StakePool)
-> VerKeyDSIGN DSIGN
-> KeyHash StakePool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN DSIGN -> VKey StakePool
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> KeyHash StakePool)
-> VerKeyDSIGN DSIGN -> KeyHash StakePool
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
cnDelegateKey
        , let poolOwnerHash :: KeyHash Staking
poolOwnerHash = VKey Staking -> KeyHash Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey Staking -> KeyHash Staking)
-> (VerKeyDSIGN DSIGN -> VKey Staking)
-> VerKeyDSIGN DSIGN
-> KeyHash Staking
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN DSIGN -> VKey Staking
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> KeyHash Staking)
-> VerKeyDSIGN DSIGN -> KeyHash Staking
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
cnDelegateKey
        , let vrfHash :: VRFVerKeyHash StakePoolVRF
vrfHash = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @c (VerKeyVRF (VRF c) -> VRFVerKeyHash StakePoolVRF)
-> VerKeyVRF (VRF c) -> VRFVerKeyHash StakePoolVRF
forall a b. (a -> b) -> a -> b
$ SignKeyVRF (VRF c) -> VerKeyVRF (VRF c)
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF (VRF c)
cnVRF
        ]

mkProtocolShelley ::
  forall m c.
  ( KESAgentContext c m
  , ShelleyCompatible (TPraos c) ShelleyEra
  ) =>
  ShelleyGenesis ->
  SL.Nonce ->
  ProtVer ->
  CoreNode c ->
  ( ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra)
  , Tracer.Tracer m KESAgentClientTrace -> m [MkBlockForging m (ShelleyBlock (TPraos c) ShelleyEra)]
  )
mkProtocolShelley :: forall (m :: * -> *) c.
(KESAgentContext c m, ShelleyCompatible (TPraos c) ShelleyEra) =>
ShelleyGenesis
-> Nonce
-> ProtVer
-> CoreNode c
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    Tracer m KESAgentClientTrace
    -> m [MkBlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
mkProtocolShelley ShelleyGenesis
genesis Nonce
initialNonce ProtVer
protVer CoreNode c
coreNode =
  ShelleyGenesis
-> ProtocolParamsShelleyBased c
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    Tracer m KESAgentClientTrace
    -> m [MkBlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
forall (m :: * -> *) c.
(IOLike m, AgentCrypto c, ShelleyCompatible (TPraos c) ShelleyEra,
 TxLimits (ShelleyBlock (TPraos c) ShelleyEra), MonadKESAgent m) =>
ShelleyGenesis
-> ProtocolParamsShelleyBased c
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    Tracer m KESAgentClientTrace
    -> m [MkBlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
protocolInfoShelley
    ShelleyGenesis
genesis
    ProtocolParamsShelleyBased
      { shelleyBasedInitialNonce :: Nonce
shelleyBasedInitialNonce = Nonce
initialNonce
      , shelleyBasedLeaderCredentials :: [ShelleyLeaderCredentials c]
shelleyBasedLeaderCredentials = [CoreNode c -> ShelleyLeaderCredentials c
forall c. CoreNode c -> ShelleyLeaderCredentials c
mkLeaderCredentials CoreNode c
coreNode]
      }
    ProtVer
protVer

{-------------------------------------------------------------------------------
  Necessary transactions for updating the 'DecentralizationParam'
-------------------------------------------------------------------------------}

incrementMinorProtVer :: SL.ProtVer -> SL.ProtVer
incrementMinorProtVer :: ProtVer -> ProtVer
incrementMinorProtVer (SL.ProtVer Version
major Natural
minor) = Version -> Natural -> ProtVer
SL.ProtVer Version
major (Natural -> Natural
forall a. Enum a => a -> a
succ Natural
minor)

mkSetDecentralizationParamTxs ::
  forall c.
  ShelleyBasedEra ShelleyEra =>
  [CoreNode c] ->
  -- | The proposed protocol version
  ProtVer ->
  -- | The TTL
  SlotNo ->
  -- | The new value
  DecentralizationParam ->
  [GenTx (ShelleyBlock (TPraos c) ShelleyEra)]
mkSetDecentralizationParamTxs :: forall c.
ShelleyBasedEra ShelleyEra =>
[CoreNode c]
-> ProtVer
-> SlotNo
-> DecentralizationParam
-> [GenTx (ShelleyBlock (TPraos c) ShelleyEra)]
mkSetDecentralizationParamTxs [CoreNode c]
coreNodes ProtVer
pVer SlotNo
ttl DecentralizationParam
dNew =
  (GenTx (ShelleyBlock (TPraos c) ShelleyEra)
-> [GenTx (ShelleyBlock (TPraos c) ShelleyEra)]
-> [GenTx (ShelleyBlock (TPraos c) ShelleyEra)]
forall a. a -> [a] -> [a]
: []) (GenTx (ShelleyBlock (TPraos c) ShelleyEra)
 -> [GenTx (ShelleyBlock (TPraos c) ShelleyEra)])
-> GenTx (ShelleyBlock (TPraos c) ShelleyEra)
-> [GenTx (ShelleyBlock (TPraos c) ShelleyEra)]
forall a b. (a -> b) -> a -> b
$
    Tx TopTx ShelleyEra -> GenTx (ShelleyBlock (TPraos c) ShelleyEra)
forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Tx TopTx ShelleyEra -> GenTx (ShelleyBlock (TPraos c) ShelleyEra))
-> Tx TopTx ShelleyEra
-> GenTx (ShelleyBlock (TPraos c) ShelleyEra)
forall a b. (a -> b) -> a -> b
$
      TxBody TopTx ShelleyEra -> Tx TopTx ShelleyEra
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l ShelleyEra -> Tx l ShelleyEra
SL.mkBasicTx TxBody TopTx ShelleyEra
body Tx TopTx ShelleyEra
-> (Tx TopTx ShelleyEra -> Tx TopTx ShelleyEra)
-> Tx TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
(ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l ShelleyEra) (TxWits ShelleyEra)
SL.witsTxL ((ShelleyTxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
 -> Tx TopTx ShelleyEra -> Identity (Tx TopTx ShelleyEra))
-> ShelleyTxWits ShelleyEra
-> Tx TopTx ShelleyEra
-> Tx TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits ShelleyEra
ShelleyTxWits ShelleyEra
witnesses
 where
  -- The funds touched by this transaction assume it's the first transaction
  -- executed.
  scheduledEpoch :: EpochNo
  scheduledEpoch :: EpochNo
scheduledEpoch = Word64 -> EpochNo
EpochNo Word64
0

  witnesses :: SL.TxWits ShelleyEra
  witnesses :: TxWits ShelleyEra
witnesses = TxWits ShelleyEra
forall era. EraTxWits era => TxWits era
SL.mkBasicTxWits TxWits ShelleyEra
-> (TxWits ShelleyEra -> ShelleyTxWits ShelleyEra)
-> ShelleyTxWits ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (TxWits ShelleyEra)
(Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits ShelleyEra) (Set (WitVKey Witness))
SL.addrTxWitsL ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> TxWits ShelleyEra -> Identity (ShelleyTxWits ShelleyEra))
-> Set (WitVKey Witness)
-> TxWits ShelleyEra
-> ShelleyTxWits ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey Witness)
signatures

  -- Every node signs the transaction body, since it includes a " vote " from
  -- every node.
  signatures :: Set (SL.WitVKey SL.Witness)
  signatures :: Set (WitVKey Witness)
signatures =
    SafeHash EraIndependentTxBody
-> [KeyPair (ZonkAny 1)] -> Set (WitVKey Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey Witness)
TL.mkWitnessesVKey
      (TxBody TopTx ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody TopTx ShelleyEra
body)
      [ VKey (ZonkAny 1) -> SignKeyDSIGN DSIGN -> KeyPair (ZonkAny 1)
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
TL.KeyPair (VerKeyDSIGN DSIGN -> VKey (ZonkAny 1)
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey VerKeyDSIGN DSIGN
vk) SignKeyDSIGN DSIGN
sk
      | CoreNode c
cn <- [CoreNode c]
coreNodes
      , let sk :: SignKeyDSIGN DSIGN
sk = CoreNode c -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey CoreNode c
cn
      , let vk :: VerKeyDSIGN DSIGN
vk = SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
sk
      ]

  -- Nothing but the parameter update and the obligatory touching of an
  -- input.
  body :: SL.TxBody SL.TopTx ShelleyEra
  body :: TxBody TopTx ShelleyEra
body =
    TxBody TopTx ShelleyEra
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l ShelleyEra
SL.mkBasicTxBody
      TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l ShelleyEra) (Set TxIn)
SL.inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> Set TxIn -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton ((TxIn, ShelleyTxOut ShelleyEra) -> TxIn
forall a b. (a, b) -> a
fst (TxIn, TxOut ShelleyEra)
(TxIn, ShelleyTxOut ShelleyEra)
touchCoins)
      TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut ShelleyEra)
 -> Identity (StrictSeq (TxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
(StrictSeq (ShelleyTxOut ShelleyEra)
 -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel).
Lens' (TxBody l ShelleyEra) (StrictSeq (TxOut ShelleyEra))
SL.outputsTxBodyL ((StrictSeq (ShelleyTxOut ShelleyEra)
  -> Identity (StrictSeq (ShelleyTxOut ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictSeq (ShelleyTxOut ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ShelleyTxOut ShelleyEra -> StrictSeq (ShelleyTxOut ShelleyEra)
forall a. a -> StrictSeq a
Seq.singleton ((TxIn, ShelleyTxOut ShelleyEra) -> ShelleyTxOut ShelleyEra
forall a b. (a, b) -> b
snd (TxIn, TxOut ShelleyEra)
(TxIn, ShelleyTxOut ShelleyEra)
touchCoins)
      TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (SlotNo -> Identity SlotNo)
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody TopTx era) SlotNo
Lens' (TxBody TopTx ShelleyEra) SlotNo
SL.ttlTxBodyL ((SlotNo -> Identity SlotNo)
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> SlotNo -> TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SlotNo
ttl
      TxBody TopTx ShelleyEra
-> (TxBody TopTx ShelleyEra -> TxBody TopTx ShelleyEra)
-> TxBody TopTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Update ShelleyEra)
 -> Identity (StrictMaybe (Update ShelleyEra)))
-> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra)
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (Update era))
Lens' (TxBody TopTx ShelleyEra) (StrictMaybe (Update ShelleyEra))
SL.updateTxBodyL ((StrictMaybe (Update ShelleyEra)
  -> Identity (StrictMaybe (Update ShelleyEra)))
 -> TxBody TopTx ShelleyEra -> Identity (TxBody TopTx ShelleyEra))
-> StrictMaybe (Update ShelleyEra)
-> TxBody TopTx ShelleyEra
-> TxBody TopTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Update ShelleyEra -> StrictMaybe (Update ShelleyEra)
forall a. a -> StrictMaybe a
SL.SJust Update ShelleyEra
update

  -- Every Shelley transaction requires one input.
  --
  -- We use the input of the first node, but we just put it all right back.
  --
  -- ASSUMPTION: This transaction runs in the first slot.
  touchCoins :: (SL.TxIn, SL.TxOut ShelleyEra)
  touchCoins :: (TxIn, TxOut ShelleyEra)
touchCoins = case [CoreNode c]
coreNodes of
    [] -> String -> (TxIn, ShelleyTxOut ShelleyEra)
forall a. HasCallStack => String -> a
error String
"no nodes!"
    CoreNode c
cn : [CoreNode c]
_ ->
      ( Addr -> TxIn
SL.initialFundsPseudoTxIn Addr
addr
      , Addr -> Value ShelleyEra -> ShelleyTxOut ShelleyEra
forall era.
(HasCallStack, Era era, Val (Value era)) =>
Addr -> Value era -> ShelleyTxOut era
SL.ShelleyTxOut Addr
addr Value ShelleyEra
Coin
coin
      )
     where
      addr :: Addr
addr =
        Network -> Credential Payment -> StakeReference -> Addr
SL.Addr
          Network
networkId
          (SignKeyDSIGN DSIGN -> Credential Payment
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential (CoreNode c -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey CoreNode c
cn))
          (Credential Staking -> StakeReference
SL.StakeRefBase (SignKeyDSIGN DSIGN -> Credential Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential (CoreNode c -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnStakingKey CoreNode c
cn)))
      coin :: Coin
coin = Integer -> Coin
SL.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
initialLovelacePerCoreNode

  -- One replicant of the parameter update per each node.
  update :: SL.Update ShelleyEra
  update :: Update ShelleyEra
update =
    (ProposedPPUpdates ShelleyEra -> EpochNo -> Update ShelleyEra)
-> EpochNo -> ProposedPPUpdates ShelleyEra -> Update ShelleyEra
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProposedPPUpdates ShelleyEra -> EpochNo -> Update ShelleyEra
forall era. ProposedPPUpdates era -> EpochNo -> Update era
SL.Update EpochNo
scheduledEpoch (ProposedPPUpdates ShelleyEra -> Update ShelleyEra)
-> ProposedPPUpdates ShelleyEra -> Update ShelleyEra
forall a b. (a -> b) -> a -> b
$
      Map (KeyHash GenesisRole) (PParamsUpdate ShelleyEra)
-> ProposedPPUpdates ShelleyEra
forall era.
Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
SL.ProposedPPUpdates (Map (KeyHash GenesisRole) (PParamsUpdate ShelleyEra)
 -> ProposedPPUpdates ShelleyEra)
-> Map (KeyHash GenesisRole) (PParamsUpdate ShelleyEra)
-> ProposedPPUpdates ShelleyEra
forall a b. (a -> b) -> a -> b
$
        [(KeyHash GenesisRole, PParamsUpdate ShelleyEra)]
-> Map (KeyHash GenesisRole) (PParamsUpdate ShelleyEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash GenesisRole, PParamsUpdate ShelleyEra)]
 -> Map (KeyHash GenesisRole) (PParamsUpdate ShelleyEra))
-> [(KeyHash GenesisRole, PParamsUpdate ShelleyEra)]
-> Map (KeyHash GenesisRole) (PParamsUpdate ShelleyEra)
forall a b. (a -> b) -> a -> b
$
          [ ( VKey GenesisRole -> KeyHash GenesisRole
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey GenesisRole -> KeyHash GenesisRole)
-> VKey GenesisRole -> KeyHash GenesisRole
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN DSIGN -> VKey GenesisRole
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> VKey GenesisRole)
-> VerKeyDSIGN DSIGN -> VKey GenesisRole
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN)
-> SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall a b. (a -> b) -> a -> b
$ CoreNode c -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnGenesisKey CoreNode c
cn
            , PParamsUpdate ShelleyEra
forall era. EraPParams era => PParamsUpdate era
SL.emptyPParamsUpdate
                PParamsUpdate ShelleyEra
-> (PParamsUpdate ShelleyEra -> PParamsUpdate ShelleyEra)
-> PParamsUpdate ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra)
forall era.
(EraPParams era, AtMostEra "Alonzo" era) =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate ShelleyEra) (StrictMaybe UnitInterval)
SL.ppuDL
                  ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra))
-> StrictMaybe UnitInterval
-> PParamsUpdate ShelleyEra
-> PParamsUpdate ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$
                         Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational (Rational -> Maybe UnitInterval) -> Rational -> Maybe UnitInterval
forall a b. (a -> b) -> a -> b
$
                           DecentralizationParam -> Rational
decentralizationParamToRational DecentralizationParam
dNew
                     )
                PParamsUpdate ShelleyEra
-> (PParamsUpdate ShelleyEra -> PParamsUpdate ShelleyEra)
-> PParamsUpdate ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
-> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra)
forall era.
(EraPParams era, AtMostEra "Babbage" era) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
Lens' (PParamsUpdate ShelleyEra) (StrictMaybe ProtVer)
SL.ppuProtocolVersionL ((StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
 -> PParamsUpdate ShelleyEra -> Identity (PParamsUpdate ShelleyEra))
-> StrictMaybe ProtVer
-> PParamsUpdate ShelleyEra
-> PParamsUpdate ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer -> StrictMaybe ProtVer
forall a. a -> StrictMaybe a
SL.SJust ProtVer
pVer
            )
          | CoreNode c
cn <- [CoreNode c]
coreNodes
          ]

{-------------------------------------------------------------------------------
  Auxiliary
-------------------------------------------------------------------------------}

initialLovelacePerCoreNode :: Word64
initialLovelacePerCoreNode :: Word64
initialLovelacePerCoreNode = Word64
1000000

mkCredential :: SignKeyDSIGN LK.DSIGN -> SL.Credential r
mkCredential :: forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential = KeyHash r -> Credential r
forall (kr :: KeyRole). KeyHash kr -> Credential kr
SL.KeyHashObj (KeyHash r -> Credential r)
-> (SignKeyDSIGN DSIGN -> KeyHash r)
-> SignKeyDSIGN DSIGN
-> Credential r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN DSIGN -> KeyHash r
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyHash r
mkKeyHash

mkKeyHash :: SignKeyDSIGN LK.DSIGN -> SL.KeyHash r
mkKeyHash :: forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyHash r
mkKeyHash = VKey r -> KeyHash r
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey r -> KeyHash r)
-> (SignKeyDSIGN DSIGN -> VKey r)
-> SignKeyDSIGN DSIGN
-> KeyHash r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN DSIGN -> VKey r
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> VKey r
mkVerKey

mkVerKey :: SignKeyDSIGN LK.DSIGN -> SL.VKey r
mkVerKey :: forall (r :: KeyRole). SignKeyDSIGN DSIGN -> VKey r
mkVerKey = VerKeyDSIGN DSIGN -> VKey r
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> VKey r)
-> (SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN)
-> SignKeyDSIGN DSIGN
-> VKey r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN

mkKeyPair :: SignKeyDSIGN LK.DSIGN -> TL.KeyPair r
mkKeyPair :: forall (r :: KeyRole). SignKeyDSIGN DSIGN -> KeyPair r
mkKeyPair SignKeyDSIGN DSIGN
sk = TL.KeyPair{vKey :: VKey r
vKey = SignKeyDSIGN DSIGN -> VKey r
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> VKey r
mkVerKey SignKeyDSIGN DSIGN
sk, sKey :: SignKeyDSIGN DSIGN
sKey = SignKeyDSIGN DSIGN
sk}

mkKeyHashVrf :: forall c r. Crypto c => SignKeyVRF (VRF c) -> LK.VRFVerKeyHash (r :: LK.KeyRoleVRF)
mkKeyHashVrf :: forall c (r :: KeyRoleVRF).
Crypto c =>
SignKeyVRF (VRF c) -> VRFVerKeyHash r
mkKeyHashVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
hashVerKeyVRF @c (VerKeyVRF (VRF c) -> VRFVerKeyHash r)
-> (SignKeyVRF (VRF c) -> VerKeyVRF (VRF c))
-> SignKeyVRF (VRF c)
-> VRFVerKeyHash r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignKeyVRF (VRF c) -> VerKeyVRF (VRF c)
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF

networkId :: SL.Network
networkId :: Network
networkId = Network
SL.Testnet

{-------------------------------------------------------------------------------
  Temporary Workaround
-------------------------------------------------------------------------------}

-- | TODO This is a copy-paste-edit of 'mkSetDecentralizationParamTxs'
--
-- Our current plan is to replace all of this infrastructure with the ThreadNet
-- rewrite; so we're minimizing the work and maintenance here for now.
mkMASetDecentralizationParamTxs ::
  forall proto era.
  ( ShelleyBasedEra era
  , SL.AllegraEraTxBody era
  , SL.ShelleyEraTxBody era
  , SL.AtMostEra "Alonzo" era
  ) =>
  [CoreNode (ProtoCrypto proto)] ->
  -- | The proposed protocol version
  ProtVer ->
  -- | The TTL
  SlotNo ->
  -- | The new value
  DecentralizationParam ->
  [GenTx (ShelleyBlock proto era)]
mkMASetDecentralizationParamTxs :: forall proto era.
(ShelleyBasedEra era, AllegraEraTxBody era, ShelleyEraTxBody era,
 AtMostEra "Alonzo" era) =>
[CoreNode (ProtoCrypto proto)]
-> ProtVer
-> SlotNo
-> DecentralizationParam
-> [GenTx (ShelleyBlock proto era)]
mkMASetDecentralizationParamTxs [CoreNode (ProtoCrypto proto)]
coreNodes ProtVer
pVer SlotNo
ttl DecentralizationParam
dNew =
  (GenTx (ShelleyBlock proto era)
-> [GenTx (ShelleyBlock proto era)]
-> [GenTx (ShelleyBlock proto era)]
forall a. a -> [a] -> [a]
: []) (GenTx (ShelleyBlock proto era)
 -> [GenTx (ShelleyBlock proto era)])
-> GenTx (ShelleyBlock proto era)
-> [GenTx (ShelleyBlock proto era)]
forall a b. (a -> b) -> a -> b
$
    Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx TopTx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Tx TopTx era -> GenTx (ShelleyBlock proto era))
-> Tx TopTx era -> GenTx (ShelleyBlock proto era)
forall a b. (a -> b) -> a -> b
$
      TxBody TopTx era -> Tx TopTx era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
SL.mkBasicTx TxBody TopTx era
body Tx TopTx era -> (Tx TopTx era -> Tx TopTx era) -> Tx TopTx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx TopTx era -> Identity (Tx TopTx era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxWits era)
forall (l :: TxLevel). Lens' (Tx l era) (TxWits era)
SL.witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx TopTx era -> Identity (Tx TopTx era))
-> TxWits era -> Tx TopTx era -> Tx TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits era
witnesses
 where
  -- The funds touched by this transaction assume it's the first transaction
  -- executed.
  scheduledEpoch :: EpochNo
  scheduledEpoch :: EpochNo
scheduledEpoch = Word64 -> EpochNo
EpochNo Word64
0

  witnesses :: SL.TxWits era
  witnesses :: TxWits era
witnesses = TxWits era
forall era. EraTxWits era => TxWits era
SL.mkBasicTxWits TxWits era -> (TxWits era -> TxWits era) -> TxWits era
forall a b. a -> (a -> b) -> b
& (Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
-> TxWits era -> Identity (TxWits era)
forall era.
EraTxWits era =>
Lens' (TxWits era) (Set (WitVKey Witness))
Lens' (TxWits era) (Set (WitVKey Witness))
SL.addrTxWitsL ((Set (WitVKey Witness) -> Identity (Set (WitVKey Witness)))
 -> TxWits era -> Identity (TxWits era))
-> Set (WitVKey Witness) -> TxWits era -> TxWits era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set (WitVKey Witness)
signatures

  -- Every node signs the transaction body, since it includes a " vote " from
  -- every node.
  signatures :: Set (SL.WitVKey SL.Witness)
  signatures :: Set (WitVKey Witness)
signatures =
    SafeHash EraIndependentTxBody
-> [KeyPair (ZonkAny 0)] -> Set (WitVKey Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey Witness)
TL.mkWitnessesVKey
      (TxBody TopTx era -> SafeHash EraIndependentTxBody
forall body.
HashAnnotated body EraIndependentTxBody =>
body -> SafeHash EraIndependentTxBody
eraIndTxBodyHash' TxBody TopTx era
body)
      [ VKey (ZonkAny 0) -> SignKeyDSIGN DSIGN -> KeyPair (ZonkAny 0)
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
TL.KeyPair (VerKeyDSIGN DSIGN -> VKey (ZonkAny 0)
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey VerKeyDSIGN DSIGN
vk) SignKeyDSIGN DSIGN
sk
      | CoreNode (ProtoCrypto proto)
cn <- [CoreNode (ProtoCrypto proto)]
coreNodes
      , let sk :: SignKeyDSIGN DSIGN
sk = CoreNode (ProtoCrypto proto) -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey CoreNode (ProtoCrypto proto)
cn
      , let vk :: VerKeyDSIGN DSIGN
vk = SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN SignKeyDSIGN DSIGN
sk
      ]

  -- Nothing but the parameter update and the obligatory touching of an
  -- input.
  body :: SL.TxBody SL.TopTx era
  body :: TxBody TopTx era
body =
    TxBody TopTx era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
SL.mkBasicTxBody
      TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (Set TxIn)
forall (l :: TxLevel). Lens' (TxBody l era) (Set TxIn)
SL.inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> Set TxIn -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
inputs
      TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxOut era))
forall (l :: TxLevel). Lens' (TxBody l era) (StrictSeq (TxOut era))
SL.outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictSeq (TxOut era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
outputs
      TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era (l :: TxLevel).
AllegraEraTxBody era =>
Lens' (TxBody l era) ValidityInterval
forall (l :: TxLevel). Lens' (TxBody l era) ValidityInterval
SL.vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> ValidityInterval -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vldt
      TxBody TopTx era
-> (TxBody TopTx era -> TxBody TopTx era) -> TxBody TopTx era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Update era) -> Identity (StrictMaybe (Update era)))
-> TxBody TopTx era -> Identity (TxBody TopTx era)
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody TopTx era) (StrictMaybe (Update era))
Lens' (TxBody TopTx era) (StrictMaybe (Update era))
SL.updateTxBodyL ((StrictMaybe (Update era) -> Identity (StrictMaybe (Update era)))
 -> TxBody TopTx era -> Identity (TxBody TopTx era))
-> StrictMaybe (Update era) -> TxBody TopTx era -> TxBody TopTx era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe (Update era)
update'
   where
    inputs :: Set TxIn
inputs = TxIn -> Set TxIn
forall a. a -> Set a
Set.singleton ((TxIn, TxOut era) -> TxIn
forall a b. (a, b) -> a
fst (TxIn, TxOut era)
touchCoins)
    outputs :: StrictSeq (TxOut era)
outputs = TxOut era -> StrictSeq (TxOut era)
forall a. a -> StrictSeq a
Seq.singleton ((TxIn, TxOut era) -> TxOut era
forall a b. (a, b) -> b
snd (TxIn, TxOut era)
touchCoins)
    vldt :: ValidityInterval
vldt =
      SL.ValidityInterval
        { invalidBefore :: StrictMaybe SlotNo
invalidBefore = StrictMaybe SlotNo
forall a. StrictMaybe a
SL.SNothing
        , invalidHereafter :: StrictMaybe SlotNo
invalidHereafter = SlotNo -> StrictMaybe SlotNo
forall a. a -> StrictMaybe a
SL.SJust SlotNo
ttl
        }
    update' :: StrictMaybe (Update era)
update' = Update era -> StrictMaybe (Update era)
forall a. a -> StrictMaybe a
SL.SJust Update era
update

  -- Every Shelley transaction requires one input.
  --
  -- We use the input of the first node, but we just put it all right back.
  --
  -- ASSUMPTION: This transaction runs in the first slot.
  touchCoins :: (SL.TxIn, SL.TxOut era)
  touchCoins :: (TxIn, TxOut era)
touchCoins = case [CoreNode (ProtoCrypto proto)]
coreNodes of
    [] -> String -> (TxIn, TxOut era)
forall a. HasCallStack => String -> a
error String
"no nodes!"
    CoreNode (ProtoCrypto proto)
cn : [CoreNode (ProtoCrypto proto)]
_ ->
      ( Addr -> TxIn
SL.initialFundsPseudoTxIn Addr
addr
      , Addr -> Value era -> TxOut era
forall era.
(EraTxOut era, HasCallStack) =>
Addr -> Value era -> TxOut era
SL.mkBasicTxOut Addr
addr Value era
coin
      )
     where
      addr :: Addr
addr =
        Network -> Credential Payment -> StakeReference -> Addr
SL.Addr
          Network
networkId
          (SignKeyDSIGN DSIGN -> Credential Payment
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential (CoreNode (ProtoCrypto proto) -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey CoreNode (ProtoCrypto proto)
cn))
          (Credential Staking -> StakeReference
SL.StakeRefBase (SignKeyDSIGN DSIGN -> Credential Staking
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential (CoreNode (ProtoCrypto proto) -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnStakingKey CoreNode (ProtoCrypto proto)
cn)))
      coin :: Value era
coin = Coin -> Value era
forall t s. Inject t s => t -> s
SL.inject (Coin -> Value era) -> Coin -> Value era
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
SL.Coin (Integer -> Coin) -> Integer -> Coin
forall a b. (a -> b) -> a -> b
$ Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
initialLovelacePerCoreNode

  -- One replicant of the parameter update per each node.
  update :: SL.Update era
  update :: Update era
update =
    (ProposedPPUpdates era -> EpochNo -> Update era)
-> EpochNo -> ProposedPPUpdates era -> Update era
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProposedPPUpdates era -> EpochNo -> Update era
forall era. ProposedPPUpdates era -> EpochNo -> Update era
SL.Update EpochNo
scheduledEpoch (ProposedPPUpdates era -> Update era)
-> ProposedPPUpdates era -> Update era
forall a b. (a -> b) -> a -> b
$
      Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
forall era.
Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
SL.ProposedPPUpdates (Map (KeyHash GenesisRole) (PParamsUpdate era)
 -> ProposedPPUpdates era)
-> Map (KeyHash GenesisRole) (PParamsUpdate era)
-> ProposedPPUpdates era
forall a b. (a -> b) -> a -> b
$
        [(KeyHash GenesisRole, PParamsUpdate era)]
-> Map (KeyHash GenesisRole) (PParamsUpdate era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash GenesisRole, PParamsUpdate era)]
 -> Map (KeyHash GenesisRole) (PParamsUpdate era))
-> [(KeyHash GenesisRole, PParamsUpdate era)]
-> Map (KeyHash GenesisRole) (PParamsUpdate era)
forall a b. (a -> b) -> a -> b
$
          [ ( VKey GenesisRole -> KeyHash GenesisRole
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey GenesisRole -> KeyHash GenesisRole)
-> VKey GenesisRole -> KeyHash GenesisRole
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN DSIGN -> VKey GenesisRole
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> VKey GenesisRole)
-> VerKeyDSIGN DSIGN -> VKey GenesisRole
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN)
-> SignKeyDSIGN DSIGN -> VerKeyDSIGN DSIGN
forall a b. (a -> b) -> a -> b
$ CoreNode (ProtoCrypto proto) -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnGenesisKey CoreNode (ProtoCrypto proto)
cn
            , PParamsUpdate era
forall era. EraPParams era => PParamsUpdate era
SL.emptyPParamsUpdate
                PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
(EraPParams era, AtMostEra "Alonzo" era) =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
SL.ppuDL
                  ((StrictMaybe UnitInterval -> Identity (StrictMaybe UnitInterval))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe UnitInterval
-> PParamsUpdate era
-> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Maybe UnitInterval -> StrictMaybe UnitInterval
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe UnitInterval -> StrictMaybe UnitInterval)
-> Maybe UnitInterval -> StrictMaybe UnitInterval
forall a b. (a -> b) -> a -> b
$
                         Rational -> Maybe UnitInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational (Rational -> Maybe UnitInterval) -> Rational -> Maybe UnitInterval
forall a b. (a -> b) -> a -> b
$
                           DecentralizationParam -> Rational
decentralizationParamToRational DecentralizationParam
dNew
                     )
                PParamsUpdate era
-> (PParamsUpdate era -> PParamsUpdate era) -> PParamsUpdate era
forall a b. a -> (a -> b) -> b
& (StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
-> PParamsUpdate era -> Identity (PParamsUpdate era)
forall era.
(EraPParams era, AtMostEra "Babbage" era) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
SL.ppuProtocolVersionL ((StrictMaybe ProtVer -> Identity (StrictMaybe ProtVer))
 -> PParamsUpdate era -> Identity (PParamsUpdate era))
-> StrictMaybe ProtVer -> PParamsUpdate era -> PParamsUpdate era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ProtVer -> StrictMaybe ProtVer
forall a. a -> StrictMaybe a
SL.SJust ProtVer
pVer
            )
          | CoreNode (ProtoCrypto proto)
cn <- [CoreNode (ProtoCrypto proto)]
coreNodes
          ]

eraIndTxBodyHash' ::
  HashAnnotated body EraIndependentTxBody =>
  body ->
  SafeHash
    EraIndependentTxBody
eraIndTxBodyHash' :: forall body.
HashAnnotated body EraIndependentTxBody =>
body -> SafeHash EraIndependentTxBody
eraIndTxBodyHash' = SafeHash EraIndependentTxBody -> SafeHash EraIndependentTxBody
forall a b. Coercible a b => a -> b
coerce (SafeHash EraIndependentTxBody -> SafeHash EraIndependentTxBody)
-> (body -> SafeHash EraIndependentTxBody)
-> body
-> SafeHash EraIndependentTxBody
forall b c a. (b -> c) -> (a -> b) -> a -> c
. body -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated