{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Cardano.CLI.EraBased.Genesis.CreateTestnetData.Run
  ( runGenesisKeyGenUTxOCmd
  , runGenesisKeyGenGenesisCmd
  , runGenesisKeyGenDelegateCmd
  , runGenesisCreateTestNetDataCmd
  , runGenesisKeyGenDelegateVRF
  , writeFileGenesis
  , WriteFileGenesis (..)
  )
where

import Cardano.Api hiding (ConwayEra)
import Cardano.Api.Ledger (StandardCrypto, StrictMaybe (SNothing))
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Byron.Genesis (NewDirectory (NewDirectory))
import Cardano.CLI.Byron.Genesis qualified as Byron
import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Genesis.Command as Cmd
import Cardano.CLI.EraBased.Genesis.Internal.Byron as Byron
import Cardano.CLI.EraBased.Genesis.Internal.Common
import Cardano.CLI.EraBased.Governance.Committee.Command qualified as CC
import Cardano.CLI.EraBased.Governance.Committee.Run qualified as CC
import Cardano.CLI.EraBased.Governance.DRep.Command qualified as DRep
import Cardano.CLI.EraBased.Governance.DRep.Run qualified as DRep
import Cardano.CLI.EraBased.StakeAddress.Run (runStakeAddressKeyGenCmd)
import Cardano.CLI.EraIndependent.Address.Run (generateAndWriteKeyFiles)
import Cardano.CLI.EraIndependent.Key.Run qualified as Key
import Cardano.CLI.EraIndependent.Node.Command qualified as Cmd
import Cardano.CLI.EraIndependent.Node.Run
  ( runNodeIssueOpCertCmd
  , runNodeKeyGenColdCmd
  , runNodeKeyGenKesCmd
  , runNodeKeyGenVrfCmd
  )
import Cardano.CLI.IO.Lazy qualified as Lazy
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.GenesisCmdError
import Cardano.CLI.Type.Error.NodeCmdError
import Cardano.CLI.Type.Error.StakePoolCmdError
import Cardano.CLI.Type.Key
import Cardano.Crypto.Hash qualified as Crypto
import Cardano.Prelude (canonicalEncodePretty)
import Cardano.Protocol.Crypto qualified as C

import RIO (throwString)

import Control.DeepSeq (NFData, deepseq)
import Control.Monad (forM, forM_, unless, when)
import Data.Aeson.Encode.Pretty qualified as Aeson
import Data.Bifunctor (Bifunctor (..))
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Functor
import Data.Functor.Identity (Identity)
import Data.ListMap (ListMap (..))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Sequence.Strict qualified as Seq
import Data.Set qualified as Set
import Data.String (fromString)
import Data.Text qualified as Text
import Data.Tuple (swap)
import Data.Word (Word64)
import GHC.Exts (IsList (..))
import GHC.Generics (Generic)
import GHC.Num (Natural)
import GHC.Stack
import Lens.Micro ((^.))
import System.Directory
import System.FilePath ((</>))
import System.Random (StdGen)
import System.Random qualified as Random
import Text.JSON.Canonical (parseCanonicalJSON, renderCanonicalJSON)
import Text.JSON.Canonical qualified (ToJSON)
import Text.Printf (printf)
import Vary (Vary)
import Vary qualified
import Vary.Utils ((:|))

runGenesisKeyGenGenesisCmd
  :: GenesisKeyGenGenesisCmdArgs
  -> CIO e ()
runGenesisKeyGenGenesisCmd :: forall e. GenesisKeyGenGenesisCmdArgs -> CIO e ()
runGenesisKeyGenGenesisCmd
  Cmd.GenesisKeyGenGenesisCmdArgs
    { VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenGenesisCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
    , SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenGenesisCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
    } = do
    skey <- AsType GenesisKey -> RIO e (SigningKey GenesisKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisKey
AsGenesisKey
    let vkey = SigningKey GenesisKey -> VerificationKey GenesisKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisKey
skey
    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringFile signingKeyPath $
        textEnvelopeToJSON (Just skeyDesc) skey
    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringFile verificationKeyPath $
        textEnvelopeToJSON (Just Key.genesisVkeyDesc) vkey
   where
    skeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis Signing Key"

runGenesisKeyGenDelegateCmd
  :: GenesisKeyGenDelegateCmdArgs
  -> CIO e ()
runGenesisKeyGenDelegateCmd :: forall e. GenesisKeyGenDelegateCmdArgs -> CIO e ()
runGenesisKeyGenDelegateCmd
  Cmd.GenesisKeyGenDelegateCmdArgs
    { VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenDelegateCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
    , SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenDelegateCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
    , OpCertCounterFile 'Out
opCertCounterPath :: OpCertCounterFile 'Out
opCertCounterPath :: GenesisKeyGenDelegateCmdArgs -> OpCertCounterFile 'Out
Cmd.opCertCounterPath
    } = do
    skey <- AsType GenesisDelegateKey -> RIO e (SigningKey GenesisDelegateKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey
    let vkey = SigningKey GenesisDelegateKey -> VerificationKey GenesisDelegateKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisDelegateKey
skey
    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringFile signingKeyPath $
        textEnvelopeToJSON (Just skeyDesc) skey
    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringFile verificationKeyPath $
        textEnvelopeToJSON (Just Key.genesisVkeyDelegateDesc) vkey
    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringFile opCertCounterPath $
        textEnvelopeToJSON (Just certCtrDesc) $
          OperationalCertificateIssueCounter
            initialCounter
            (castVerificationKey vkey) -- Cast to a 'StakePoolKey'
   where
    skeyDesc, certCtrDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis delegate operator key"
    certCtrDesc :: TextEnvelopeDescr
certCtrDesc =
      TextEnvelopeDescr
"Next certificate issue number: "
        TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
forall a. Semigroup a => a -> a -> a
<> FilePath -> TextEnvelopeDescr
forall a. IsString a => FilePath -> a
fromString (Word64 -> FilePath
forall a. Show a => a -> FilePath
show Word64
initialCounter)

    initialCounter :: Word64
    initialCounter :: Word64
initialCounter = Word64
0

runGenesisKeyGenDelegateVRF
  :: VerificationKeyFile Out
  -> SigningKeyFile Out
  -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateVRF :: VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateVRF VerificationKeyFile 'Out
vkeyPath SigningKeyFile 'Out
skeyPath = do
  skey <- AsType VrfKey -> ExceptT GenesisCmdError IO (SigningKey VrfKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType VrfKey
AsVrfKey
  let vkey = SigningKey VrfKey -> VerificationKey VrfKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey VrfKey
skey
  firstExceptT GenesisCmdGenesisFileError . newExceptT $ do
    void $
      writeLazyByteStringFile skeyPath $
        textEnvelopeToJSON (Just skeyDesc) skey
    writeLazyByteStringFile vkeyPath $
      textEnvelopeToJSON (Just vkeyDesc) vkey
 where
  skeyDesc, vkeyDesc :: TextEnvelopeDescr
  skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"VRF Signing Key"
  vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"VRF Verification Key"

runGenesisKeyGenUTxOCmd
  :: GenesisKeyGenUTxOCmdArgs
  -> CIO e ()
runGenesisKeyGenUTxOCmd :: forall e. GenesisKeyGenUTxOCmdArgs -> CIO e ()
runGenesisKeyGenUTxOCmd
  Cmd.GenesisKeyGenUTxOCmdArgs
    { VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenUTxOCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
    , SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenUTxOCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
    } = do
    skey <- AsType GenesisUTxOKey -> RIO e (SigningKey GenesisUTxOKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey
    let vkey = SigningKey GenesisUTxOKey -> VerificationKey GenesisUTxOKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisUTxOKey
skey
    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringFile signingKeyPath $
        textEnvelopeToJSON (Just skeyDesc) skey
    fromEitherIOCli @(FileError ()) $
      writeLazyByteStringFile verificationKeyPath $
        textEnvelopeToJSON (Just vkeyDesc) vkey
   where
    skeyDesc, vkeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis Initial UTxO Signing Key"
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Genesis Initial UTxO Verification Key"

writeFileGenesis
  :: FilePath
  -> WriteFileGenesis
  -> ExceptT GenesisCmdError IO (Crypto.Hash Crypto.Blake2b_256 ByteString)
writeFileGenesis :: FilePath
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis FilePath
fpath WriteFileGenesis
genesis = do
  (IOException -> GenesisCmdError)
-> IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> GenesisCmdError
GenesisCmdGenesisFileError (FileError () -> GenesisCmdError)
-> (IOException -> FileError ()) -> IOException -> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOException -> FileError ()
forall e. FilePath -> IOException -> FileError e
FileIOError FilePath
fpath) (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fpath ByteString
content
  Hash Blake2b_256 ByteString
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a. a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash Blake2b_256 ByteString
 -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> Hash Blake2b_256 ByteString
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
content
 where
  content :: ByteString
content = case WriteFileGenesis
genesis of
    WritePretty genesis
a -> ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ genesis -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty genesis
a
    WriteCanonical genesis
a ->
      ByteString -> ByteString
LBS.toStrict
        (ByteString -> ByteString)
-> (genesis -> ByteString) -> genesis -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ByteString
renderCanonicalJSON
        (JSValue -> ByteString)
-> (genesis -> JSValue) -> genesis -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> JSValue)
-> (JSValue -> JSValue) -> Either FilePath JSValue -> JSValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> JSValue
forall a. HasCallStack => FilePath -> a
error (FilePath -> JSValue)
-> (FilePath -> FilePath) -> FilePath -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"error parsing json that was just encoded!? " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) JSValue -> JSValue
forall a. a -> a
id
        (Either FilePath JSValue -> JSValue)
-> (genesis -> Either FilePath JSValue) -> genesis -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath JSValue
parseCanonicalJSON
        (ByteString -> Either FilePath JSValue)
-> (genesis -> ByteString) -> genesis -> Either FilePath JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. genesis -> ByteString
forall a. ToJSON Identity a => a -> ByteString
canonicalEncodePretty
        (genesis -> ByteString) -> genesis -> ByteString
forall a b. (a -> b) -> a -> b
$ genesis
a

data WriteFileGenesis where
  WriteCanonical :: Text.JSON.Canonical.ToJSON Identity genesis => genesis -> WriteFileGenesis
  WritePretty :: ToJSON genesis => genesis -> WriteFileGenesis

runGenesisCreateTestNetDataCmd
  :: GenesisCreateTestNetDataCmdArgs
  -> CIO e ()
runGenesisCreateTestNetDataCmd :: forall e. GenesisCreateTestNetDataCmdArgs -> CIO e ()
runGenesisCreateTestNetDataCmd
  Cmd.GenesisCreateTestNetDataCmdArgs
    { Era era
eon :: Era era
eon :: ()
eon
    , Maybe NetworkId
networkId :: Maybe NetworkId
networkId :: GenesisCreateTestNetDataCmdArgs -> Maybe NetworkId
networkId
    , Maybe FilePath
specShelley :: Maybe FilePath
specShelley :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
specShelley
    , Maybe FilePath
specAlonzo :: Maybe FilePath
specAlonzo :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
specAlonzo
    , Maybe FilePath
specConway :: Maybe FilePath
specConway :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
specConway
    , Maybe FilePath
specDijkstra :: Maybe FilePath
specDijkstra :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
specDijkstra
    , Word
numGenesisKeys :: Word
numGenesisKeys :: GenesisCreateTestNetDataCmdArgs -> Word
numGenesisKeys
    , Word
numPools :: Word
numPools :: GenesisCreateTestNetDataCmdArgs -> Word
numPools
    , stakeDelegators :: GenesisCreateTestNetDataCmdArgs -> StakeDelegators
stakeDelegators =
      StakeDelegators
        { CredentialGenerationMode
stakeDelegatorsGenerationMode :: CredentialGenerationMode
stakeDelegatorsGenerationMode :: StakeDelegators -> CredentialGenerationMode
stakeDelegatorsGenerationMode
        , Word
numOfStakeDelegators :: Word
numOfStakeDelegators :: StakeDelegators -> Word
numOfStakeDelegators
        }
    , Word
numCommitteeKeys :: Word
numCommitteeKeys :: GenesisCreateTestNetDataCmdArgs -> Word
numCommitteeKeys
    , numDRepKeys :: GenesisCreateTestNetDataCmdArgs -> DRepCredentials
numDRepKeys =
      DRepCredentials
        { CredentialGenerationMode
dRepCredentialGenerationMode :: CredentialGenerationMode
dRepCredentialGenerationMode :: DRepCredentials -> CredentialGenerationMode
dRepCredentialGenerationMode
        , Word
numOfDRepCredentials :: Word
numOfDRepCredentials :: DRepCredentials -> Word
numOfDRepCredentials
        }
    , Word
numStuffedUtxo :: Word
numStuffedUtxo :: GenesisCreateTestNetDataCmdArgs -> Word
numStuffedUtxo
    , Word
numUtxoKeys :: Word
numUtxoKeys :: GenesisCreateTestNetDataCmdArgs -> Word
numUtxoKeys
    , Maybe Coin
totalSupply :: Maybe Coin
totalSupply :: GenesisCreateTestNetDataCmdArgs -> Maybe Coin
totalSupply
    , Maybe Coin
delegatedSupply :: Maybe Coin
delegatedSupply :: GenesisCreateTestNetDataCmdArgs -> Maybe Coin
delegatedSupply
    , Maybe FilePath
relays :: Maybe FilePath
relays :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
relays
    , Maybe SystemStart
systemStart :: Maybe SystemStart
systemStart :: GenesisCreateTestNetDataCmdArgs -> Maybe SystemStart
systemStart
    , FilePath
outputDir :: FilePath
outputDir :: GenesisCreateTestNetDataCmdArgs -> FilePath
outputDir
    } = do
    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
outputDir
    shelleyGenesisInit <-
      ShelleyGenesis -> Maybe ShelleyGenesis -> ShelleyGenesis
forall a. a -> Maybe a -> a
fromMaybe ShelleyGenesis
shelleyGenesisDefaults
        (Maybe ShelleyGenesis -> ShelleyGenesis)
-> RIO e (Maybe ShelleyGenesis) -> RIO e ShelleyGenesis
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> RIO e ShelleyGenesis)
-> Maybe FilePath -> RIO e (Maybe ShelleyGenesis)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis)
-> (FilePath -> ExceptT GenesisCmdError IO ShelleyGenesis)
-> FilePath
-> RIO e ShelleyGenesis
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ExceptT GenesisCmdError IO ShelleyGenesis
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
FilePath -> t m ShelleyGenesis
decodeShelleyGenesisFile) Maybe FilePath
specShelley
    alonzoGenesis <-
      fromMaybe alonzoGenesisDefaults
        <$> traverse (fromExceptTCli . decodeAlonzoGenesisFile) specAlonzo
    conwayGenesis <-
      fromMaybe conwayGenesisDefaults <$> fromExceptTCli (traverse decodeConwayGenesisFile specConway)
    dijkstraGenesis <-
      fromMaybe dijkstraGenesisDefaults
        <$> fromExceptTCli (traverse decodeDijkstraGenesisFile specDijkstra)

    -- Read NetworkId either from file or from the flag. Flag overrides template file.
    let actualNetworkId =
          case Maybe NetworkId
