{-# 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 (..), 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.Alonzo (AlonzoEra)
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 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.Common
                     (PraosCanBeLeader (PraosCanBeLeader),
                     praosCanBeLeaderColdVerKey, praosCanBeLeaderOpCert,
                     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           Ouroboros.Consensus.Util.IOLike
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 'Genesis, AllIssuerKeys c 'GenesisDelegate)
cnkiCoreNode ::
      ( TL.KeyPair 'SL.Genesis
      , 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 'Genesis, AllIssuerKeys c 'GenesisDelegate)
cnkiCoreNode =
          ( SignKeyDSIGN DSIGN -> KeyPair 'Genesis
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 {
        shelleyLeaderCredentialsInitSignKey :: UnsoundPureSignKeyKES (KES c)
shelleyLeaderCredentialsInitSignKey = UnsoundPureSignKeyKES (KES c)
cnKES
      , shelleyLeaderCredentialsCanBeLeader :: PraosCanBeLeader c
shelleyLeaderCredentialsCanBeLeader = PraosCanBeLeader {
          praosCanBeLeaderOpCert :: OCert c
praosCanBeLeaderOpCert     = OCert c
cnOCert
        , 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
  => ProtVer   -- ^ Initial protocol version
  -> SecurityParam
  -> Rational  -- ^ Initial active slot coefficient
  -> DecentralizationParam
  -> Word64
     -- ^ Max Lovelace supply, must be >= #coreNodes * initialLovelacePerCoreNode
  -> 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 'Genesis) GenDelegPair
sgGenDelegs             = Map (KeyHash 'Genesis) 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, ProtVerAtMost era 6) =>
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.Genesis) SL.GenDelegPair
    coreNodesToGenesisMapping :: Map (KeyHash 'Genesis) GenDelegPair
coreNodesToGenesisMapping  = [(KeyHash 'Genesis, GenDelegPair)]
-> Map (KeyHash 'Genesis) GenDelegPair
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ let
          gkh :: SL.KeyHash 'SL.Genesis
          gkh :: KeyHash 'Genesis
gkh = VKey 'Genesis -> KeyHash 'Genesis
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey 'Genesis -> KeyHash 'Genesis)
-> (VerKeyDSIGN DSIGN -> VKey 'Genesis)
-> VerKeyDSIGN DSIGN
-> KeyHash 'Genesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerKeyDSIGN DSIGN -> VKey 'Genesis
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> KeyHash 'Genesis)
-> VerKeyDSIGN DSIGN -> KeyHash 'Genesis
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 'Genesis
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 -> PaymentCredential -> StakeReference -> Addr
SL.Addr Network
networkId
                           (SignKeyDSIGN DSIGN -> PaymentCredential
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential SignKeyDSIGN DSIGN
cnDelegateKey)
                           (StakeCredential -> StakeReference
SL.StakeRefBase (SignKeyDSIGN DSIGN -> StakeCredential
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) PoolParams
sgsPools = [(KeyHash 'StakePool, PoolParams)]
-> ListMap (KeyHash 'StakePool) PoolParams
forall k v. [(k, v)] -> ListMap k v
ListMap
          [ (KeyHash 'StakePool
pk, PoolParams
pp)
          | pp :: PoolParams
pp@SL.PoolParams { ppId :: PoolParams -> KeyHash 'StakePool
ppId = KeyHash 'StakePool
pk } <- Map (KeyHash 'StakePool) PoolParams -> [PoolParams]
forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'StakePool) PoolParams
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.PoolParams
        coreNodeToPoolMapping :: Map (KeyHash 'StakePool) PoolParams
coreNodeToPoolMapping = [(KeyHash 'StakePool, PoolParams)]
-> Map (KeyHash 'StakePool) PoolParams
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.PoolParams
                { ppId :: KeyHash 'StakePool
SL.ppId = KeyHash 'StakePool
poolHash
                , ppVrf :: VRFVerKeyHash 'StakePoolVRF
SL.ppVrf = VRFVerKeyHash 'StakePoolVRF
vrfHash
                  -- Each core node pledges its full stake to the pool.
                , ppPledge :: Coin
SL.ppPledge = 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
                , ppCost :: Coin
SL.ppCost = Integer -> Coin
SL.Coin Integer
1
                , ppMargin :: UnitInterval
SL.ppMargin = 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.
                , ppRewardAccount :: RewardAccount
SL.ppRewardAccount = Network -> StakeCredential -> RewardAccount
SL.RewardAccount Network
networkId (StakeCredential -> RewardAccount)
-> StakeCredential -> RewardAccount
forall a b. (a -> b) -> a -> b
$ SignKeyDSIGN DSIGN -> StakeCredential
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential SignKeyDSIGN DSIGN
cnDelegateKey
                , ppOwners :: Set (KeyHash 'Staking)
SL.ppOwners = KeyHash 'Staking -> Set (KeyHash 'Staking)
forall a. a -> Set a
Set.singleton KeyHash 'Staking
poolOwnerHash
                , ppRelays :: StrictSeq StakePoolRelay
SL.ppRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
Seq.empty
                , ppMetadata :: StrictMaybe PoolMetadata
SL.ppMetadata = 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.
     (IOLike m, ShelleyCompatible (TPraos c) ShelleyEra)
  => ShelleyGenesis
  -> SL.Nonce
  -> ProtVer
  -> CoreNode c
  -> ( ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra)
     , m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)]
     )
mkProtocolShelley :: forall (m :: * -> *) c.
(IOLike m, ShelleyCompatible (TPraos c) ShelleyEra) =>
ShelleyGenesis
-> Nonce
-> ProtVer
-> CoreNode c
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
mkProtocolShelley ShelleyGenesis
genesis Nonce
initialNonce ProtVer
protVer CoreNode c
coreNode =
    ShelleyGenesis
-> ProtocolParamsShelleyBased c
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    m [BlockForging m (ShelleyBlock (TPraos c) ShelleyEra)])
forall (m :: * -> *) c.
(IOLike m, ShelleyCompatible (TPraos c) ShelleyEra,
 TxLimits (ShelleyBlock (TPraos c) ShelleyEra)) =>
ShelleyGenesis
-> ProtocolParamsShelleyBased c
-> ProtVer
-> (ProtocolInfo (ShelleyBlock (TPraos c) ShelleyEra),
    m [BlockForging 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]
  -> ProtVer   -- ^ The proposed protocol version
  -> SlotNo   -- ^ The TTL
  -> DecentralizationParam   -- ^ The new value
  -> [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 ShelleyEra -> GenTx (ShelleyBlock (TPraos c) ShelleyEra)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Tx ShelleyEra -> GenTx (ShelleyBlock (TPraos c) ShelleyEra))
-> Tx ShelleyEra -> GenTx (ShelleyBlock (TPraos c) ShelleyEra)
forall a b. (a -> b) -> a -> b
$
    TxBody ShelleyEra -> Tx ShelleyEra
forall era. EraTx era => TxBody era -> Tx era
SL.mkBasicTx TxBody ShelleyEra
body Tx ShelleyEra
-> (Tx ShelleyEra -> ShelleyTx ShelleyEra) -> ShelleyTx ShelleyEra
forall a b. a -> (a -> b) -> b
& (TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Tx ShelleyEra -> Identity (Tx ShelleyEra)
(TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
-> Tx ShelleyEra -> Identity (ShelleyTx ShelleyEra)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx ShelleyEra) (TxWits ShelleyEra)
SL.witsTxL ((TxWits ShelleyEra -> Identity (TxWits ShelleyEra))
 -> Tx ShelleyEra -> Identity (ShelleyTx ShelleyEra))
-> TxWits ShelleyEra -> Tx ShelleyEra -> ShelleyTx ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxWits 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 Any] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
TL.mkWitnessesVKey
          (ShelleyTxBody ShelleyEra -> SafeHash EraIndependentTxBody
forall x i. HashAnnotated x i => x -> SafeHash i
hashAnnotated TxBody ShelleyEra
ShelleyTxBody ShelleyEra
body)
          [ VKey Any -> SignKeyDSIGN DSIGN -> KeyPair Any
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
TL.KeyPair (VerKeyDSIGN DSIGN -> VKey Any
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 ShelleyEra
    body :: TxBody ShelleyEra
body = TxBody ShelleyEra
forall era. EraTxBody era => TxBody era
SL.mkBasicTxBody
         TxBody ShelleyEra
-> (TxBody ShelleyEra -> TxBody ShelleyEra) -> TxBody ShelleyEra
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody ShelleyEra -> Identity (TxBody ShelleyEra)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody ShelleyEra) (Set TxIn)
SL.inputsTxBodyL  ((Set TxIn -> Identity (Set TxIn))
 -> TxBody ShelleyEra -> Identity (TxBody ShelleyEra))
-> Set TxIn -> TxBody ShelleyEra -> TxBody 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 ShelleyEra
-> (TxBody ShelleyEra -> TxBody ShelleyEra) -> TxBody ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut ShelleyEra)
 -> Identity (StrictSeq (TxOut ShelleyEra)))
-> TxBody ShelleyEra -> Identity (TxBody ShelleyEra)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody ShelleyEra) (StrictSeq (TxOut ShelleyEra))
SL.outputsTxBodyL ((StrictSeq (TxOut ShelleyEra)
  -> Identity (StrictSeq (TxOut ShelleyEra)))
 -> TxBody ShelleyEra -> Identity (TxBody ShelleyEra))
-> StrictSeq (TxOut ShelleyEra)
-> TxBody ShelleyEra
-> TxBody ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxOut ShelleyEra -> StrictSeq (TxOut ShelleyEra)
forall a. a -> StrictSeq a
Seq.singleton ((TxIn, TxOut ShelleyEra) -> TxOut ShelleyEra
forall a b. (a, b) -> b
snd (TxIn, TxOut ShelleyEra)
touchCoins)
         TxBody ShelleyEra
-> (TxBody ShelleyEra -> ShelleyTxBody ShelleyEra)
-> ShelleyTxBody ShelleyEra
forall a b. a -> (a -> b) -> b
& (SlotNo -> Identity SlotNo)
-> TxBody ShelleyEra -> Identity (TxBody ShelleyEra)
(SlotNo -> Identity SlotNo)
-> TxBody ShelleyEra -> Identity (ShelleyTxBody ShelleyEra)
forall era.
(ShelleyEraTxBody era, ExactEra ShelleyEra era) =>
Lens' (TxBody era) SlotNo
Lens' (TxBody ShelleyEra) SlotNo
SL.ttlTxBodyL     ((SlotNo -> Identity SlotNo)
 -> TxBody ShelleyEra -> Identity (ShelleyTxBody ShelleyEra))
-> SlotNo -> TxBody ShelleyEra -> ShelleyTxBody ShelleyEra
forall s t a b. ASetter s t a b -> b -> s -> t
.~ SlotNo
ttl
         ShelleyTxBody ShelleyEra
-> (ShelleyTxBody ShelleyEra -> ShelleyTxBody ShelleyEra)
-> ShelleyTxBody ShelleyEra
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Update ShelleyEra)
 -> Identity (StrictMaybe (Update ShelleyEra)))
-> TxBody ShelleyEra -> Identity (TxBody ShelleyEra)
(StrictMaybe (Update ShelleyEra)
 -> Identity (StrictMaybe (Update ShelleyEra)))
-> ShelleyTxBody ShelleyEra -> Identity (ShelleyTxBody ShelleyEra)
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody ShelleyEra) (StrictMaybe (Update ShelleyEra))
SL.updateTxBodyL ((StrictMaybe (Update ShelleyEra)
  -> Identity (StrictMaybe (Update ShelleyEra)))
 -> ShelleyTxBody ShelleyEra -> Identity (ShelleyTxBody ShelleyEra))
-> StrictMaybe (Update ShelleyEra)
-> ShelleyTxBody ShelleyEra
-> ShelleyTxBody 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 -> PaymentCredential -> StakeReference -> Addr
SL.Addr Network
networkId
                (SignKeyDSIGN DSIGN -> PaymentCredential
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential (CoreNode c -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey CoreNode c
cn))
                (StakeCredential -> StakeReference
SL.StakeRefBase (SignKeyDSIGN DSIGN -> StakeCredential
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 'Genesis) (PParamsUpdate ShelleyEra)
-> ProposedPPUpdates ShelleyEra
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
SL.ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
 -> ProposedPPUpdates ShelleyEra)
-> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
-> ProposedPPUpdates ShelleyEra
forall a b. (a -> b) -> a -> b
$
        [(KeyHash 'Genesis, PParamsUpdate ShelleyEra)]
-> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash 'Genesis, PParamsUpdate ShelleyEra)]
 -> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra))
-> [(KeyHash 'Genesis, PParamsUpdate ShelleyEra)]
-> Map (KeyHash 'Genesis) (PParamsUpdate ShelleyEra)
forall a b. (a -> b) -> a -> b
$
        [ ( VKey 'Genesis -> KeyHash 'Genesis
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey 'Genesis -> KeyHash 'Genesis)
-> VKey 'Genesis -> KeyHash 'Genesis
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN DSIGN -> VKey 'Genesis
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> VKey 'Genesis)
-> VerKeyDSIGN DSIGN -> VKey 'Genesis
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, ProtVerAtMost era 6) =>
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, ProtVerAtMost era 8) =>
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 AlonzoEra era
     )
  => [CoreNode (ProtoCrypto proto)]
  -> ProtVer   -- ^ The proposed protocol version
  -> SlotNo   -- ^ The TTL
  -> DecentralizationParam   -- ^ The new value
  -> [GenTx (ShelleyBlock proto era)]
mkMASetDecentralizationParamTxs :: forall proto era.
(ShelleyBasedEra era, AllegraEraTxBody era, ShelleyEraTxBody era,
 AtMostEra AlonzoEra 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 era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Tx era -> GenTx (ShelleyBlock proto era))
-> Tx era -> GenTx (ShelleyBlock proto era)
forall a b. (a -> b) -> a -> b
$
    TxBody era -> Tx era
forall era. EraTx era => TxBody era -> Tx era
SL.mkBasicTx TxBody era
body Tx era -> (Tx era -> Tx era) -> Tx era
forall a b. a -> (a -> b) -> b
& (TxWits era -> Identity (TxWits era))
-> Tx era -> Identity (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxWits era)
Lens' (Tx era) (TxWits era)
SL.witsTxL ((TxWits era -> Identity (TxWits era))
 -> Tx era -> Identity (Tx era))
-> TxWits era -> Tx era -> Tx 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 Any] -> Set (WitVKey 'Witness)
forall (kr :: KeyRole).
SafeHash EraIndependentTxBody
-> [KeyPair kr] -> Set (WitVKey 'Witness)
TL.mkWitnessesVKey
          (TxBody era -> SafeHash EraIndependentTxBody
forall body.
HashAnnotated body EraIndependentTxBody =>
body -> SafeHash EraIndependentTxBody
eraIndTxBodyHash' TxBody era
body)
          [ VKey Any -> SignKeyDSIGN DSIGN -> KeyPair Any
forall (kd :: KeyRole). VKey kd -> SignKeyDSIGN DSIGN -> KeyPair kd
TL.KeyPair (VerKeyDSIGN DSIGN -> VKey Any
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 era
    body :: TxBody era
body = TxBody era
forall era. EraTxBody era => TxBody era
SL.mkBasicTxBody
      TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (Set TxIn -> Identity (Set TxIn))
-> TxBody era -> Identity (TxBody era)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
SL.inputsTxBodyL ((Set TxIn -> Identity (Set TxIn))
 -> TxBody era -> Identity (TxBody era))
-> Set TxIn -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Set TxIn
inputs
      TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
-> TxBody era -> Identity (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
SL.outputsTxBodyL ((StrictSeq (TxOut era) -> Identity (StrictSeq (TxOut era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictSeq (TxOut era) -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictSeq (TxOut era)
outputs
      TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (ValidityInterval -> Identity ValidityInterval)
-> TxBody era -> Identity (TxBody era)
forall era.
AllegraEraTxBody era =>
Lens' (TxBody era) ValidityInterval
Lens' (TxBody era) ValidityInterval
SL.vldtTxBodyL ((ValidityInterval -> Identity ValidityInterval)
 -> TxBody era -> Identity (TxBody era))
-> ValidityInterval -> TxBody era -> TxBody era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ValidityInterval
vldt
      TxBody era -> (TxBody era -> TxBody era) -> TxBody era
forall a b. a -> (a -> b) -> b
& (StrictMaybe (Update era) -> Identity (StrictMaybe (Update era)))
-> TxBody era -> Identity (TxBody era)
forall era.
ShelleyEraTxBody era =>
Lens' (TxBody era) (StrictMaybe (Update era))
Lens' (TxBody era) (StrictMaybe (Update era))
SL.updateTxBodyL ((StrictMaybe (Update era) -> Identity (StrictMaybe (Update era)))
 -> TxBody era -> Identity (TxBody era))
-> StrictMaybe (Update era) -> TxBody era -> TxBody 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 -> PaymentCredential -> StakeReference -> Addr
SL.Addr Network
networkId
                (SignKeyDSIGN DSIGN -> PaymentCredential
forall (r :: KeyRole). SignKeyDSIGN DSIGN -> Credential r
mkCredential (CoreNode (ProtoCrypto proto) -> SignKeyDSIGN DSIGN
forall c. CoreNode c -> SignKeyDSIGN DSIGN
cnDelegateKey CoreNode (ProtoCrypto proto)
cn))
                (StakeCredential -> StakeReference
SL.StakeRefBase (SignKeyDSIGN DSIGN -> StakeCredential
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 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
forall era.
Map (KeyHash 'Genesis) (PParamsUpdate era) -> ProposedPPUpdates era
SL.ProposedPPUpdates (Map (KeyHash 'Genesis) (PParamsUpdate era)
 -> ProposedPPUpdates era)
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
-> ProposedPPUpdates era
forall a b. (a -> b) -> a -> b
$
        [(KeyHash 'Genesis, PParamsUpdate era)]
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash 'Genesis, PParamsUpdate era)]
 -> Map (KeyHash 'Genesis) (PParamsUpdate era))
-> [(KeyHash 'Genesis, PParamsUpdate era)]
-> Map (KeyHash 'Genesis) (PParamsUpdate era)
forall a b. (a -> b) -> a -> b
$
        [ ( VKey 'Genesis -> KeyHash 'Genesis
forall (kd :: KeyRole). VKey kd -> KeyHash kd
SL.hashKey (VKey 'Genesis -> KeyHash 'Genesis)
-> VKey 'Genesis -> KeyHash 'Genesis
forall a b. (a -> b) -> a -> b
$ VerKeyDSIGN DSIGN -> VKey 'Genesis
forall (kd :: KeyRole). VerKeyDSIGN DSIGN -> VKey kd
SL.VKey (VerKeyDSIGN DSIGN -> VKey 'Genesis)
-> VerKeyDSIGN DSIGN -> VKey 'Genesis
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, ProtVerAtMost era 6) =>
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, ProtVerAtMost era 8) =>
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