networkId of
            Just NetworkId
networkFromFlag -> NetworkId
networkFromFlag
            Maybe NetworkId
Nothing -> NetworkMagic -> NetworkId
fromNetworkMagic (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Word32 -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis -> Word32
sgNetworkMagic ShelleyGenesis
shelleyGenesisInit)
        actualNetworkWord32 = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
actualNetworkId)
        shelleyGenesis = ShelleyGenesis
shelleyGenesisInit{sgNetworkMagic = actualNetworkWord32}
        -- {0 -> genesis-keys/genesis0/key.vkey, 1 -> genesis-keys/genesis1/key.vkey, ...}
        genesisVKeysPaths = Word -> FilePath -> FilePath -> FilePath -> Map Int FilePath
mkPaths Word
numGenesisKeys FilePath
genesisDir FilePath
"genesis" FilePath
"key.vkey"
        -- {0 -> delegate-keys/delegate0/key.vkey, 1 -> delegate-keys/delegate1/key.vkey, ...}
        delegateKeys = Word -> FilePath -> FilePath -> FilePath -> Map Int FilePath
mkPaths Word
numGenesisKeys FilePath
delegateDir FilePath
"delegate" FilePath
"key.vkey"
        -- {0 -> delegate-keys/delegate0/vrf.vkey, 1 -> delegate-keys/delegate1/vrf.vkey, ...}
        delegateVrfKeys = Word -> FilePath -> FilePath -> FilePath -> Map Int FilePath
mkPaths Word
numGenesisKeys FilePath
delegateDir FilePath
"delegate" FilePath
"vrf.vkey"
        -- {"stake-delegators/delegator1", "stake-delegators/delegator2", ...}
        stakeDelegatorsDirs = [FilePath
stakeDelegatorsDir FilePath -> FilePath -> FilePath
</> FilePath
"delegator" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
i | Word
i <- [Word
1 .. Word
numOfStakeDelegators]]

    forM_ [1 .. numGenesisKeys] $ \Word
index -> do
      FilePath -> CIO e ()
forall e. FilePath -> CIO e ()
createGenesisKeys (FilePath
genesisDir FilePath -> FilePath -> FilePath
</> (FilePath
"genesis" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))
      Vary '[FormatBech32, FormatTextEnvelope] -> FilePath -> CIO e ()
forall e.
Vary '[FormatBech32, FormatTextEnvelope] -> FilePath -> CIO e ()
createDelegateKeys Vary '[FormatBech32, FormatTextEnvelope]
forall (f :: [*]). (FormatTextEnvelope :| f) => Vary f
desiredKeyOutputFormat (FilePath
delegateDir FilePath -> FilePath -> FilePath
</> (FilePath
"delegate" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))

    when (0 < numGenesisKeys) $ do
      fromExceptTCli $ writeREADME genesisDir genesisREADME
      fromExceptTCli $ writeREADME delegateDir delegatesREADME

    -- UTxO keys
    let utxoKeyFileNames =
          [ FilePath
utxoKeysDir FilePath -> FilePath -> FilePath
</> (FilePath
"utxo" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index) FilePath -> FilePath -> FilePath
</> FilePath
"utxo.vkey"
          | Word
index <- [Word
1 .. Word
numUtxoKeys]
          ]
    forM_ [1 .. numUtxoKeys] $ \Word
index ->
      FilePath -> CIO e ()
forall e. FilePath -> CIO e ()
createUtxoKeys (FilePath
utxoKeysDir FilePath -> FilePath -> FilePath
</> (FilePath
"utxo" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))

    fromExceptTCli $ when (0 < numUtxoKeys) $ writeREADME utxoKeysDir utxoKeysREADME

    mSPOsRelays <- forM relays (fromExceptTCli . readRelays)
    case (relays, mSPOsRelays) of
      (Just FilePath
fp, Just Map Word [StakePoolRelay]
stakePoolRelays)
        | Map Word [StakePoolRelay] -> Int
forall k a. Map k a -> Int
Map.size Map Word [StakePoolRelay]
stakePoolRelays Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
numPools ->
            GenesisCmdError -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (GenesisCmdError -> RIO e ()) -> GenesisCmdError -> RIO e ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Int -> GenesisCmdError
GenesisCmdTooManyRelaysError FilePath
fp (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
numPools) (Map Word [StakePoolRelay] -> Int
forall k a. Map k a -> Int
Map.size Map Word [StakePoolRelay]
stakePoolRelays)
      (Maybe FilePath, Maybe (Map Word [StakePoolRelay]))
_ -> () -> RIO e ()
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    -- Pools
    poolParams <- forM [1 .. numPools] $ \Word
index -> do
      let poolDir :: FilePath
poolDir = Word -> FilePath
mkPoolDir Word
index

      Vary '[FormatBech32, FormatTextEnvelope] -> FilePath -> CIO e ()
forall e.
Vary '[FormatBech32, FormatTextEnvelope] -> FilePath -> CIO e ()
createPoolCredentials Vary '[FormatBech32, FormatTextEnvelope]
forall (f :: [*]). (FormatTextEnvelope :| f) => Vary f
desiredKeyOutputFormat FilePath
poolDir
      -- Indexes of directories created on disk start at 1, but
      -- indexes in terms of the relays' list start at 0. Hence 'index - 1' here:
      ExceptT GenesisCmdError IO PoolParams -> RIO e PoolParams
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO PoolParams -> RIO e PoolParams)
-> ExceptT GenesisCmdError IO PoolParams -> RIO e PoolParams
forall a b. (a -> b) -> a -> b
$ NetworkId
-> FilePath
-> Word
-> Map Word [StakePoolRelay]
-> ExceptT GenesisCmdError IO PoolParams
buildPoolParams NetworkId
actualNetworkId FilePath
poolDir (Word
index Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) (Map Word [StakePoolRelay]
-> Maybe (Map Word [StakePoolRelay]) -> Map Word [StakePoolRelay]
forall a. a -> Maybe a -> a
fromMaybe Map Word [StakePoolRelay]
forall a. Monoid a => a
mempty Maybe (Map Word [StakePoolRelay])
mSPOsRelays)

    fromExceptTCli $ when (0 < numPools) $ writeREADME poolsDir poolsREADME

    -- CC members. We don't need to look at the eon, because the command's parser guarantees
    -- that before Conway, the number of CC members at this point is 0.
    ccColdKeys <- forM [1 .. numCommitteeKeys] $ \Word
index -> do
      let committeeDir :: FilePath
committeeDir = FilePath
committeesDir FilePath -> FilePath -> FilePath
</> FilePath
"cc" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index
          vkeyHotFile :: VerificationKeyFile 'Out
vkeyHotFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
committeeDir FilePath -> FilePath -> FilePath
</> FilePath
"cc.hot.vkey"
          skeyHotFile :: SigningKeyFile 'Out
skeyHotFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
committeeDir FilePath -> FilePath -> FilePath
</> FilePath
"cc.hot.skey"
          vkeyColdFile :: VerificationKeyFile 'Out
vkeyColdFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
committeeDir FilePath -> FilePath -> FilePath
</> FilePath
"cc.cold.vkey"
          skeyColdFile :: SigningKeyFile 'Out
skeyColdFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
committeeDir FilePath -> FilePath -> FilePath
</> FilePath
"cc.cold.skey"
          hotArgs :: GovernanceCommitteeKeyGenHotCmdArgs era
hotArgs = Era era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceCommitteeKeyGenHotCmdArgs era
forall era.
Era era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceCommitteeKeyGenHotCmdArgs era
CC.GovernanceCommitteeKeyGenHotCmdArgs Era era
eon VerificationKeyFile 'Out
vkeyHotFile SigningKeyFile 'Out
skeyHotFile
          coldArgs :: GovernanceCommitteeKeyGenColdCmdArgs era
coldArgs = Era era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceCommitteeKeyGenColdCmdArgs era
forall era.
Era era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceCommitteeKeyGenColdCmdArgs era
CC.GovernanceCommitteeKeyGenColdCmdArgs Era era
eon VerificationKeyFile 'Out
vkeyColdFile SigningKeyFile 'Out
skeyColdFile
      IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
committeeDir
      RIO e (VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
-> RIO e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO
   e (VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
 -> RIO e ())
-> RIO
     e (VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
-> RIO e ()
forall a b. (a -> b) -> a -> b
$
        GovernanceCommitteeKeyGenHotCmdArgs era
-> CIO
     e (VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
forall era e.
GovernanceCommitteeKeyGenHotCmdArgs era
-> CIO
     e (VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
CC.runGovernanceCommitteeKeyGenHot GovernanceCommitteeKeyGenHotCmdArgs era
hotArgs
      (vColdKey, _) <-
        GovernanceCommitteeKeyGenColdCmdArgs era
-> CIO
     e (VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
forall era e.
GovernanceCommitteeKeyGenColdCmdArgs era
-> CIO
     e (VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
CC.runGovernanceCommitteeKeyGenCold GovernanceCommitteeKeyGenColdCmdArgs era
coldArgs
      return vColdKey

    fromExceptTCli $ when (0 < numCommitteeKeys) $ writeREADME committeesDir committeeREADME

    -- DReps. We don't need to look at the eon, because the command's parser guarantees
    -- that before Conway, the number of DReps at this point is 0.
    g <- Random.getStdGen

    dRepKeys <-
      case dRepCredentialGenerationMode of
        CredentialGenerationMode
OnDisk -> [Word]
-> (Word -> RIO e (VerificationKey DRepKey))
-> RIO e [VerificationKey DRepKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Word
1 .. Word
numOfDRepCredentials] ((Word -> RIO e (VerificationKey DRepKey))
 -> RIO e [VerificationKey DRepKey])
-> (Word -> RIO e (VerificationKey DRepKey))
-> RIO e [VerificationKey DRepKey]
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
          let drepDir :: FilePath
drepDir = FilePath
drepsDir FilePath -> FilePath -> FilePath
</> FilePath
"drep" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index
              vkeyFile :: VerificationKeyFile 'Out
vkeyFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
drepDir FilePath -> FilePath -> FilePath
</> FilePath
"drep.vkey"
              skeyFile :: SigningKeyFile 'Out
skeyFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
drepDir FilePath -> FilePath -> FilePath
</> FilePath
"drep.skey"
              cmd :: GovernanceDRepKeyGenCmdArgs era
cmd = Era era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceDRepKeyGenCmdArgs era
forall era.
Era era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceDRepKeyGenCmdArgs era
DRep.GovernanceDRepKeyGenCmdArgs Era era
eon VerificationKeyFile 'Out
vkeyFile SigningKeyFile 'Out
skeyFile
          IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
drepDir
          (VerificationKey DRepKey, SigningKey DRepKey)
-> VerificationKey DRepKey
forall a b. (a, b) -> a
fst ((VerificationKey DRepKey, SigningKey DRepKey)
 -> VerificationKey DRepKey)
-> RIO e (VerificationKey DRepKey, SigningKey DRepKey)
-> RIO e (VerificationKey DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GovernanceDRepKeyGenCmdArgs era
-> CIO e (VerificationKey DRepKey, SigningKey DRepKey)
forall era e.
GovernanceDRepKeyGenCmdArgs era
-> CIO e (VerificationKey DRepKey, SigningKey DRepKey)
DRep.runGovernanceDRepKeyGenCmd GovernanceDRepKeyGenCmdArgs era
cmd
        CredentialGenerationMode
Transient ->
          IO [VerificationKey DRepKey] -> RIO e [VerificationKey DRepKey]
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VerificationKey DRepKey] -> RIO e [VerificationKey DRepKey])
-> IO [VerificationKey DRepKey] -> RIO e [VerificationKey DRepKey]
forall a b. (a -> b) -> a -> b
$
            (StdGen -> Word -> IO (StdGen, VerificationKey DRepKey))
-> StdGen -> [Word] -> IO [VerificationKey DRepKey]
forall acc b c. (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM
              (\StdGen
g' Word
_ -> (VerificationKey DRepKey, StdGen)
-> (StdGen, VerificationKey DRepKey)
forall a b. (a, b) -> (b, a)
swap ((VerificationKey DRepKey, StdGen)
 -> (StdGen, VerificationKey DRepKey))
-> ((SigningKey DRepKey, StdGen)
    -> (VerificationKey DRepKey, StdGen))
-> (SigningKey DRepKey, StdGen)
-> (StdGen, VerificationKey DRepKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigningKey DRepKey -> VerificationKey DRepKey)
-> (SigningKey DRepKey, StdGen)
-> (VerificationKey DRepKey, StdGen)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SigningKey DRepKey -> VerificationKey DRepKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey ((SigningKey DRepKey, StdGen) -> (StdGen, VerificationKey DRepKey))
-> IO (SigningKey DRepKey, StdGen)
-> IO (StdGen, VerificationKey DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> AsType DRepKey -> IO (SigningKey DRepKey, StdGen)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole,
 SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> m (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g' AsType DRepKey
AsDRepKey)
              StdGen
g
              [Word
1 .. Word
numOfDRepCredentials]

    fromExceptTCli $
      when (0 < numOfDRepCredentials && dRepCredentialGenerationMode == OnDisk) $
        writeREADME drepsDir drepsREADME

    -- Stake delegators
    g2 <- Random.getStdGen
    delegatorKeys <- case stakeDelegatorsGenerationMode of
      CredentialGenerationMode
OnDisk -> [FilePath]
-> (FilePath
    -> RIO e (VerificationKey PaymentKey, VerificationKey StakeKey))
-> RIO e [(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
stakeDelegatorsDirs ((FilePath
  -> RIO e (VerificationKey PaymentKey, VerificationKey StakeKey))
 -> RIO e [(VerificationKey PaymentKey, VerificationKey StakeKey)])
-> (FilePath
    -> RIO e (VerificationKey PaymentKey, VerificationKey StakeKey))
-> RIO e [(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall a b. (a -> b) -> a -> b
$ \FilePath
delegator -> FilePath
-> CIO e (VerificationKey PaymentKey, VerificationKey StakeKey)
forall e.
FilePath
-> CIO e (VerificationKey PaymentKey, VerificationKey StakeKey)
createStakeDelegatorCredentials FilePath
delegator
      CredentialGenerationMode
Transient -> IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> RIO e [(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
 -> RIO e [(VerificationKey PaymentKey, VerificationKey StakeKey)])
-> IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> RIO e [(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall a b. (a -> b) -> a -> b
$ (StdGen
 -> Word
 -> IO
      (StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey)))
-> StdGen
-> [Word]
-> IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall acc b c. (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM (\StdGen
g' Word
_ -> StdGen
-> IO
     (StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
computeInsecureStakeKeyAddr StdGen
g') StdGen
g2 [Word
1 .. Word
numOfStakeDelegators]

    let (delegsPerPool, delegsRemaining) =
          if numPools == 0
            then (0, 0)
            else numOfStakeDelegators `divMod` numPools
        delegsForPool Word
poolIx =
          if Word
poolIx Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
delegsRemaining
            then Word
delegsPerPool Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1
            else Word
delegsPerPool
        distribution = [PoolParams
pool | (PoolParams
pool, Word
poolIx) <- [PoolParams] -> [Word] -> [(PoolParams, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PoolParams]
poolParams [Word
1 ..], Word
_ <- [Word
1 .. Word -> Word
delegsForPool Word
poolIx]]

    -- Distribute M delegates across N pools:
    let delegations = ((VerificationKey PaymentKey, VerificationKey StakeKey)
 -> PoolParams -> Delegation)
-> [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> [PoolParams]
-> [Delegation]
forall c a b. NFData c => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithDeepSeq (NetworkId
-> (VerificationKey PaymentKey, VerificationKey StakeKey)
-> PoolParams
-> Delegation
computeDelegation NetworkId
actualNetworkId) [(VerificationKey PaymentKey, VerificationKey StakeKey)]
delegatorKeys [PoolParams]
distribution

    genDlgs <- fromExceptTCli $ readGenDelegsMap genesisVKeysPaths delegateKeys delegateVrfKeys
    nonDelegAddrs <- fromExceptTCli $ readInitialFundAddresses utxoKeyFileNames actualNetworkId
    start <- maybe (SystemStart <$> getCurrentTimePlus30) pure systemStart

    let network = NetworkId -> Network
toShelleyNetwork NetworkId
actualNetworkId
    stuffedUtxoAddrs <-
      liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ genStuffedAddress network

    conwayGenesis' <-
      addDRepsToConwayGenesis dRepKeys (map snd delegatorKeys) conwayGenesis
        <&> addCommitteeToConwayGenesis ccColdKeys

    let stake = (PoolParams -> KeyHash 'StakePool)
-> (KeyHash 'Staking, PoolParams)
-> (KeyHash 'Staking, KeyHash 'StakePool)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second PoolParams -> KeyHash 'StakePool
L.ppId ((KeyHash 'Staking, PoolParams)
 -> (KeyHash 'Staking, KeyHash 'StakePool))
-> (Delegation -> (KeyHash 'Staking, PoolParams))
-> Delegation
-> (KeyHash 'Staking, KeyHash 'StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation -> (KeyHash 'Staking, PoolParams)
mkDelegationMapEntry (Delegation -> (KeyHash 'Staking, KeyHash 'StakePool))
-> [Delegation] -> [(KeyHash 'Staking, KeyHash 'StakePool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
        stakePools = [(PoolParams -> KeyHash 'StakePool
L.ppId PoolParams
poolParams', PoolParams
poolParams') | PoolParams
poolParams' <- (KeyHash 'Staking, PoolParams) -> PoolParams
forall a b. (a, b) -> b
snd ((KeyHash 'Staking, PoolParams) -> PoolParams)
-> (Delegation -> (KeyHash 'Staking, PoolParams))
-> Delegation
-> PoolParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation -> (KeyHash 'Staking, PoolParams)
mkDelegationMapEntry (Delegation -> PoolParams) -> [Delegation] -> [PoolParams]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations]
        delegAddrs = Delegation -> AddressInEra ShelleyEra
dInitialUtxoAddr (Delegation -> AddressInEra ShelleyEra)
-> [Delegation] -> [AddressInEra ShelleyEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
    !shelleyGenesis' <-
      fromExceptTCli $
        updateOutputTemplate
          start
          genDlgs
          totalSupply
          nonDelegAddrs
          stakePools
          stake
          delegatedSupply
          (length delegations)
          delegAddrs
          stuffedUtxoAddrs
          shelleyGenesis

    let byronGenesisFp = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"byron.genesis.spec.json" -- This file is used by the performance testing team.
    void $
      fromExceptTCli $
        writeFileGenesis byronGenesisFp $
          WritePretty Byron.defaultProtocolParamsJsonValue

    let byronGenesisParameters = Word -> Word32 -> FilePath -> ShelleyGenesis -> GenesisParameters
Byron.mkGenesisParameters Word
numPools Word32
actualNetworkWord32 FilePath
byronGenesisFp ShelleyGenesis
shelleyGenesis'
        byronOutputDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"byron-gen-command"
    (byronGenesis, byronSecrets) <-
      Byron.mkGenesis byronGenesisParameters

    fromExceptTCli $
      Byron.dumpGenesis (NewDirectory byronOutputDir) byronGenesis byronSecrets

    -- Move things from byron-gen-command to the nodes' directories
    forM_ [1 .. numPools] $ \Word
index -> do
      let poolDir :: FilePath
poolDir = Word -> FilePath
mkPoolDir Word
index
          inputIndex :: FilePath
inputIndex = FilePath -> Word -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%03d" (Word
index Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) -- mkGenesis is 0-based
          mkInputFile :: FilePath -> FilePath -> FilePath
mkInputFile FilePath
filePrefix FilePath
suffix = FilePath
byronOutputDir FilePath -> FilePath -> FilePath
</> FilePath
filePrefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
inputIndex FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
suffix
      IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
        FilePath -> FilePath -> IO ()
renameFile (FilePath -> FilePath -> FilePath
mkInputFile FilePath
"delegate-keys." FilePath
".key") (FilePath
poolDir FilePath -> FilePath -> FilePath
</> FilePath
"byron-delegate.key")
        FilePath -> FilePath -> IO ()
renameFile (FilePath -> FilePath -> FilePath
mkInputFile FilePath
"delegation-cert." FilePath
".json") (FilePath
poolDir FilePath -> FilePath -> FilePath
</> FilePath
"byron-delegation.cert")

    -- Install the byron genesis where it's supposed to be
    liftIO $ renameFile (byronOutputDir </> "genesis.json") (outputDir </> "byron-genesis.json")
    -- Note that we leave some content in the "byron-gen-command" directory:
    -- 1. Deleting a non-empty directory on Windows is hard (yes -> https://github.com/haskell/directory/pull/108)
    -- 2. Users of cardano-testnet may use them

    forM_
      [ ("shelley-genesis.json", WritePretty shelleyGenesis')
      , ("alonzo-genesis.json", WritePretty alonzoGenesis)
      , ("conway-genesis.json", WritePretty conwayGenesis')
      , ("dijkstra-genesis.json", WritePretty dijkstraGenesis)
      ]
      $ \(FilePath
filename, WriteFileGenesis
genesis) -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> RIO e (Hash Blake2b_256 ByteString)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
 -> RIO e (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> RIO e (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ FilePath
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
filename) WriteFileGenesis
genesis
   where
    genesisDir :: FilePath
genesisDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"genesis-keys"
    delegateDir :: FilePath
delegateDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"delegate-keys"
    committeesDir :: FilePath
committeesDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"cc-keys"
    drepsDir :: FilePath
drepsDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"drep-keys"
    utxoKeysDir :: FilePath
utxoKeysDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"utxo-keys"
    poolsDir :: FilePath
poolsDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"pools-keys"
    stakeDelegatorsDir :: FilePath
stakeDelegatorsDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"stake-delegators"
    mkPoolDir :: Word -> FilePath
mkPoolDir Word
idx = FilePath
poolsDir FilePath -> FilePath -> FilePath
</> (FilePath
"pool" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
idx)

    mkDelegationMapEntry
      :: Delegation -> (L.KeyHash L.Staking, L.PoolParams)
    mkDelegationMapEntry :: Delegation -> (KeyHash 'Staking, PoolParams)
mkDelegationMapEntry Delegation
d = (Delegation -> KeyHash 'Staking
dDelegStaking Delegation
d, Delegation -> PoolParams
dPoolParams Delegation
d)

    addCommitteeToConwayGenesis
      :: [VerificationKey CommitteeColdKey]
      -> L.ConwayGenesis
      -> L.ConwayGenesis
    addCommitteeToConwayGenesis :: [VerificationKey CommitteeColdKey]
-> ConwayGenesis -> ConwayGenesis
addCommitteeToConwayGenesis [VerificationKey CommitteeColdKey]
ccColdKeys ConwayGenesis
conwayGenesis =
      ConwayGenesis
conwayGenesis
        { L.cgCommittee =
            L.Committee
              { L.committeeMembers =
                  Map.fromList $ map ((,EpochNo maxBound) . toCommitteeColdCredential) ccColdKeys
              , L.committeeThreshold = zeroUnitInterval -- Taken from cardano-testnet at the time of writing. Change to 0.5 in the future?
              }
        }
     where
      zeroUnitInterval :: UnitInterval
zeroUnitInterval = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundedRational @L.UnitInterval Rational
0
      toCommitteeColdCredential
        :: VerificationKey CommitteeColdKey -> L.Credential L.ColdCommitteeRole
      toCommitteeColdCredential :: VerificationKey CommitteeColdKey -> Credential 'ColdCommitteeRole
toCommitteeColdCredential VerificationKey CommitteeColdKey
vk = Hash CommitteeColdKey -> Credential 'ColdCommitteeRole
toCredential (VerificationKey CommitteeColdKey -> Hash CommitteeColdKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey CommitteeColdKey
vk)
       where
        toCredential :: Hash CommitteeColdKey -> L.Credential L.ColdCommitteeRole
        toCredential :: Hash CommitteeColdKey -> Credential 'ColdCommitteeRole
toCredential (CommitteeColdKeyHash KeyHash 'ColdCommitteeRole
v) = KeyHash 'ColdCommitteeRole -> Credential 'ColdCommitteeRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj KeyHash 'ColdCommitteeRole
v

    addDRepsToConwayGenesis
      :: forall m
       . HasCallStack
      => MonadIO m
      => [VerificationKey DRepKey]
      -> [VerificationKey StakeKey]
      -> L.ConwayGenesis
      -> m L.ConwayGenesis
    addDRepsToConwayGenesis :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[VerificationKey DRepKey]
-> [VerificationKey StakeKey] -> ConwayGenesis -> m ConwayGenesis
addDRepsToConwayGenesis [VerificationKey DRepKey]
dRepKeys [VerificationKey StakeKey]
stakingKeys ConwayGenesis
conwayGenesis = do
      cgInitialDReps <- Coin
-> [VerificationKey DRepKey]
-> m (ListMap (Credential 'DRepRole) DRepState)
initialDReps (UpgradeConwayPParams Identity -> HKD Identity Coin
forall (f :: * -> *). UpgradeConwayPParams f -> HKD f Coin
L.ucppDRepDeposit (UpgradeConwayPParams Identity -> HKD Identity Coin)
-> UpgradeConwayPParams Identity -> HKD Identity Coin
forall a b. (a -> b) -> a -> b
$ ConwayGenesis -> UpgradeConwayPParams Identity
L.cgUpgradePParams ConwayGenesis
conwayGenesis) [VerificationKey DRepKey]
dRepKeys
      pure $
        conwayGenesis
          { L.cgDelegs = delegs (zip stakingKeys (case dRepKeys of [] -> []; [VerificationKey DRepKey]
_ -> [VerificationKey DRepKey] -> [VerificationKey DRepKey]
forall a. HasCallStack => [a] -> [a]
cycle [VerificationKey DRepKey]
dRepKeys))
          , L.cgInitialDReps
          }
     where
      delegs
        :: [(VerificationKey StakeKey, VerificationKey DRepKey)]
        -> ListMap (L.Credential L.Staking) L.Delegatee
      delegs :: [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> ListMap (Credential 'Staking) Delegatee
delegs =
        [(Credential 'Staking, Delegatee)]
-> ListMap (Credential 'Staking) Delegatee
[Item (ListMap (Credential 'Staking) Delegatee)]
-> ListMap (Credential 'Staking) Delegatee
forall l. IsList l => [Item l] -> l
fromList
          ([(Credential 'Staking, Delegatee)]
 -> ListMap (Credential 'Staking) Delegatee)
-> ([(VerificationKey StakeKey, VerificationKey DRepKey)]
    -> [(Credential 'Staking, Delegatee)])
-> [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> ListMap (Credential 'Staking) Delegatee
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VerificationKey StakeKey, VerificationKey DRepKey)
 -> (Credential 'Staking, Delegatee))
-> [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> [(Credential 'Staking, Delegatee)]
forall a b. (a -> b) -> [a] -> [b]
map
            ( (VerificationKey StakeKey -> Credential 'Staking)
-> (VerificationKey DRepKey -> Delegatee)
-> (VerificationKey StakeKey, VerificationKey DRepKey)
-> (Credential 'Staking, Delegatee)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
                VerificationKey StakeKey -> Credential 'Staking
verificationKeytoStakeCredential
                (DRep -> Delegatee
L.DelegVote (DRep -> Delegatee)
-> (VerificationKey DRepKey -> DRep)
-> VerificationKey DRepKey
-> Delegatee
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'DRepRole -> DRep
L.DRepCredential (Credential 'DRepRole -> DRep)
-> (VerificationKey DRepKey -> Credential 'DRepRole)
-> VerificationKey DRepKey
-> DRep
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey DRepKey -> Credential 'DRepRole
verificationKeyToDRepCredential)
            )

      initialDReps
        :: Lovelace
        -> [VerificationKey DRepKey]
        -> m (ListMap (L.Credential L.DRepRole) L.DRepState)
      initialDReps :: Coin
-> [VerificationKey DRepKey]
-> m (ListMap (Credential 'DRepRole) DRepState)
initialDReps Coin
minDeposit [VerificationKey DRepKey]
verificationKeys = do
        drepDeposit <-
          m (CompactForm Coin)
-> (CompactForm Coin -> m (CompactForm Coin))
-> Maybe (CompactForm Coin)
-> m (CompactForm Coin)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
            (FilePath -> m (CompactForm Coin)
forall (m :: * -> *) a.
(MonadIO m, HasCallStack) =>
FilePath -> m a
throwString (FilePath
"Initial DRep deposit value cannot be compacted: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Coin -> FilePath
forall a. Show a => a -> FilePath
show Coin
minDeposit))
            CompactForm Coin -> m (CompactForm Coin)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
            (Coin -> Maybe (CompactForm Coin)
forall a. Compactible a => a -> Maybe (CompactForm a)
L.toCompact (Coin -> Maybe (CompactForm Coin))
-> Coin -> Maybe (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ Coin -> Coin -> Coin
forall a. Ord a => a -> a -> a
max (Integer -> Coin
L.Coin Integer
1_000_000) Coin
minDeposit)
        pure
          . fromList
          $ map
            ( \VerificationKey DRepKey
c ->
                ( VerificationKey DRepKey -> Credential 'DRepRole
verificationKeyToDRepCredential VerificationKey DRepKey
c
                , L.DRepState
                    { drepExpiry :: EpochNo
L.drepExpiry = Word64 -> EpochNo
EpochNo Word64
1_000
                    , drepAnchor :: StrictMaybe Anchor
L.drepAnchor = StrictMaybe Anchor
forall a. StrictMaybe a
SNothing
                    , CompactForm Coin
drepDeposit :: CompactForm Coin
drepDeposit :: CompactForm Coin
L.drepDeposit
                    , drepDelegs :: Set (Credential 'Staking)
L.drepDelegs = Set (Credential 'Staking)
forall a. Set a
Set.empty -- We don't need to populate this field (field "initialDReps"."keyHash-*"."delegators" in the JSON)
                    -- because its content is derived from the "delegs" field ("cgDelegs" above). In other words, when the Conway genesis is applied,
                    -- DRep delegations are computed from the "delegs" field. In the future the "delegators" field may
                    -- be omitted altogether from the JSON representation, but it remains in the Haskell type.
                    -- More details are provided here: https://github.com/IntersectMBO/cardano-ledger/issues/4782
                    }
                )
            )
            verificationKeys

      verificationKeyToDRepCredential
        :: VerificationKey DRepKey -> L.Credential L.DRepRole
      verificationKeyToDRepCredential :: VerificationKey DRepKey -> Credential 'DRepRole
verificationKeyToDRepCredential VerificationKey DRepKey
vk = Hash DRepKey -> Credential 'DRepRole
dRepKeyToCredential (VerificationKey DRepKey -> Hash DRepKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey DRepKey
vk)
       where
        dRepKeyToCredential :: Hash DRepKey -> L.Credential L.DRepRole
        dRepKeyToCredential :: Hash DRepKey -> Credential 'DRepRole
dRepKeyToCredential (DRepKeyHash KeyHash 'DRepRole
v) = KeyHash 'DRepRole -> Credential 'DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj KeyHash 'DRepRole
v

      verificationKeytoStakeCredential
        :: VerificationKey StakeKey -> L.Credential L.Staking
      verificationKeytoStakeCredential :: VerificationKey StakeKey -> Credential 'Staking
verificationKeytoStakeCredential VerificationKey StakeKey
vk = Hash StakeKey -> Credential 'Staking
stakeKeyToCredential (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
vk)
       where
        stakeKeyToCredential :: Hash StakeKey -> L.Credential L.Staking
        stakeKeyToCredential :: Hash StakeKey -> Credential 'Staking
stakeKeyToCredential (StakeKeyHash KeyHash 'Staking
v) = KeyHash 'Staking -> Credential 'Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
L.KeyHashObj KeyHash 'Staking
v

    -- \| 'zipWithDeepSeq' is like 'zipWith' but it ensures each element of the result is fully
    -- evaluated before calculating the rest of the list. We do this in order to avoid the
    -- case were we expand the intermediate representation (the two input lists) before
    -- converging to the result. The intermediate representation is larger than the result,
    -- so we try to avoid having it all in memory at once to reduce the memory footprint.
    zipWithDeepSeq :: NFData c => (a -> b -> c) -> [a] -> [b] -> [c]
    zipWithDeepSeq :: forall c a b. NFData c => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithDeepSeq a -> b -> c
_ [a]
_ [] = []
    zipWithDeepSeq a -> b -> c
_ [] [b]
_ = []
    zipWithDeepSeq a -> b -> c
f (a
h1 : [a]
t1) (b
h2 : [b]
t2) =
      let h :: c
h = a -> b -> c
f a
h1 b
h2
       in c
h c -> [c] -> [c]
forall a b. NFData a => a -> b -> b
`deepseq` (c
h c -> [c] -> [c]
forall a. a -> [a] -> [a]
: (a -> b -> c) -> [a] -> [b] -> [c]
forall c a b. NFData c => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithDeepSeq a -> b -> c
f [a]
t1 [b]
t2)

    -- \| Manually implemented (because the one in Data.Traversable requires `base-4.18` or greater)
    mapAccumM :: (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
    mapAccumM :: forall acc b c. (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM acc -> b -> IO (acc, c)
_ acc
_ [] = [c] -> IO [c]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    mapAccumM acc -> b -> IO (acc, c)
f acc
a (b
h : [b]
t) = do
      (a', h') <- acc -> b -> IO (acc, c)
f acc
a b
h
      rest <- mapAccumM f a' t
      return $ h' : rest

-- | The output format used all along this file
desiredKeyOutputFormat :: FormatTextEnvelope :| f => Vary f
desiredKeyOutputFormat :: forall (f :: [*]). (FormatTextEnvelope :| f) => Vary f
desiredKeyOutputFormat = FormatTextEnvelope -> Vary f
forall a (l :: [*]). (a :| l) => a -> Vary l
Vary.from FormatTextEnvelope
FormatTextEnvelope

writeREADME
  :: ()
  => FilePath
  -> Text.Text
  -> ExceptT GenesisCmdError IO ()
writeREADME :: FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
dir Text
content = do
  (FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdFileError (ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GenesisCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ File Text 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile File Text 'Out
file Text
content
 where
  File Text 'Out
file :: File Text.Text Out = FilePath -> File Text 'Out
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File Text 'Out) -> FilePath -> File Text 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"README.md"

genesisREADME :: Text.Text
genesisREADME :: Text
genesisREADME =
  Text -> [Text] -> Text
Text.intercalate
    Text
"\n"
    [ Text
"Keys generated by the --genesis-keys flag. In Byron these keys were used to mint blocks and initiate hard forks."
    , Text
"Starting with Shelley and decentralization, blocks started being produced by other keys than genesis keys."
    , Text
"Still, these keys were required to trigger hard forks."
    , Text
"With the introduction of Conway, these keys should become useless"
    ]

committeeREADME :: Text.Text
committeeREADME :: Text
committeeREADME =
  Text -> [Text] -> Text
Text.intercalate
    Text
"\n"
    [ Text
"Keys generated by the --committee-keys flag. These keys are used to run the constitutional committee."
    , Text
"A pair of both cold keys and hot keys are generated for each committee member."
    ]

delegatesREADME :: Text.Text
delegatesREADME :: Text
delegatesREADME =
  Text -> [Text] -> Text
Text.intercalate
    Text
"\n"
    [ Text
"Keys generated by the --genesis-keys flag. These keys are used to mint blocks when not being completely decentralized"
    , Text
"(e.g. when stake pools are not the sole block producers). These keys are intended to run nodes."
    ]

drepsREADME :: Text.Text
drepsREADME :: Text
drepsREADME =
  Text -> [Text] -> Text
Text.intercalate
    Text
"\n"
    [ Text
"Keys generated by the --drep-keys flag. These keys are for Delegated Representatives (DReps) that make decisions"
    , Text
"related to Cardano governance. Delegators that do not want to vote for each decision will pick DReps in line with"
    , Text
"their views delegate their voting power to them. The DRep's in this generated testnet data will automatically get"
    , Text
"registered and all the stake delegators (if any) will automatically delegate their vote to one of the DReps here."
    ]

utxoKeysREADME :: Text.Text
utxoKeysREADME :: Text
utxoKeysREADME =
  Text -> [Text] -> Text
Text.intercalate
    Text
"\n"
    [Text
"Keys generated by the --utxo-keys flag. These keys receive a portion of the supply."]

poolsREADME :: Text.Text
poolsREADME :: Text
poolsREADME =
  Text -> [Text] -> Text
Text.intercalate
    Text
"\n"
    [Text
"Keys generated by the --pools flag. These keys are intended to run nodes."]

-- | @mkPaths numKeys dir segment filename@ returns the paths to the keys to generate.
-- For example @mkPaths 3 dir prefix fn.ext@ returns
-- [dir/segment1/fn.ext, dir/segment2/fn.ext, dir/segment3/fn.ext]
mkPaths :: Word -> String -> String -> String -> Map Int FilePath
mkPaths :: Word -> FilePath -> FilePath -> FilePath -> Map Int FilePath
mkPaths Word
numKeys FilePath
dir FilePath
segment FilePath
filename =
  [Item (Map Int FilePath)] -> Map Int FilePath
forall l. IsList l => [Item l] -> l
fromList
    [ (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
idx, FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
segment FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
idx) FilePath -> FilePath -> FilePath
</> FilePath
filename)
    | Word
idx <- [Word
1 .. Word
numKeys]
    ]

createDelegateKeys
  :: Vary [FormatBech32, FormatTextEnvelope]
  -> FilePath
  -> CIO e ()
createDelegateKeys :: forall e.
Vary '[FormatBech32, FormatTextEnvelope] -> FilePath -> CIO e ()
createDelegateKeys Vary '[FormatBech32, FormatTextEnvelope]
fmt FilePath
dir = do
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  GenesisKeyGenDelegateCmdArgs -> CIO e ()
forall e. GenesisKeyGenDelegateCmdArgs -> CIO e ()
runGenesisKeyGenDelegateCmd
    Cmd.GenesisKeyGenDelegateCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"key.vkey"
      , signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = File (SigningKey ()) 'InOut -> SigningKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (SigningKey ()) 'InOut
coldSK
      , opCertCounterPath :: OpCertCounterFile 'Out
Cmd.opCertCounterPath = File OpCertCounter 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File OpCertCounter 'InOut
opCertCtr
      }
  ExceptT GenesisCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO () -> RIO e ())
-> ExceptT GenesisCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateVRF
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.vkey")
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.skey")
  NodeKeyGenKESCmdArgs -> RIO e ()
NodeKeyGenKESCmdArgs -> CIO e ()
forall e. NodeKeyGenKESCmdArgs -> CIO e ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> CIO e ())
-> NodeKeyGenKESCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (VerificationKey ()) 'InOut
kesVK)
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"kes.skey")
  NodeIssueOpCertCmdArgs -> RIO e ()
NodeIssueOpCertCmdArgs -> CIO e ()
forall e. NodeIssueOpCertCmdArgs -> CIO e ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> CIO e ())
-> NodeIssueOpCertCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> File OpCertCounter 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
      (VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (VerificationKey ()) 'InOut
kesVK))
      (File (SigningKey ()) 'InOut -> SigningKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (SigningKey ()) 'InOut
coldSK)
      File OpCertCounter 'InOut
opCertCtr
      (Word -> KESPeriod
KESPeriod Word
0)
      (FilePath -> File () 'Out
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File () 'Out) -> FilePath -> File () 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"opcert.cert")
 where
  kesVK :: File (VerificationKey ()) 'InOut
kesVK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> File (VerificationKey ()) 'InOut)
-> FilePath -> File (VerificationKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"kes.vkey"
  coldSK :: File (SigningKey ()) 'InOut
coldSK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> File (SigningKey ()) 'InOut)
-> FilePath -> File (SigningKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"key.skey"
  opCertCtr :: File OpCertCounter 'InOut
opCertCtr = FilePath -> File OpCertCounter 'InOut
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File OpCertCounter 'InOut)
-> FilePath -> File OpCertCounter 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"opcert.counter"

createGenesisKeys :: FilePath -> CIO e ()
createGenesisKeys :: forall e. FilePath -> CIO e ()
createGenesisKeys FilePath
dir = do
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  GenesisKeyGenGenesisCmdArgs -> CIO e ()
forall e. GenesisKeyGenGenesisCmdArgs -> CIO e ()
runGenesisKeyGenGenesisCmd
    GenesisKeyGenGenesisCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"key.vkey"
      , signingKeyPath :: SigningKeyFile 'Out
signingKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"key.skey"
      }

createStakeDelegatorCredentials
  :: FilePath
  -> CIO
       e
       ( VerificationKey PaymentKey
       , VerificationKey StakeKey
       )
createStakeDelegatorCredentials :: forall e.
FilePath
-> CIO e (VerificationKey PaymentKey, VerificationKey StakeKey)
createStakeDelegatorCredentials FilePath
dir = do
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  (pvk, _psk) <-
    Vary '[FormatBech32, FormatTextEnvelope]
-> AsType PaymentKey
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> CIO e (VerificationKey PaymentKey, SigningKey PaymentKey)
forall keyrole e.
(Key keyrole, HasTypeProxy keyrole,
 SerialiseAsBech32 (SigningKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
Vary '[FormatBech32, FormatTextEnvelope]
-> AsType keyrole
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> CIO e (VerificationKey keyrole, SigningKey keyrole)
generateAndWriteKeyFiles Vary '[FormatBech32, FormatTextEnvelope]
forall (f :: [*]). (FormatTextEnvelope :| f) => Vary f
desiredKeyOutputFormat AsType PaymentKey
AsPaymentKey VerificationKeyFile 'Out
paymentVK SigningKeyFile 'Out
paymentSK
  (svk, _ssk) <-
    runStakeAddressKeyGenCmd desiredKeyOutputFormat stakingVK stakingSK
  return (pvk, svk)
 where
  paymentVK :: VerificationKeyFile 'Out
paymentVK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"payment.vkey"
  paymentSK :: SigningKeyFile 'Out
paymentSK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"payment.skey"
  stakingVK :: VerificationKeyFile 'Out
stakingVK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking.vkey"
  stakingSK :: SigningKeyFile 'Out
stakingSK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking.skey"

createUtxoKeys :: FilePath -> CIO e ()
createUtxoKeys :: forall e. FilePath -> CIO e ()
createUtxoKeys FilePath
dir = do
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  GenesisKeyGenUTxOCmdArgs -> CIO e ()
forall e. GenesisKeyGenUTxOCmdArgs -> CIO e ()
runGenesisKeyGenUTxOCmd
    Cmd.GenesisKeyGenUTxOCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"utxo.vkey"
      , signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"utxo.skey"
      }

createPoolCredentials
  :: Vary [FormatBech32, FormatTextEnvelope]
  -> FilePath
  -> CIO e ()
createPoolCredentials :: forall e.
Vary '[FormatBech32, FormatTextEnvelope] -> FilePath -> CIO e ()
createPoolCredentials Vary '[FormatBech32, FormatTextEnvelope]
fmt FilePath
dir = do
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  NodeKeyGenKESCmdArgs -> RIO e ()
NodeKeyGenKESCmdArgs -> CIO e ()
forall e. NodeKeyGenKESCmdArgs -> CIO e ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> CIO e ())
-> NodeKeyGenKESCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (VerificationKey ()) 'InOut
kesVK)
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"kes.skey")

  NodeKeyGenVRFCmdArgs -> RIO e ()
NodeKeyGenVRFCmdArgs -> CIO e ()
forall e. NodeKeyGenVRFCmdArgs -> CIO e ()
runNodeKeyGenVrfCmd (NodeKeyGenVRFCmdArgs -> CIO e ())
-> NodeKeyGenVRFCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenVRFCmdArgs
Cmd.NodeKeyGenVRFCmdArgs
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.vkey")
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.skey")

  NodeKeyGenColdCmdArgs -> RIO e ()
NodeKeyGenColdCmdArgs -> CIO e ()
forall e. NodeKeyGenColdCmdArgs -> CIO e ()
runNodeKeyGenColdCmd (NodeKeyGenColdCmdArgs -> CIO e ())
-> NodeKeyGenColdCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> OpCertCounterFile 'Out
-> NodeKeyGenColdCmdArgs
Cmd.NodeKeyGenColdCmdArgs
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cold.vkey")
      (File (SigningKey ()) 'InOut -> SigningKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (SigningKey ()) 'InOut
coldSK)
      (File OpCertCounter 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File OpCertCounter 'InOut
opCertCtr)

  NodeIssueOpCertCmdArgs -> RIO e ()
NodeIssueOpCertCmdArgs -> CIO e ()
forall e. NodeIssueOpCertCmdArgs -> CIO e ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> CIO e ())
-> NodeIssueOpCertCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> File OpCertCounter 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
      (VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (VerificationKey ()) 'InOut
kesVK))
      (File (SigningKey ()) 'InOut -> SigningKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (SigningKey ()) 'InOut
coldSK)
      File OpCertCounter 'InOut
opCertCtr
      (Word -> KESPeriod
KESPeriod Word
0)
      (FilePath -> File () 'Out
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File () 'Out) -> FilePath -> File () 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"opcert.cert")

  RIO e (VerificationKey StakeKey, SigningKey StakeKey) -> RIO e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO e (VerificationKey StakeKey, SigningKey StakeKey) -> RIO e ())
-> RIO e (VerificationKey StakeKey, SigningKey StakeKey)
-> RIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> CIO e (VerificationKey StakeKey, SigningKey StakeKey)
forall e.
Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> CIO e (VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking-reward.vkey")
      (forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking-reward.skey")
 where
  kesVK :: File (VerificationKey ()) 'InOut
kesVK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> File (VerificationKey ()) 'InOut)
-> FilePath -> File (VerificationKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"kes.vkey"
  coldSK :: File (SigningKey ()) 'InOut
coldSK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> File (SigningKey ()) 'InOut)
-> FilePath -> File (SigningKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cold.skey"
  opCertCtr :: File OpCertCounter 'InOut
opCertCtr = FilePath -> File OpCertCounter 'InOut
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File OpCertCounter 'InOut)
-> FilePath -> File OpCertCounter 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"opcert.counter"

data Delegation = Delegation
  { Delegation -> AddressInEra ShelleyEra
dInitialUtxoAddr :: !(AddressInEra ShelleyEra)
  , Delegation -> KeyHash 'Staking
dDelegStaking :: !(L.KeyHash L.Staking)
  , Delegation -> PoolParams
dPoolParams :: !L.PoolParams
  }
  deriving ((forall x. Delegation -> Rep Delegation x)
-> (forall x. Rep Delegation x -> Delegation) -> Generic Delegation
forall x. Rep Delegation x -> Delegation
forall x. Delegation -> Rep Delegation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Delegation -> Rep Delegation x
from :: forall x. Delegation -> Rep Delegation x
$cto :: forall x. Rep Delegation x -> Delegation
to :: forall x. Rep Delegation x -> Delegation
Generic, Delegation -> ()
(Delegation -> ()) -> NFData Delegation
forall a. (a -> ()) -> NFData a
$crnf :: Delegation -> ()
rnf :: Delegation -> ()
NFData)

buildPoolParams
  :: NetworkId
  -> FilePath
  -- ^ File directory where the necessary pool credentials were created
  -> Word
  -- ^ The index of the pool being built. Starts at 0.
  -> Map Word [L.StakePoolRelay]
  -- ^ User submitted stake pool relay map. Starts at 0
  -> ExceptT GenesisCmdError IO L.PoolParams
buildPoolParams :: NetworkId
-> FilePath
-> Word
-> Map Word [StakePoolRelay]
-> ExceptT GenesisCmdError IO PoolParams
buildPoolParams NetworkId
nw FilePath
dir Word
index Map Word [StakePoolRelay]
specifiedRelays = do
  StakePoolVerificationKey poolColdVK <-
    (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
-> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (StakePoolCmdError -> GenesisCmdError
GenesisCmdStakePoolCmdError (StakePoolCmdError -> GenesisCmdError)
-> (FileError TextEnvelopeError -> StakePoolCmdError)
-> FileError TextEnvelopeError
-> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> StakePoolCmdError
StakePoolCmdReadFileError)
      (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
 -> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
 -> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ File (ZonkAny 4) 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope File (ZonkAny 4) 'In
poolColdVKF

  VrfVerificationKey poolVrfVK <-
    firstExceptT (GenesisCmdNodeCmdError . NodeCmdReadFileError)
      . newExceptT
      $ readFileTextEnvelope poolVrfVKF
  rewardsSVK <-
    firstExceptT GenesisCmdTextEnvReadFileError
      . newExceptT
      $ readFileTextEnvelope poolRewardVKF

  pure
    L.PoolParams
      { L.ppId = L.hashKey poolColdVK
      , L.ppVrf = C.hashVerKeyVRF @StandardCrypto poolVrfVK
      , L.ppPledge = L.Coin 0
      , L.ppCost = L.Coin 0
      , L.ppMargin = minBound
      , L.ppRewardAccount =
          toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK)
      , L.ppOwners = mempty
      , L.ppRelays = lookupPoolRelay specifiedRelays
      , L.ppMetadata = L.SNothing
      }
 where
  lookupPoolRelay :: Map Word [L.StakePoolRelay] -> Seq.StrictSeq L.StakePoolRelay
  lookupPoolRelay :: Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
m = [Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay
forall l. IsList l => [Item l] -> l
fromList ([Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay)
-> [Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay
forall a b. (a -> b) -> a -> b
$ [Item (StrictSeq StakePoolRelay)]
-> Word
-> Map Word [Item (StrictSeq StakePoolRelay)]
-> [Item (StrictSeq StakePoolRelay)]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Word
index Map Word [Item (StrictSeq StakePoolRelay)]
Map Word [StakePoolRelay]
m
  poolColdVKF :: File (ZonkAny 4) 'In
poolColdVKF = FilePath -> File (ZonkAny 4) 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File (ZonkAny 4) 'In)
-> FilePath -> File (ZonkAny 4) 'In
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cold.vkey"
  poolVrfVKF :: File (ZonkAny 3) 'In
poolVrfVKF = FilePath -> File (ZonkAny 3) 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File (ZonkAny 3) 'In)
-> FilePath -> File (ZonkAny 3) 'In
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.vkey"
  poolRewardVKF :: File (ZonkAny 2) 'In
poolRewardVKF = FilePath -> File (ZonkAny 2) 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File (ZonkAny 2) 'In)
-> FilePath -> File (ZonkAny 2) 'In
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking-reward.vkey"

-- | This function should only be used for testing purposes.
-- Keys returned by this function are not cryptographically secure.
computeInsecureStakeKeyAddr
  :: StdGen
  -> IO (StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
computeInsecureStakeKeyAddr :: StdGen
-> IO
     (StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
computeInsecureStakeKeyAddr StdGen
g0 = do
  (paymentKeys, g1) <- (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> (SigningKey PaymentKey, StdGen)
-> (VerificationKey PaymentKey, StdGen)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey ((SigningKey PaymentKey, StdGen)
 -> (VerificationKey PaymentKey, StdGen))
-> IO (SigningKey PaymentKey, StdGen)
-> IO (VerificationKey PaymentKey, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> AsType PaymentKey -> IO (SigningKey PaymentKey, StdGen)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole,
 SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> m (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g0 AsType PaymentKey
AsPaymentKey
  (stakeKeys, g2) <- first getVerificationKey <$> generateInsecureSigningKey g1 AsStakeKey
  return (g2, (paymentKeys, stakeKeys))

computeDelegation
  :: NetworkId
  -> (VerificationKey PaymentKey, VerificationKey StakeKey)
  -> L.PoolParams
  -> Delegation
computeDelegation :: NetworkId
-> (VerificationKey PaymentKey, VerificationKey StakeKey)
-> PoolParams
-> Delegation
computeDelegation NetworkId
nw (VerificationKey PaymentKey
paymentVK, VerificationKey StakeKey
stakeVK) PoolParams
dPoolParams = do
  let paymentCredential :: PaymentCredential
paymentCredential = Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
paymentVK)
  let stakeAddressReference :: StakeAddressReference
stakeAddressReference = StakeCredential -> StakeAddressReference
StakeAddressByValue (StakeCredential -> StakeAddressReference)
-> (VerificationKey StakeKey -> StakeCredential)
-> VerificationKey StakeKey
-> StakeAddressReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash StakeKey -> StakeCredential
StakeCredentialByKey (Hash StakeKey -> StakeCredential)
-> (VerificationKey StakeKey -> Hash StakeKey)
-> VerificationKey StakeKey
-> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey StakeKey -> StakeAddressReference)
-> VerificationKey StakeKey -> StakeAddressReference
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey
stakeVK
  Delegation
    { dInitialUtxoAddr :: AddressInEra ShelleyEra
dInitialUtxoAddr =
        ShelleyBasedEra ShelleyEra
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra ShelleyEra
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley NetworkId
nw PaymentCredential
paymentCredential StakeAddressReference
stakeAddressReference
    , dDelegStaking :: KeyHash 'Staking
dDelegStaking = VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
L.hashKey (VKey 'Staking -> KeyHash 'Staking)
-> VKey 'Staking -> KeyHash 'Staking
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey -> VKey 'Staking
unStakeVerificationKey VerificationKey StakeKey
stakeVK
    , PoolParams
dPoolParams :: PoolParams
dPoolParams :: PoolParams
dPoolParams
    }

updateOutputTemplate
  :: forall m
   . MonadError GenesisCmdError m
  => SystemStart
  -- ^ System start time
  -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
  -- ^ Genesis delegation (not stake-based)
  -> Maybe Lovelace
  -- ^ Total amount of lovelace
  -> [AddressInEra ShelleyEra]
  -- ^ UTxO addresses that are not delegating
  -> [(L.KeyHash 'L.StakePool, L.PoolParams)]
  -- ^ Pool map
  -> [(L.KeyHash 'L.Staking, L.KeyHash 'L.StakePool)]
  -- ^ Delegaton map
  -> Maybe Lovelace
  -- ^ Amount of lovelace to delegate
  -> Int
  -- ^ Number of UTxO address for delegation
  -> [AddressInEra ShelleyEra]
  -- ^ UTxO address for delegation
  -> [AddressInEra ShelleyEra]
  -- ^ Stuffed UTxO addresses
  -> ShelleyGenesis
  -- ^ Template from which to build a genesis
  -> m ShelleyGenesis
  -- ^ Updated genesis
updateOutputTemplate :: forall (m :: * -> *).
MonadError GenesisCmdError m =>
SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool, PoolParams)]
-> [(KeyHash 'Staking, KeyHash 'StakePool)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis
-> m ShelleyGenesis
updateOutputTemplate
  (SystemStart UTCTime
sgSystemStart)
  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
  Maybe Coin
mTotalSupply
  [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
  [(KeyHash 'StakePool, PoolParams)]
pools
  [(KeyHash 'Staking, KeyHash 'StakePool)]
stake
  Maybe Coin
mDelegatedSupply
  Int
nUtxoAddrsDeleg
  [AddressInEra ShelleyEra]
utxoAddrsDeleg
  [AddressInEra ShelleyEra]
stuffedUtxoAddrs
  template :: ShelleyGenesis
template@ShelleyGenesis{PParams ShelleyEra
sgProtocolParams :: PParams ShelleyEra
sgProtocolParams :: ShelleyGenesis -> PParams ShelleyEra
sgProtocolParams} = do
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
      (Integer
delegCoinRaw Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
forall a. Integral a => a
totalSupply)
      (GenesisCmdError -> m ()
forall a. GenesisCmdError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisCmdError -> m ()) -> GenesisCmdError -> m ()
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> GenesisCmdError
GenesisCmdDelegatedSupplyExceedsTotalSupply Integer
delegCoinRaw Integer
forall a. Integral a => a
totalSupply)
    ShelleyGenesis -> m ShelleyGenesis
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ShelleyGenesis
template
        { sgSystemStart
        , sgMaxLovelaceSupply = totalSupply
        , sgGenDelegs = shelleyDelKeys
        , sgInitialFunds =
            fromList
              [ (toShelleyAddr addr, v)
              | (addr, v) <-
                  distribute nonDelegCoin nUtxoAddrsNonDeleg utxoAddrsNonDeleg
                    ++ distribute delegCoin nUtxoAddrsDeleg utxoAddrsDeleg
                    ++ mkStuffedUtxo stuffedUtxoAddrs
              ]
        , sgStaking =
            ShelleyGenesisStaking
              { sgsPools = ListMap pools
              , sgsStake = ListMap stake
              }
        , sgProtocolParams
        }
   where
    nonDelegCoin :: Natural
nonDelegCoin = Integer -> Natural
getCoinForDistribution Integer
nonDelegCoinRaw
    delegCoin :: Natural
delegCoin = Integer -> Natural
getCoinForDistribution Integer
delegCoinRaw

    getCoinForDistribution :: Integer -> Natural
    getCoinForDistribution :: Integer -> Natural
getCoinForDistribution Integer
inputCoin =
      -- If the initial funds are equal to the maximum funds, rewards cannot be created.
      -- So subtrahend a part for the treasury:
      Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer
inputCoin Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
inputCoin Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
10)

    nUtxoAddrsNonDeleg :: Int
nUtxoAddrsNonDeleg = [AddressInEra ShelleyEra] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
    maximumLovelaceSupply :: Word64
    maximumLovelaceSupply :: Word64
maximumLovelaceSupply = ShelleyGenesis -> Word64
sgMaxLovelaceSupply ShelleyGenesis
template

    totalSupply :: Integral a => a
    -- if --total-supply is not specified, supply comes from the template passed to this function:
    totalSupply :: forall a. Integral a => a
totalSupply = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ Word64 -> (Coin -> Word64) -> Maybe Coin -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
maximumLovelaceSupply Coin -> Word64
forall a. Integral a => Coin -> a
unLovelace Maybe Coin
mTotalSupply

    delegCoinRaw, nonDelegCoinRaw :: Integer
    delegCoinRaw :: Integer
delegCoinRaw = Integer -> (Coin -> Integer) -> Maybe Coin -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer
forall a. Integral a => a
totalSupply Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2) Coin -> Integer
forall a. Integral a => Coin -> a
unLovelace Maybe Coin
mDelegatedSupply
    -- Since the user can specify total supply and delegated amount, the non-delegated amount is:
    nonDelegCoinRaw :: Integer
nonDelegCoinRaw = Integer
forall a. Integral a => a
totalSupply Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
delegCoinRaw

    distribute :: Natural -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
    distribute :: Natural
-> Int
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Coin)]
distribute Natural
funds Int
nAddrs [AddressInEra ShelleyEra]
addrs =
      [AddressInEra ShelleyEra]
-> [Coin] -> [(AddressInEra ShelleyEra, Coin)]
forall a b. [a] -> [b] -> [(a, b)]
zip [AddressInEra ShelleyEra]
addrs ([Coin] -> [(AddressInEra ShelleyEra, Coin)])
-> [Coin] -> [(AddressInEra ShelleyEra, Coin)]
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
L.Coin (Integer -> Coin) -> (Natural -> Integer) -> Natural -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Coin) -> [Natural] -> [Coin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural
coinPerAddr Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
remainder Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: Natural -> [Natural]
forall a. a -> [a]
repeat Natural
coinPerAddr)
     where
      coinPerAddr, remainder :: Natural
      (Natural
coinPerAddr, Natural
remainder) = Natural
funds Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nAddrs

    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Coin)]
mkStuffedUtxo [AddressInEra ShelleyEra]
xs = (,Integer -> Coin
L.Coin Integer
minUtxoVal) (AddressInEra ShelleyEra -> (AddressInEra ShelleyEra, Coin))
-> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddressInEra ShelleyEra]
xs
     where
      L.Coin Integer
minUtxoVal = PParams ShelleyEra
sgProtocolParams PParams ShelleyEra
-> Getting Coin (PParams ShelleyEra) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams ShelleyEra) Coin
forall era.
(EraPParams era, AtMostEra "Mary" era) =>
Lens' (PParams era) Coin
Lens' (PParams ShelleyEra) Coin
L.ppMinUTxOValueL
    shelleyDelKeys :: Map (KeyHash 'Genesis) GenDelegPair
shelleyDelKeys =
      [Item (Map (KeyHash 'Genesis) GenDelegPair)]
-> Map (KeyHash 'Genesis) GenDelegPair
forall l. IsList l => [Item l] -> l
fromList
        [ (KeyHash 'Genesis
gh, KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
L.GenDelegPair KeyHash 'GenesisDelegate
gdh (VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
forall a b. (a -> b) -> a -> b
$ Hash Blake2b_256 (VerKeyVRF PraosVRF) -> VRFVerKeyHash 'GenDelegVRF
forall v (r :: KeyRoleVRF).
Hash Blake2b_256 (VerKeyVRF v) -> VRFVerKeyHash r
L.toVRFVerKeyHash Hash Blake2b_256 (VerKeyVRF PraosVRF)
Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto))
h)
        | ( GenesisKeyHash KeyHash 'Genesis
gh
            , (GenesisDelegateKeyHash KeyHash 'GenesisDelegate
gdh, VrfKeyHash Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto))
h)
            ) <-
            Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> [Item
      (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
forall l. IsList l => l -> [Item l]
toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
        ]

    unLovelace :: Integral a => Lovelace -> a
    unLovelace :: forall a. Integral a => Coin -> a
unLovelace (L.Coin Integer
coin) = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
coin

readGenDelegsMap
  :: Map Int FilePath
  -> Map Int FilePath
  -> Map Int FilePath
  -> ExceptT
       GenesisCmdError
       IO
       ( Map
           (Hash GenesisKey)
           (Hash GenesisDelegateKey, Hash VrfKey)
       )
readGenDelegsMap :: Map Int FilePath
-> Map Int FilePath
-> Map Int FilePath
-> ExceptT
     GenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap Map Int FilePath
genesisKeys Map Int FilePath
delegateKeys Map Int FilePath
delegateVrfKeys = do
  gkm <- Map Int FilePath
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys Map Int FilePath
genesisKeys
  dkm <- readKeys delegateKeys
  vkm <- readKeys delegateVrfKeys

  let combinedMap
        :: Map
             Int
             ( VerificationKey GenesisKey
             , ( VerificationKey GenesisDelegateKey
               , VerificationKey VrfKey
               )
             )
      combinedMap =
        (VerificationKey GenesisKey
 -> (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
 -> (VerificationKey GenesisKey,
     (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)))
-> Map Int (VerificationKey GenesisKey)
-> Map
     Int (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
          (,)
          Map Int (VerificationKey GenesisKey)
gkm
          ((VerificationKey GenesisDelegateKey
 -> VerificationKey VrfKey
 -> (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisDelegateKey)
-> Map Int (VerificationKey VrfKey)
-> Map
     Int (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) Map Int (VerificationKey GenesisDelegateKey)
dkm Map Int (VerificationKey VrfKey)
vkm)

  -- All the maps should have an identical set of keys. Complain if not.
  let gkmExtra = Map Int (VerificationKey GenesisKey)
gkm Map Int (VerificationKey GenesisKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
      dkmExtra = Map Int (VerificationKey GenesisDelegateKey)
dkm Map Int (VerificationKey GenesisDelegateKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisDelegateKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
      vkmExtra = Map Int (VerificationKey VrfKey)
vkm Map Int (VerificationKey VrfKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey VrfKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
  unless (Map.null gkmExtra && Map.null dkmExtra && Map.null vkmExtra) $
    throwError $
      GenesisCmdMismatchedGenesisKeyFiles
        (Map.keys gkm)
        (Map.keys dkm)
        (Map.keys vkm)

  let delegsMap
        :: Map
             (Hash GenesisKey)
             (Hash GenesisDelegateKey, Hash VrfKey)
      delegsMap =
        [Item
   (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
forall l. IsList l => [Item l] -> l
fromList
          [ (Hash GenesisKey
gh, (Hash GenesisDelegateKey
dh, Hash VrfKey
vh))
          | (VerificationKey GenesisKey
g, (VerificationKey GenesisDelegateKey
d, VerificationKey VrfKey
v)) <- Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> [(VerificationKey GenesisKey,
     (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))]
forall k a. Map k a -> [a]
Map.elems Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
          , let gh :: Hash GenesisKey
gh = VerificationKey GenesisKey -> Hash GenesisKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisKey
g
                dh :: Hash GenesisDelegateKey
dh = VerificationKey GenesisDelegateKey -> Hash GenesisDelegateKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisDelegateKey
d
                vh :: Hash VrfKey
vh = VerificationKey VrfKey -> Hash VrfKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VrfKey
v
          ]

  pure delegsMap

-- | Given a map @{0 -> someKey0, 1 -> someKey1}@, lift reading
-- the files to the map's values.
readKeys
  :: ()
  => HasTextEnvelope a
  => Ord k
  => Map k FilePath
  -> ExceptT GenesisCmdError IO (Map k a)
readKeys :: forall a k.
(HasTextEnvelope a, Ord k) =>
Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys Map k FilePath
genesisVKeys = do
  (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
-> ExceptT GenesisCmdError IO (Map k a)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT (FileError TextEnvelopeError) IO (Map k a)
 -> ExceptT GenesisCmdError IO (Map k a))
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
-> ExceptT GenesisCmdError IO (Map k a)
forall a b. (a -> b) -> a -> b
$
    [(k, a)] -> Map k a
[Item (Map k a)] -> Map k a
forall l. IsList l => [Item l] -> l
fromList
      ([(k, a)] -> Map k a)
-> ExceptT (FileError TextEnvelopeError) IO [(k, a)]
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExceptT (FileError TextEnvelopeError) IO (k, a)]
-> ExceptT (FileError TextEnvelopeError) IO [(k, a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ (,) k
ix (a -> (k, a))
-> ExceptT (FileError TextEnvelopeError) IO a
-> ExceptT (FileError TextEnvelopeError) IO (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> File (ZonkAny 1) 'In -> ExceptT (FileError TextEnvelopeError) IO a
forall {content}.
File content 'In -> ExceptT (FileError TextEnvelopeError) IO a
readKey (FilePath -> File (ZonkAny 1) 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
file)
        | (k
ix, FilePath
file) <- Map k FilePath -> [Item (Map k FilePath)]
forall l. IsList l => l -> [Item l]
toList Map k FilePath
genesisVKeys
        ]
 where
  readKey :: File content 'In -> ExceptT (FileError TextEnvelopeError) IO a
readKey = IO (Either (FileError TextEnvelopeError) a)
-> ExceptT (FileError TextEnvelopeError) IO a
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) a)
 -> ExceptT (FileError TextEnvelopeError) IO a)
-> (File content 'In
    -> IO (Either (FileError TextEnvelopeError) a))
-> File content 'In
-> ExceptT (FileError TextEnvelopeError) IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File content 'In -> IO (Either (FileError TextEnvelopeError) a)
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope

readInitialFundAddresses
  :: [FilePath]
  -> NetworkId
  -> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses :: [FilePath]
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses [FilePath]
utxoKeyFileNames NetworkId
nw = do
  vkeys <-
    (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
 -> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey])
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall a b. (a -> b) -> a -> b
$
      [ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)]
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
 -> ExceptT
      (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
            forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope
              @(VerificationKey GenesisUTxOKey)
              (FilePath -> File (ZonkAny 0) 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
file)
        | FilePath
file <- [FilePath]
utxoKeyFileNames
        ]
  return
    [ addr
    | vkey <- vkeys
    , let vkh = VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey GenesisUTxOKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisUTxOKey
vkey)
          addr =
            ShelleyBasedEra ShelleyEra
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra ShelleyEra
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra
              ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
              NetworkId
nw
              (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
              StakeAddressReference
NoStakeAddress
    ]