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

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

import           Cardano.Api hiding (ConwayEra)
import           Cardano.Api.Ledger (StrictMaybe (SNothing))
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Shelley
                   (Hash (DRepKeyHash, GenesisDelegateKeyHash, GenesisKeyHash, StakeKeyHash, VrfKeyHash),
                   KESPeriod (KESPeriod),
                   OperationalCertificateIssueCounter (OperationalCertificateIssueCounter),
                   ShelleyGenesis (ShelleyGenesis, sgGenDelegs, sgInitialFunds, sgMaxLovelaceSupply, sgNetworkMagic, sgProtocolParams, sgStaking, sgSystemStart),
                   StakeCredential (StakeCredentialByKey), VerificationKey (VrfVerificationKey),
                   VrfKey, alonzoGenesisDefaults, conwayGenesisDefaults, shelleyGenesisDefaults,
                   toShelleyAddr, toShelleyNetwork, toShelleyStakeAddr)

import qualified Cardano.CLI.Commands.Node as Cmd
import           Cardano.CLI.EraBased.Commands.Genesis as Cmd
import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as DRep
import           Cardano.CLI.EraBased.Run.Genesis.Common
import qualified Cardano.CLI.EraBased.Run.Governance.DRep as DRep
import           Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd)
import qualified Cardano.CLI.IO.Lazy as Lazy
import           Cardano.CLI.Run.Address (generateAndWriteKeyFiles)
import qualified Cardano.CLI.Run.Key as Key
import           Cardano.CLI.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd,
                   runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd)
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.GenesisCmdError
import           Cardano.CLI.Types.Errors.NodeCmdError
import           Cardano.CLI.Types.Errors.StakePoolCmdError
import           Cardano.CLI.Types.Key
import qualified Cardano.Crypto.Hash as Crypto
import           Ouroboros.Consensus.Shelley.Node (ShelleyGenesisStaking (..))

import           Control.DeepSeq (NFData, deepseq)
import           Control.Monad (forM, forM_, unless, void, when)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encode.Pretty as Aeson
import qualified Data.Aeson.Key as Aeson
import qualified Data.Aeson.KeyMap as Aeson
import           Data.Bifunctor (Bifunctor (..))
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.ListMap (ListMap (..))
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromMaybe)
import qualified Data.Sequence.Strict as Seq
import           Data.String (fromString)
import qualified Data.Text as Text
import           Data.Tuple (swap)
import           Data.Word (Word64)
import qualified Data.Yaml as Yaml
import           GHC.Exts (IsList (..))
import           GHC.Generics (Generic)
import           GHC.Num (Natural)
import           Lens.Micro ((^.))
import           System.Directory (createDirectoryIfMissing)
import           System.FilePath ((</>))
import qualified System.Random as Random
import           System.Random (StdGen)

runGenesisKeyGenGenesisCmd
  :: GenesisKeyGenGenesisCmdArgs
  -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenGenesisCmd :: GenesisKeyGenGenesisCmdArgs -> ExceptT GenesisCmdError IO ()
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
    SigningKey GenesisKey
skey <- AsType GenesisKey
-> ExceptT GenesisCmdError IO (SigningKey GenesisKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisKey
AsGenesisKey
    let vkey :: VerificationKey GenesisKey
vkey = SigningKey GenesisKey -> VerificationKey GenesisKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisKey
skey
    (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
GenesisCmdGenesisFileError (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
$ do
      IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> SigningKey GenesisKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisKey
skey
      VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> VerificationKey GenesisKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.genesisVkeyDesc) VerificationKey GenesisKey
vkey
   where
    skeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis Signing Key"

runGenesisKeyGenDelegateCmd
  :: GenesisKeyGenDelegateCmdArgs
  -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateCmd :: GenesisKeyGenDelegateCmdArgs -> ExceptT GenesisCmdError IO ()
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
    SigningKey GenesisDelegateKey
skey <- AsType GenesisDelegateKey
-> ExceptT GenesisCmdError IO (SigningKey GenesisDelegateKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey
    let vkey :: VerificationKey GenesisDelegateKey
vkey = SigningKey GenesisDelegateKey -> VerificationKey GenesisDelegateKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisDelegateKey
skey
    (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
GenesisCmdGenesisFileError (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
$ do
      IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        SigningKeyFile 'Out -> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$
          Maybe TextEnvelopeDescr
-> SigningKey GenesisDelegateKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisDelegateKey
skey
      IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$
          Maybe TextEnvelopeDescr
-> VerificationKey GenesisDelegateKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.genesisVkeyDelegateDesc) VerificationKey GenesisDelegateKey
vkey
      OpCertCounterFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile OpCertCounterFile 'Out
opCertCounterPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
certCtrDesc) (OperationalCertificateIssueCounter -> ByteString)
-> OperationalCertificateIssueCounter -> ByteString
forall a b. (a -> b) -> a -> b
$
          Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter
            Word64
initialCounter
            (VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisDelegateKey
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
  SigningKey VrfKey
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 :: VerificationKey VrfKey
vkey = SigningKey VrfKey -> VerificationKey VrfKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey VrfKey
skey
  (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
GenesisCmdGenesisFileError (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
$ do
    IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
      SigningKeyFile 'Out -> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
skeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$
        Maybe TextEnvelopeDescr -> SigningKey VrfKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey VrfKey
skey
    VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
vkeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
      Maybe TextEnvelopeDescr -> VerificationKey VrfKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey VrfKey
vkey
 where
  skeyDesc, vkeyDesc :: TextEnvelopeDescr
  skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"VRF Signing Key"
  vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"VRF Verification Key"

runGenesisKeyGenUTxOCmd
  :: GenesisKeyGenUTxOCmdArgs
  -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenUTxOCmd :: GenesisKeyGenUTxOCmdArgs -> ExceptT GenesisCmdError IO ()
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
    SigningKey GenesisUTxOKey
skey <- AsType GenesisUTxOKey
-> ExceptT GenesisCmdError IO (SigningKey GenesisUTxOKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey
    let vkey :: VerificationKey GenesisUTxOKey
vkey = SigningKey GenesisUTxOKey -> VerificationKey GenesisUTxOKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisUTxOKey
skey
    (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
GenesisCmdGenesisFileError (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
$ do
      IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
        SigningKeyFile 'Out -> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$
          Maybe TextEnvelopeDescr -> SigningKey GenesisUTxOKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisUTxOKey
skey
      VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
        Maybe TextEnvelopeDescr
-> VerificationKey GenesisUTxOKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey GenesisUTxOKey
vkey
   where
    skeyDesc, vkeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis Initial UTxO Signing Key"
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Genesis Initial UTxO Verification Key"

runGenesisCreateTestNetDataCmd
  :: GenesisCreateTestNetDataCmdArgs era
  -> ExceptT GenesisCmdError IO ()
runGenesisCreateTestNetDataCmd :: forall era.
GenesisCreateTestNetDataCmdArgs era
-> ExceptT GenesisCmdError IO ()
runGenesisCreateTestNetDataCmd
  Cmd.GenesisCreateTestNetDataCmdArgs
    { ShelleyBasedEra era
eon :: ShelleyBasedEra era
eon :: forall era.
GenesisCreateTestNetDataCmdArgs era -> ShelleyBasedEra era
eon
    , Maybe NetworkId
networkId :: Maybe NetworkId
networkId :: forall era. GenesisCreateTestNetDataCmdArgs era -> Maybe NetworkId
networkId
    , Maybe FilePath
specNodeConfig :: Maybe FilePath
specNodeConfig :: forall era. GenesisCreateTestNetDataCmdArgs era -> Maybe FilePath
specNodeConfig
    , Maybe FilePath
specShelley :: Maybe FilePath
specShelley :: forall era. GenesisCreateTestNetDataCmdArgs era -> Maybe FilePath
specShelley
    , Maybe FilePath
specAlonzo :: Maybe FilePath
specAlonzo :: forall era. GenesisCreateTestNetDataCmdArgs era -> Maybe FilePath
specAlonzo
    , Maybe FilePath
specConway :: Maybe FilePath
specConway :: forall era. GenesisCreateTestNetDataCmdArgs era -> Maybe FilePath
specConway
    , Word
numGenesisKeys :: Word
numGenesisKeys :: forall era. GenesisCreateTestNetDataCmdArgs era -> Word
numGenesisKeys
    , Word
numPools :: Word
numPools :: forall era. GenesisCreateTestNetDataCmdArgs era -> Word
numPools
    , stakeDelegators :: forall era. GenesisCreateTestNetDataCmdArgs era -> StakeDelegators
stakeDelegators =
      StakeDelegators
        { CredentialGenerationMode
stakeDelegatorsGenerationMode :: CredentialGenerationMode
stakeDelegatorsGenerationMode :: StakeDelegators -> CredentialGenerationMode
stakeDelegatorsGenerationMode
        , Word
numOfStakeDelegators :: Word
numOfStakeDelegators :: StakeDelegators -> Word
numOfStakeDelegators
        }
    , numDRepKeys :: forall era. GenesisCreateTestNetDataCmdArgs era -> DRepCredentials
numDRepKeys =
      DRepCredentials
        { CredentialGenerationMode
dRepCredentialGenerationMode :: CredentialGenerationMode
dRepCredentialGenerationMode :: DRepCredentials -> CredentialGenerationMode
dRepCredentialGenerationMode
        , Word
numOfDRepCredentials :: Word
numOfDRepCredentials :: DRepCredentials -> Word
numOfDRepCredentials
        }
    , Word
numStuffedUtxo :: Word
numStuffedUtxo :: forall era. GenesisCreateTestNetDataCmdArgs era -> Word
numStuffedUtxo
    , Word
numUtxoKeys :: Word
numUtxoKeys :: forall era. GenesisCreateTestNetDataCmdArgs era -> Word
numUtxoKeys
    , Maybe Coin
totalSupply :: Maybe Coin
totalSupply :: forall era. GenesisCreateTestNetDataCmdArgs era -> Maybe Coin
totalSupply
    , Maybe Coin
delegatedSupply :: Maybe Coin
delegatedSupply :: forall era. GenesisCreateTestNetDataCmdArgs era -> Maybe Coin
delegatedSupply
    , Maybe FilePath
relays :: Maybe FilePath
relays :: forall era. GenesisCreateTestNetDataCmdArgs era -> Maybe FilePath
relays
    , Maybe SystemStart
systemStart :: Maybe SystemStart
systemStart :: forall era.
GenesisCreateTestNetDataCmdArgs era -> Maybe SystemStart
systemStart
    , FilePath
outputDir :: FilePath
outputDir :: forall era. GenesisCreateTestNetDataCmdArgs era -> FilePath
outputDir
    } = do
    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
outputDir
    let era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
eon
    ShelleyGenesis StandardCrypto
shelleyGenesisInit <-
      ShelleyGenesis StandardCrypto
-> Maybe (ShelleyGenesis StandardCrypto)
-> ShelleyGenesis StandardCrypto
forall a. a -> Maybe a -> a
fromMaybe ShelleyGenesis StandardCrypto
shelleyGenesisDefaults (Maybe (ShelleyGenesis StandardCrypto)
 -> ShelleyGenesis StandardCrypto)
-> ExceptT
     GenesisCmdError IO (Maybe (ShelleyGenesis StandardCrypto))
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath
 -> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto))
-> Maybe FilePath
-> ExceptT
     GenesisCmdError IO (Maybe (ShelleyGenesis StandardCrypto))
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 FilePath
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
FilePath -> t m (ShelleyGenesis StandardCrypto)
decodeShelleyGenesisFile Maybe FilePath
specShelley
    AlonzoGenesis
alonzoGenesis <-
      AlonzoGenesis -> Maybe AlonzoGenesis -> AlonzoGenesis
forall a. a -> Maybe a -> a
fromMaybe (CardanoEra era -> AlonzoGenesis
forall era. CardanoEra era -> AlonzoGenesis
alonzoGenesisDefaults CardanoEra era
era) (Maybe AlonzoGenesis -> AlonzoGenesis)
-> ExceptT GenesisCmdError IO (Maybe AlonzoGenesis)
-> ExceptT GenesisCmdError IO AlonzoGenesis
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> ExceptT GenesisCmdError IO AlonzoGenesis)
-> Maybe FilePath
-> ExceptT GenesisCmdError IO (Maybe AlonzoGenesis)
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 (Maybe (CardanoEra era)
-> FilePath -> ExceptT GenesisCmdError IO AlonzoGenesis
forall (t :: (* -> *) -> * -> *) (m :: * -> *) era.
MonadIOTransError GenesisCmdError t m =>
Maybe (CardanoEra era) -> FilePath -> t m AlonzoGenesis
decodeAlonzoGenesisFile (CardanoEra era -> Maybe (CardanoEra era)
forall a. a -> Maybe a
Just CardanoEra era
era)) Maybe FilePath
specAlonzo
    ConwayGenesis StandardCrypto
conwayGenesis <- ConwayGenesis StandardCrypto
-> Maybe (ConwayGenesis StandardCrypto)
-> ConwayGenesis StandardCrypto
forall a. a -> Maybe a -> a
fromMaybe ConwayGenesis StandardCrypto
conwayGenesisDefaults (Maybe (ConwayGenesis StandardCrypto)
 -> ConwayGenesis StandardCrypto)
-> ExceptT
     GenesisCmdError IO (Maybe (ConwayGenesis StandardCrypto))
-> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath
 -> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto))
-> Maybe FilePath
-> ExceptT
     GenesisCmdError IO (Maybe (ConwayGenesis StandardCrypto))
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 FilePath
-> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
FilePath -> t m (ConwayGenesis StandardCrypto)
decodeConwayGenesisFile Maybe FilePath
specConway

    -- Read NetworkId either from file or from the flag. Flag overrides template file.
    let actualNetworkId :: NetworkId
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 StandardCrypto -> Word32
forall c. ShelleyGenesis c -> Word32
sgNetworkMagic ShelleyGenesis StandardCrypto
shelleyGenesisInit)
        shelleyGenesis :: ShelleyGenesis StandardCrypto
shelleyGenesis = ShelleyGenesis StandardCrypto
shelleyGenesisInit{sgNetworkMagic = unNetworkMagic (toNetworkMagic actualNetworkId)}
        -- {0 -> genesis-keys/genesis0/key.vkey, 1 -> genesis-keys/genesis1/key.vkey, ...}
        genesisVKeysPaths :: Map Int FilePath
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 :: Map Int FilePath
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 :: Map Int FilePath
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]
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]]

    [Word]
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word
1 .. Word
numGenesisKeys] ((Word -> ExceptT GenesisCmdError IO ())
 -> ExceptT GenesisCmdError IO ())
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
      FilePath -> ExceptT GenesisCmdError IO ()
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))
      KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createDelegateKeys KeyOutputFormat
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))

    Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numGenesisKeys) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
      FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
genesisDir Text
genesisREADME
      FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
delegateDir Text
delegatesREADME

    -- UTxO keys
    let utxoKeyFileNames :: [FilePath]
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]
          ]
    [Word]
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word
1 .. Word
numUtxoKeys] ((Word -> ExceptT GenesisCmdError IO ())
 -> ExceptT GenesisCmdError IO ())
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \Word
index ->
      FilePath -> ExceptT GenesisCmdError IO ()
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))

    Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numUtxoKeys) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
utxoKeysDir Text
utxoKeysREADME

    Maybe (Map Word [StakePoolRelay])
mSPOsRelays <- Maybe FilePath
-> (FilePath
    -> ExceptT GenesisCmdError IO (Map Word [StakePoolRelay]))
-> ExceptT GenesisCmdError IO (Maybe (Map Word [StakePoolRelay]))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe FilePath
relays FilePath -> ExceptT GenesisCmdError IO (Map Word [StakePoolRelay])
forall (m :: * -> *).
MonadIO m =>
FilePath -> ExceptT GenesisCmdError m (Map Word [StakePoolRelay])
readRelays
    case (Maybe FilePath
relays, Maybe (Map Word [StakePoolRelay])
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 -> ExceptT GenesisCmdError IO ()
forall a. GenesisCmdError -> ExceptT GenesisCmdError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisCmdError -> ExceptT GenesisCmdError IO ())
-> GenesisCmdError -> ExceptT GenesisCmdError IO ()
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]))
_ -> () -> ExceptT GenesisCmdError IO ()
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    -- Pools
    [PoolParams StandardCrypto]
poolParams <- [Word]
-> (Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT GenesisCmdError IO [PoolParams StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Word
1 .. Word
numPools] ((Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
 -> ExceptT GenesisCmdError IO [PoolParams StandardCrypto])
-> (Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT GenesisCmdError IO [PoolParams StandardCrypto]
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
      let poolDir :: FilePath
poolDir = 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
index)

      KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createPoolCredentials KeyOutputFormat
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:
      NetworkId
-> FilePath
-> Word
-> Map Word [StakePoolRelay]
-> ExceptT GenesisCmdError IO (PoolParams StandardCrypto)
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)

    Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numPools) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
poolsDir Text
poolsREADME

    -- DReps
    StdGen
g <- ExceptT GenesisCmdError IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
Random.getStdGen

    [VerificationKey DRepKey]
dRepKeys <- (FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
-> ExceptT GenesisCmdError IO [VerificationKey DRepKey]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdFileError (ExceptT (FileError ()) IO [VerificationKey DRepKey]
 -> ExceptT GenesisCmdError IO [VerificationKey DRepKey])
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
-> ExceptT GenesisCmdError IO [VerificationKey DRepKey]
forall a b. (a -> b) -> a -> b
$
      case CredentialGenerationMode
dRepCredentialGenerationMode of
        CredentialGenerationMode
OnDisk -> [Word]
-> (Word -> ExceptT (FileError ()) IO (VerificationKey DRepKey))
-> ExceptT (FileError ()) IO [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 -> ExceptT (FileError ()) IO (VerificationKey DRepKey))
 -> ExceptT (FileError ()) IO [VerificationKey DRepKey])
-> (Word -> ExceptT (FileError ()) IO (VerificationKey DRepKey))
-> ExceptT (FileError ()) IO [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 ConwayEra
cmd = ConwayEraOnwards ConwayEra
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceDRepKeyGenCmdArgs ConwayEra
forall era.
ConwayEraOnwards era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceDRepKeyGenCmdArgs era
DRep.GovernanceDRepKeyGenCmdArgs ConwayEraOnwards ConwayEra
ConwayEraOnwardsConway VerificationKeyFile 'Out
vkeyFile SigningKeyFile 'Out
skeyFile
          IO () -> ExceptT (FileError ()) IO ()
forall a. IO a -> ExceptT (FileError ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
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)
-> ExceptT
     (FileError ()) IO (VerificationKey DRepKey, SigningKey DRepKey)
-> ExceptT (FileError ()) IO (VerificationKey DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GovernanceDRepKeyGenCmdArgs ConwayEra
-> ExceptT
     (FileError ()) IO (VerificationKey DRepKey, SigningKey DRepKey)
forall era.
GovernanceDRepKeyGenCmdArgs era
-> ExceptT
     (FileError ()) IO (VerificationKey DRepKey, SigningKey DRepKey)
DRep.runGovernanceDRepKeyGenCmd GovernanceDRepKeyGenCmdArgs ConwayEra
cmd
        CredentialGenerationMode
Transient ->
          IO [VerificationKey DRepKey]
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
forall a. IO a -> ExceptT (FileError ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VerificationKey DRepKey]
 -> ExceptT (FileError ()) IO [VerificationKey DRepKey])
-> IO [VerificationKey DRepKey]
-> ExceptT (FileError ()) IO [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
numOfStakeDelegators]

    Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numOfDRepCredentials Bool -> Bool -> Bool
&& CredentialGenerationMode
dRepCredentialGenerationMode CredentialGenerationMode -> CredentialGenerationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CredentialGenerationMode
OnDisk) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
drepsDir Text
drepsREADME

    -- Stake delegators
    StdGen
g2 <- ExceptT GenesisCmdError IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
Random.getStdGen
    [(VerificationKey PaymentKey, VerificationKey StakeKey)]
delegatorKeys <- case CredentialGenerationMode
stakeDelegatorsGenerationMode of
      CredentialGenerationMode
OnDisk -> [FilePath]
-> (FilePath
    -> ExceptT
         GenesisCmdError
         IO
         (VerificationKey PaymentKey, VerificationKey StakeKey))
-> ExceptT
     GenesisCmdError
     IO
     [(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
  -> ExceptT
       GenesisCmdError
       IO
       (VerificationKey PaymentKey, VerificationKey StakeKey))
 -> ExceptT
      GenesisCmdError
      IO
      [(VerificationKey PaymentKey, VerificationKey StakeKey)])
-> (FilePath
    -> ExceptT
         GenesisCmdError
         IO
         (VerificationKey PaymentKey, VerificationKey StakeKey))
-> ExceptT
     GenesisCmdError
     IO
     [(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall a b. (a -> b) -> a -> b
$ \FilePath
delegator -> FilePath
-> ExceptT
     GenesisCmdError
     IO
     (VerificationKey PaymentKey, VerificationKey StakeKey)
createStakeDelegatorCredentials FilePath
delegator
      CredentialGenerationMode
Transient -> IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> ExceptT
     GenesisCmdError
     IO
     [(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
 -> ExceptT
      GenesisCmdError
      IO
      [(VerificationKey PaymentKey, VerificationKey StakeKey)])
-> IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> ExceptT
     GenesisCmdError
     IO
     [(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 (Word
delegsPerPool, Word
delegsRemaining) =
          if Word
numPools Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
            then (Word
0, Word
0)
            else Word
numOfStakeDelegators Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word
numPools
        delegsForPool :: Word -> Word
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 StandardCrypto]
distribution = [PoolParams StandardCrypto
pool | (PoolParams StandardCrypto
pool, Word
poolIx) <- [PoolParams StandardCrypto]
-> [Word] -> [(PoolParams StandardCrypto, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PoolParams StandardCrypto]
poolParams [Word
1 ..], Word
_ <- [Word
1 .. Word -> Word
delegsForPool Word
poolIx]]

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

    Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs <- Map Int FilePath
-> Map Int FilePath
-> Map Int FilePath
-> ExceptT
     GenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap Map Int FilePath
genesisVKeysPaths Map Int FilePath
delegateKeys Map Int FilePath
delegateVrfKeys
    [AddressInEra ShelleyEra]
nonDelegAddrs <- [FilePath]
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses [FilePath]
utxoKeyFileNames NetworkId
actualNetworkId
    SystemStart
start <- ExceptT GenesisCmdError IO SystemStart
-> (SystemStart -> ExceptT GenesisCmdError IO SystemStart)
-> Maybe SystemStart
-> ExceptT GenesisCmdError IO SystemStart
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart)
-> ExceptT GenesisCmdError IO UTCTime
-> ExceptT GenesisCmdError IO SystemStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT GenesisCmdError IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTimePlus30) SystemStart -> ExceptT GenesisCmdError IO SystemStart
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SystemStart
systemStart

    let network :: Network
network = NetworkId -> Network
toShelleyNetwork NetworkId
actualNetworkId
    [AddressInEra ShelleyEra]
stuffedUtxoAddrs <-
      IO [AddressInEra ShelleyEra]
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AddressInEra ShelleyEra]
 -> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra])
-> IO [AddressInEra ShelleyEra]
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
forall a b. (a -> b) -> a -> b
$ Int -> IO (AddressInEra ShelleyEra) -> IO [AddressInEra ShelleyEra]
forall (m :: * -> *) a. MonadUnliftIO m => Int -> m a -> m [a]
Lazy.replicateM (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
numStuffedUtxo) (IO (AddressInEra ShelleyEra) -> IO [AddressInEra ShelleyEra])
-> IO (AddressInEra ShelleyEra) -> IO [AddressInEra ShelleyEra]
forall a b. (a -> b) -> a -> b
$ Network -> IO (AddressInEra ShelleyEra)
genStuffedAddress Network
network

    let conwayGenesis' :: ConwayGenesis StandardCrypto
conwayGenesis' = [VerificationKey DRepKey]
-> [VerificationKey StakeKey]
-> ConwayGenesis StandardCrypto
-> ConwayGenesis StandardCrypto
addDRepsToConwayGenesis [VerificationKey DRepKey]
dRepKeys (((VerificationKey PaymentKey, VerificationKey StakeKey)
 -> VerificationKey StakeKey)
-> [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> [VerificationKey StakeKey]
forall a b. (a -> b) -> [a] -> [b]
map (VerificationKey PaymentKey, VerificationKey StakeKey)
-> VerificationKey StakeKey
forall a b. (a, b) -> b
snd [(VerificationKey PaymentKey, VerificationKey StakeKey)]
delegatorKeys) ConwayGenesis StandardCrypto
conwayGenesis

    let stake :: [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake = (PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto)
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
-> (KeyHash 'Staking StandardCrypto,
    KeyHash 'StakePool StandardCrypto)
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 StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c. PoolParams c -> KeyHash 'StakePool c
L.ppId ((KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
 -> (KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto))
-> (Delegation
    -> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto))
-> Delegation
-> (KeyHash 'Staking StandardCrypto,
    KeyHash 'StakePool StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry (Delegation
 -> (KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto))
-> [Delegation]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
        stakePools :: [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
stakePools = [(PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c. PoolParams c -> KeyHash 'StakePool c
L.ppId PoolParams StandardCrypto
poolParams', PoolParams StandardCrypto
poolParams') | PoolParams StandardCrypto
poolParams' <- (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
-> PoolParams StandardCrypto
forall a b. (a, b) -> b
snd ((KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
 -> PoolParams StandardCrypto)
-> (Delegation
    -> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto))
-> Delegation
-> PoolParams StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry (Delegation -> PoolParams StandardCrypto)
-> [Delegation] -> [PoolParams StandardCrypto]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations]
        delegAddrs :: [AddressInEra ShelleyEra]
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 StandardCrypto
shelleyGenesis' <-
      SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (m :: * -> *).
MonadError GenesisCmdError m =>
SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> m (ShelleyGenesis StandardCrypto)
updateOutputTemplate
        SystemStart
start
        Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs
        Maybe Coin
totalSupply
        [AddressInEra ShelleyEra]
nonDelegAddrs
        [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
stakePools
        [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake
        Maybe Coin
delegatedSupply
        ([Delegation] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Delegation]
delegations)
        [AddressInEra ShelleyEra]
delegAddrs
        [AddressInEra ShelleyEra]
stuffedUtxoAddrs
        ShelleyGenesis StandardCrypto
shelleyGenesis

    -- Write genesis.json file to output
    let conwayGenesisFilename :: FilePath
conwayGenesisFilename = FilePath
"conway-genesis.json"
        shelleyGenesisFilename :: FilePath
shelleyGenesisFilename = FilePath
"shelley-genesis.json"
        alonzoGenesisFilename :: FilePath
alonzoGenesisFilename = FilePath
"alonzo-genesis.json"
        conwayGenesisPath :: FilePath
conwayGenesisPath = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
conwayGenesisFilename
        shelleyGenesisPath :: FilePath
shelleyGenesisPath = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
shelleyGenesisFilename
        alonzoGenesisPath :: FilePath
alonzoGenesisPath = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
alonzoGenesisFilename
    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
conwayGenesisPath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ConwayGenesis StandardCrypto -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty ConwayGenesis StandardCrypto
conwayGenesis'
    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
shelleyGenesisPath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis StandardCrypto -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty ShelleyGenesis StandardCrypto
shelleyGenesis'
    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
alonzoGenesisPath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ AlonzoGenesis -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty AlonzoGenesis
alonzoGenesis

    case Maybe FilePath
specNodeConfig of
      Maybe FilePath
Nothing -> {- Don't do anything for now -} () -> ExceptT GenesisCmdError IO ()
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just FilePath
inputNodeConfigPath -> do
        let outputNodeConfigPath :: FilePath
outputNodeConfigPath = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"configuration.json"
            addOrCheckHash :: Key
-> Hash Blake2b_256 ByteString
-> Value
-> Either GenesisCmdError Value
addOrCheckHash Key
k Hash Blake2b_256 ByteString
v = FilePath -> Key -> Text -> Value -> Either GenesisCmdError Value
addOrCheck FilePath
inputNodeConfigPath Key
k (Hash Blake2b_256 ByteString -> Text
forall h a. Hash h a -> Text
Crypto.hashToTextAsHex Hash Blake2b_256 ByteString
v)
            addOrCheckPath :: Key -> FilePath -> Value -> Either GenesisCmdError Value
addOrCheckPath Key
k FilePath
v = FilePath -> Key -> Text -> Value -> Either GenesisCmdError Value
addOrCheck FilePath
inputNodeConfigPath Key
k (FilePath -> Text
Text.pack FilePath
v)
        Hash Blake2b_256 ByteString
conwayGenesisHash <- FilePath
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall (m :: * -> *).
MonadIO m =>
FilePath -> m (Hash Blake2b_256 ByteString)
getShelleyOnwardsGenesisHash FilePath
conwayGenesisPath
        Hash Blake2b_256 ByteString
shelleyGenesisHash <- FilePath
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall (m :: * -> *).
MonadIO m =>
FilePath -> m (Hash Blake2b_256 ByteString)
getShelleyOnwardsGenesisHash FilePath
shelleyGenesisPath
        Hash Blake2b_256 ByteString
alonzoGenesisHash <- FilePath
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall (m :: * -> *).
MonadIO m =>
FilePath -> m (Hash Blake2b_256 ByteString)
getShelleyOnwardsGenesisHash FilePath
alonzoGenesisPath
        Value
nodeConfig <- FilePath -> ExceptT GenesisCmdError IO Value
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => FilePath -> m a
Yaml.decodeFileThrow FilePath
inputNodeConfigPath
        Value
nodeConfigToWrite <-
          Either GenesisCmdError Value -> ExceptT GenesisCmdError IO Value
forall (m :: * -> *) e a. Monad m => Either e a -> ExceptT e m a
except (Either GenesisCmdError Value -> ExceptT GenesisCmdError IO Value)
-> Either GenesisCmdError Value -> ExceptT GenesisCmdError IO Value
forall a b. (a -> b) -> a -> b
$
            -- Write hashs
            Key
-> Hash Blake2b_256 ByteString
-> Value
-> Either GenesisCmdError Value
addOrCheckHash Key
"ConwayGenesisHash" Hash Blake2b_256 ByteString
conwayGenesisHash Value
nodeConfig
              Either GenesisCmdError Value
-> (Value -> Either GenesisCmdError Value)
-> Either GenesisCmdError Value
forall a b.
Either GenesisCmdError a
-> (a -> Either GenesisCmdError b) -> Either GenesisCmdError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key
-> Hash Blake2b_256 ByteString
-> Value
-> Either GenesisCmdError Value
addOrCheckHash Key
"ShelleyGenesisHash" Hash Blake2b_256 ByteString
shelleyGenesisHash
              Either GenesisCmdError Value
-> (Value -> Either GenesisCmdError Value)
-> Either GenesisCmdError Value
forall a b.
Either GenesisCmdError a
-> (a -> Either GenesisCmdError b) -> Either GenesisCmdError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key
-> Hash Blake2b_256 ByteString
-> Value
-> Either GenesisCmdError Value
addOrCheckHash Key
"AlonzoGenesisHash" Hash Blake2b_256 ByteString
alonzoGenesisHash
              -- Write paths
              Either GenesisCmdError Value
-> (Value -> Either GenesisCmdError Value)
-> Either GenesisCmdError Value
forall a b.
Either GenesisCmdError a
-> (a -> Either GenesisCmdError b) -> Either GenesisCmdError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> FilePath -> Value -> Either GenesisCmdError Value
addOrCheckPath Key
"ConwayGenesisFile" FilePath
conwayGenesisFilename
              Either GenesisCmdError Value
-> (Value -> Either GenesisCmdError Value)
-> Either GenesisCmdError Value
forall a b.
Either GenesisCmdError a
-> (a -> Either GenesisCmdError b) -> Either GenesisCmdError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> FilePath -> Value -> Either GenesisCmdError Value
addOrCheckPath Key
"ShelleyGenesisFile" FilePath
shelleyGenesisFilename
              Either GenesisCmdError Value
-> (Value -> Either GenesisCmdError Value)
-> Either GenesisCmdError Value
forall a b.
Either GenesisCmdError a
-> (a -> Either GenesisCmdError b) -> Either GenesisCmdError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Key -> FilePath -> Value -> Either GenesisCmdError Value
addOrCheckPath Key
"AlonzoGenesisFile" FilePath
alonzoGenesisFilename
        IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
outputNodeConfigPath (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty Value
nodeConfigToWrite
   where
    genesisDir :: FilePath
genesisDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"genesis-keys"
    delegateDir :: FilePath
delegateDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"delegate-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"
    mkDelegationMapEntry
      :: Delegation -> (L.KeyHash L.Staking L.StandardCrypto, L.PoolParams L.StandardCrypto)
    mkDelegationMapEntry :: Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry Delegation
d = (Delegation -> KeyHash 'Staking StandardCrypto
dDelegStaking Delegation
d, Delegation -> PoolParams StandardCrypto
dPoolParams Delegation
d)

    -- @addOrCheck filepath key expectedValue obj @ checks
    -- if @obj@ maps @key@. If it does, it checks that the value is @expectedValue@.
    -- If @key@ is not mapped, the mapping @key -> expectedValue@ is inserted.
    addOrCheck :: FilePath -> Aeson.Key -> Text.Text -> Yaml.Value -> Either GenesisCmdError Yaml.Value
    addOrCheck :: FilePath -> Key -> Text -> Value -> Either GenesisCmdError Value
addOrCheck FilePath
filepath Key
key Text
expectedValue nodeConfig :: Value
nodeConfig@(Aeson.Object Object
obj) =
      case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Aeson.lookup Key
key Object
obj of
        Maybe Value
Nothing ->
          -- Key of hash is not there, insert it
          Value -> Either GenesisCmdError Value
forall a. a -> Either GenesisCmdError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Either GenesisCmdError Value)
-> Value -> Either GenesisCmdError Value
forall a b. (a -> b) -> a -> b
$ Object -> Value
Aeson.Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.insert Key
key (Text -> Value
Aeson.String Text
expectedValue) Object
obj
        Just (Aeson.String Text
seen)
          | Text
seen Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
expectedValue ->
              -- Hash is there and it's correct: no change
              Value -> Either GenesisCmdError Value
forall a. a -> Either GenesisCmdError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
nodeConfig
        Just (Aeson.String Text
seen) ->
          -- Hash is there, but it's incorrect: fail
          GenesisCmdError -> Either GenesisCmdError Value
forall a b. a -> Either a b
Left (GenesisCmdError -> Either GenesisCmdError Value)
-> GenesisCmdError -> Either GenesisCmdError Value
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> Text -> Text -> GenesisCmdError
GenesisCmdWrongGenesisHash FilePath
filepath (Key -> Text
Aeson.toText Key
key) Text
seen Text
expectedValue
        Maybe Value
_ ->
          GenesisCmdError -> Either GenesisCmdError Value
forall a b. a -> Either a b
Left (GenesisCmdError -> Either GenesisCmdError Value)
-> GenesisCmdError -> Either GenesisCmdError Value
forall a b. (a -> b) -> a -> b
$
            FilePath -> Text -> GenesisCmdError
GenesisCmdWrongNodeConfigFile
              FilePath
filepath
              (Text
"Expected a String at key \"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Key -> Text
Aeson.toText Key
key Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\", but found something else")
    addOrCheck FilePath
filepath Key
_ Text
_ Value
_ =
      GenesisCmdError -> Either GenesisCmdError Value
forall a b. a -> Either a b
Left (GenesisCmdError -> Either GenesisCmdError Value)
-> GenesisCmdError -> Either GenesisCmdError Value
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> GenesisCmdError
GenesisCmdWrongNodeConfigFile FilePath
filepath Text
"Expected Object at the top-level"

    addDRepsToConwayGenesis
      :: [VerificationKey DRepKey]
      -> [VerificationKey StakeKey]
      -> L.ConwayGenesis L.StandardCrypto
      -> L.ConwayGenesis L.StandardCrypto
    addDRepsToConwayGenesis :: [VerificationKey DRepKey]
-> [VerificationKey StakeKey]
-> ConwayGenesis StandardCrypto
-> ConwayGenesis StandardCrypto
addDRepsToConwayGenesis [VerificationKey DRepKey]
dRepKeys [VerificationKey StakeKey]
stakingKeys ConwayGenesis StandardCrypto
conwayGenesis =
      ConwayGenesis StandardCrypto
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 = initialDReps (L.ucppDRepDeposit $ L.cgUpgradePParams conwayGenesis) dRepKeys
        }
     where
      delegs
        :: [(VerificationKey StakeKey, VerificationKey DRepKey)]
        -> ListMap (L.Credential L.Staking L.StandardCrypto) (L.Delegatee L.StandardCrypto)
      delegs :: [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> ListMap
     (Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
delegs =
        [(Credential 'Staking StandardCrypto, Delegatee StandardCrypto)]
-> ListMap
     (Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
[Item
   (ListMap
      (Credential 'Staking StandardCrypto) (Delegatee StandardCrypto))]
-> ListMap
     (Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
          ([(Credential 'Staking StandardCrypto, Delegatee StandardCrypto)]
 -> ListMap
      (Credential 'Staking StandardCrypto) (Delegatee StandardCrypto))
-> ([(VerificationKey StakeKey, VerificationKey DRepKey)]
    -> [(Credential 'Staking StandardCrypto,
         Delegatee StandardCrypto)])
-> [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> ListMap
     (Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VerificationKey StakeKey, VerificationKey DRepKey)
 -> (Credential 'Staking StandardCrypto, Delegatee StandardCrypto))
-> [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> [(Credential 'Staking StandardCrypto, Delegatee StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map
            ( (VerificationKey StakeKey -> Credential 'Staking StandardCrypto)
-> (VerificationKey DRepKey -> Delegatee StandardCrypto)
-> (VerificationKey StakeKey, VerificationKey DRepKey)
-> (Credential 'Staking StandardCrypto, Delegatee StandardCrypto)
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 StandardCrypto
verificationKeytoStakeCredential
                (DRep StandardCrypto -> Delegatee StandardCrypto
forall c. DRep c -> Delegatee c
L.DelegVote (DRep StandardCrypto -> Delegatee StandardCrypto)
-> (VerificationKey DRepKey -> DRep StandardCrypto)
-> VerificationKey DRepKey
-> Delegatee StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'DRepRole StandardCrypto -> DRep StandardCrypto
forall c. Credential 'DRepRole c -> DRep c
L.DRepCredential (Credential 'DRepRole StandardCrypto -> DRep StandardCrypto)
-> (VerificationKey DRepKey -> Credential 'DRepRole StandardCrypto)
-> VerificationKey DRepKey
-> DRep StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey DRepKey -> Credential 'DRepRole StandardCrypto
verificationKeyToDRepCredential)
            )

      initialDReps
        :: Lovelace
        -> [VerificationKey DRepKey]
        -> ListMap (L.Credential L.DRepRole L.StandardCrypto) (L.DRepState L.StandardCrypto)
      initialDReps :: Coin
-> [VerificationKey DRepKey]
-> ListMap
     (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
initialDReps Coin
minDeposit =
        [(Credential 'DRepRole StandardCrypto, DRepState StandardCrypto)]
-> ListMap
     (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
[Item
   (ListMap
      (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))]
-> ListMap
     (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
          ([(Credential 'DRepRole StandardCrypto, DRepState StandardCrypto)]
 -> ListMap
      (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
-> ([VerificationKey DRepKey]
    -> [(Credential 'DRepRole StandardCrypto,
         DRepState StandardCrypto)])
-> [VerificationKey DRepKey]
-> ListMap
     (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationKey DRepKey
 -> (Credential 'DRepRole StandardCrypto, DRepState StandardCrypto))
-> [VerificationKey DRepKey]
-> [(Credential 'DRepRole StandardCrypto,
     DRepState StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map
            ( \VerificationKey DRepKey
c ->
                ( VerificationKey DRepKey -> Credential 'DRepRole StandardCrypto
verificationKeyToDRepCredential VerificationKey DRepKey
c
                , L.DRepState
                    { drepExpiry :: EpochNo
L.drepExpiry = Word64 -> EpochNo
EpochNo Word64
1_000
                    , drepAnchor :: StrictMaybe (Anchor StandardCrypto)
L.drepAnchor = StrictMaybe (Anchor StandardCrypto)
forall a. StrictMaybe a
SNothing
                    , drepDeposit :: Coin
L.drepDeposit = Coin -> Coin -> Coin
forall a. Ord a => a -> a -> a
max (Integer -> Coin
L.Coin Integer
1_000_000) Coin
minDeposit
                    }
                )
            )

      verificationKeyToDRepCredential
        :: VerificationKey DRepKey -> L.Credential L.DRepRole L.StandardCrypto
      verificationKeyToDRepCredential :: VerificationKey DRepKey -> Credential 'DRepRole StandardCrypto
verificationKeyToDRepCredential VerificationKey DRepKey
vk = Hash DRepKey -> Credential 'DRepRole StandardCrypto
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 L.StandardCrypto
        dRepKeyToCredential :: Hash DRepKey -> Credential 'DRepRole StandardCrypto
dRepKeyToCredential (DRepKeyHash KeyHash 'DRepRole StandardCrypto
v) = KeyHash 'DRepRole StandardCrypto
-> Credential 'DRepRole StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj KeyHash 'DRepRole StandardCrypto
v

      verificationKeytoStakeCredential
        :: VerificationKey StakeKey -> L.Credential L.Staking L.StandardCrypto
      verificationKeytoStakeCredential :: VerificationKey StakeKey -> Credential 'Staking StandardCrypto
verificationKeytoStakeCredential VerificationKey StakeKey
vk = Hash StakeKey -> Credential 'Staking StandardCrypto
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 L.StandardCrypto
        stakeKeyToCredential :: Hash StakeKey -> Credential 'Staking StandardCrypto
stakeKeyToCredential (StakeKeyHash KeyHash 'Staking StandardCrypto
v) = KeyHash 'Staking StandardCrypto
-> Credential 'Staking StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj KeyHash 'Staking StandardCrypto
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
      (acc
a', c
h') <- acc -> b -> IO (acc, c)
f acc
a b
h
      [c]
rest <- (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
forall acc b c. (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM acc -> b -> IO (acc, c)
f acc
a' [b]
t
      [c] -> IO [c]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([c] -> IO [c]) -> [c] -> IO [c]
forall a b. (a -> b) -> a -> b
$ c
h' c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [c]
rest

    --- | Read the given file and hashes it using 'Blake2b_256'
    getShelleyOnwardsGenesisHash
      :: MonadIO m
      => FilePath
      -> m (Crypto.Hash Crypto.Blake2b_256 BS.ByteString)
    getShelleyOnwardsGenesisHash :: forall (m :: * -> *).
MonadIO m =>
FilePath -> m (Hash Blake2b_256 ByteString)
getShelleyOnwardsGenesisHash FilePath
path = do
      ByteString
content <- IO ByteString -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
BS.readFile FilePath
path
      Hash Blake2b_256 ByteString -> m (Hash Blake2b_256 ByteString)
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash Blake2b_256 ByteString -> m (Hash Blake2b_256 ByteString))
-> Hash Blake2b_256 ByteString -> m (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith @Crypto.Blake2b_256 ByteString -> ByteString
forall a. a -> a
id ByteString
content

-- | The output format used all along this file
desiredKeyOutputFormat :: KeyOutputFormat
desiredKeyOutputFormat :: KeyOutputFormat
desiredKeyOutputFormat = KeyOutputFormat
KeyOutputFormatTextEnvelope

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"
    ]

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 :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createDelegateKeys :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createDelegateKeys KeyOutputFormat
fmt FilePath
dir = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  GenesisKeyGenDelegateCmdArgs -> ExceptT GenesisCmdError IO ()
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
      }
  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")
  (NodeCmdError -> GenesisCmdError)
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT NodeCmdError -> GenesisCmdError
GenesisCmdNodeCmdError (ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
        KeyOutputFormat
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 -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
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 -> ExceptT GenesisCmdError IO ()
createGenesisKeys :: FilePath -> ExceptT GenesisCmdError IO ()
createGenesisKeys FilePath
dir = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  GenesisKeyGenGenesisCmdArgs -> ExceptT GenesisCmdError IO ()
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
  -> ExceptT
      GenesisCmdError
      IO
      ( VerificationKey PaymentKey
      , VerificationKey StakeKey
      )
createStakeDelegatorCredentials :: FilePath
-> ExceptT
     GenesisCmdError
     IO
     (VerificationKey PaymentKey, VerificationKey StakeKey)
createStakeDelegatorCredentials FilePath
dir = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  (VerificationKey PaymentKey
pvk, SigningKey PaymentKey
_psk) <-
    (AddressCmdError -> GenesisCmdError)
-> ExceptT
     AddressCmdError
     IO
     (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ExceptT
     GenesisCmdError
     IO
     (VerificationKey PaymentKey, SigningKey PaymentKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AddressCmdError -> GenesisCmdError
GenesisCmdAddressCmdError (ExceptT
   AddressCmdError
   IO
   (VerificationKey PaymentKey, SigningKey PaymentKey)
 -> ExceptT
      GenesisCmdError
      IO
      (VerificationKey PaymentKey, SigningKey PaymentKey))
-> ExceptT
     AddressCmdError
     IO
     (VerificationKey PaymentKey, SigningKey PaymentKey)
-> ExceptT
     GenesisCmdError
     IO
     (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> AsType PaymentKey
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     AddressCmdError
     IO
     (VerificationKey PaymentKey, SigningKey PaymentKey)
forall keyrole.
(Key keyrole, HasTypeProxy keyrole,
 SerialiseAsBech32 (SigningKey keyrole),
 SerialiseAsBech32 (VerificationKey keyrole)) =>
KeyOutputFormat
-> AsType keyrole
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
generateAndWriteKeyFiles KeyOutputFormat
desiredKeyOutputFormat AsType PaymentKey
AsPaymentKey VerificationKeyFile 'Out
paymentVK SigningKeyFile 'Out
paymentSK
  (VerificationKey StakeKey
svk, SigningKey StakeKey
_ssk) <-
    (StakeAddressCmdError -> GenesisCmdError)
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT
     GenesisCmdError IO (VerificationKey StakeKey, SigningKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeAddressCmdError -> GenesisCmdError
GenesisCmdStakeAddressCmdError (ExceptT
   StakeAddressCmdError
   IO
   (VerificationKey StakeKey, SigningKey StakeKey)
 -> ExceptT
      GenesisCmdError IO (VerificationKey StakeKey, SigningKey StakeKey))
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT
     GenesisCmdError IO (VerificationKey StakeKey, SigningKey StakeKey)
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd KeyOutputFormat
desiredKeyOutputFormat VerificationKeyFile 'Out
stakingVK SigningKeyFile 'Out
stakingSK
  (VerificationKey PaymentKey, VerificationKey StakeKey)
-> ExceptT
     GenesisCmdError
     IO
     (VerificationKey PaymentKey, VerificationKey StakeKey)
forall a. a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey PaymentKey
pvk, VerificationKey StakeKey
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 -> ExceptT GenesisCmdError IO ()
createUtxoKeys :: FilePath -> ExceptT GenesisCmdError IO ()
createUtxoKeys FilePath
dir = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  GenesisKeyGenUTxOCmdArgs -> ExceptT GenesisCmdError IO ()
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 :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createPoolCredentials :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createPoolCredentials KeyOutputFormat
fmt FilePath
dir = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
  (NodeCmdError -> GenesisCmdError)
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT NodeCmdError -> GenesisCmdError
GenesisCmdNodeCmdError (ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
        KeyOutputFormat
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 -> ExceptT NodeCmdError IO ()
runNodeKeyGenVrfCmd (NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenVRFCmdArgs
Cmd.NodeKeyGenVRFCmdArgs
        KeyOutputFormat
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 -> ExceptT NodeCmdError IO ()
runNodeKeyGenColdCmd (NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> OpCertCounterFile 'Out
-> NodeKeyGenColdCmdArgs
Cmd.NodeKeyGenColdCmdArgs
        KeyOutputFormat
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 -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
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")
  (StakeAddressCmdError -> GenesisCmdError)
-> ExceptT StakeAddressCmdError IO ()
-> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeAddressCmdError -> GenesisCmdError
GenesisCmdStakeAddressCmdError (ExceptT StakeAddressCmdError IO ()
 -> ExceptT GenesisCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    ExceptT
  StakeAddressCmdError
  IO
  (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   StakeAddressCmdError
   IO
   (VerificationKey StakeKey, SigningKey StakeKey)
 -> ExceptT StakeAddressCmdError IO ())
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd
        KeyOutputFormat
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 StandardCrypto
dDelegStaking :: !(L.KeyHash L.Staking L.StandardCrypto)
  , Delegation -> PoolParams StandardCrypto
dPoolParams :: !(L.PoolParams L.StandardCrypto)
  }
  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 L.StandardCrypto)
buildPoolParams :: NetworkId
-> FilePath
-> Word
-> Map Word [StakePoolRelay]
-> ExceptT GenesisCmdError IO (PoolParams StandardCrypto)
buildPoolParams NetworkId
nw FilePath
dir Word
index Map Word [StakePoolRelay]
specifiedRelays = do
  StakePoolVerificationKey VKey 'StakePool StandardCrypto
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
$ AsType (VerificationKey StakePoolKey)
-> File Any 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakePoolKey -> AsType (VerificationKey StakePoolKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolKey
AsStakePoolKey) File Any 'In
poolColdVKF

  VrfVerificationKey VerKeyVRF StandardCrypto
poolVrfVK <-
    (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
-> ExceptT GenesisCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (NodeCmdError -> GenesisCmdError
GenesisCmdNodeCmdError (NodeCmdError -> GenesisCmdError)
-> (FileError TextEnvelopeError -> NodeCmdError)
-> FileError TextEnvelopeError
-> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> NodeCmdError
NodeCmdReadFileError)
      (ExceptT (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
 -> ExceptT GenesisCmdError IO (VerificationKey VrfKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey VrfKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT GenesisCmdError IO (VerificationKey VrfKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
 -> ExceptT GenesisCmdError IO (VerificationKey VrfKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT GenesisCmdError IO (VerificationKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey VrfKey)
-> File Any 'In
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType VrfKey -> AsType (VerificationKey VrfKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey) File Any 'In
poolVrfVKF
  VerificationKey StakeKey
rewardsSVK <-
    (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
-> ExceptT GenesisCmdError IO (VerificationKey StakeKey)
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 StakeKey)
 -> ExceptT GenesisCmdError IO (VerificationKey StakeKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakeKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
 -> ExceptT GenesisCmdError IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakeKey)
-> File Any 'In
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakeKey -> AsType (VerificationKey StakeKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakeKey
AsStakeKey) File Any 'In
poolRewardVKF

  PoolParams StandardCrypto
-> ExceptT GenesisCmdError IO (PoolParams StandardCrypto)
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    L.PoolParams
      { ppId :: KeyHash 'StakePool StandardCrypto
L.ppId = VKey 'StakePool StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
L.hashKey VKey 'StakePool StandardCrypto
poolColdVK
      , ppVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
L.ppVrf = VerKeyVRF PraosVRF -> Hash Blake2b_256 (VerKeyVRF PraosVRF)
forall h.
HashAlgorithm h =>
VerKeyVRF PraosVRF -> Hash h (VerKeyVRF PraosVRF)
forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
L.hashVerKeyVRF VerKeyVRF PraosVRF
VerKeyVRF StandardCrypto
poolVrfVK
      , ppPledge :: Coin
L.ppPledge = Integer -> Coin
L.Coin Integer
0
      , ppCost :: Coin
L.ppCost = Integer -> Coin
L.Coin Integer
0
      , ppMargin :: UnitInterval
L.ppMargin = UnitInterval
forall a. Bounded a => a
minBound
      , ppRewardAccount :: RewardAccount StandardCrypto
L.ppRewardAccount =
          StakeAddress -> RewardAccount StandardCrypto
toShelleyStakeAddr (StakeAddress -> RewardAccount StandardCrypto)
-> StakeAddress -> RewardAccount StandardCrypto
forall a b. (a -> b) -> a -> b
$ NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
nw (StakeCredential -> StakeAddress)
-> StakeCredential -> StakeAddress
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
rewardsSVK)
      , ppOwners :: Set (KeyHash 'Staking StandardCrypto)
L.ppOwners = Set (KeyHash 'Staking StandardCrypto)
forall a. Monoid a => a
mempty
      , ppRelays :: StrictSeq StakePoolRelay
L.ppRelays = Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
specifiedRelays
      , ppMetadata :: StrictMaybe PoolMetadata
L.ppMetadata = StrictMaybe PoolMetadata
forall a. StrictMaybe a
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
$ [StakePoolRelay]
-> Word -> Map Word [StakePoolRelay] -> [StakePoolRelay]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Word
index Map Word [StakePoolRelay]
m
  poolColdVKF :: File Any 'In
poolColdVKF = FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File Any 'In) -> FilePath -> File Any 'In
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cold.vkey"
  poolVrfVKF :: File Any 'In
poolVrfVKF = FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File Any 'In) -> FilePath -> File Any 'In
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.vkey"
  poolRewardVKF :: File Any 'In
poolRewardVKF = FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File Any 'In) -> FilePath -> File Any '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
  (VerificationKey PaymentKey
paymentKeys, StdGen
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
  (VerificationKey StakeKey
stakeKeys, StdGen
g2) <- (SigningKey StakeKey -> VerificationKey StakeKey)
-> (SigningKey StakeKey, StdGen)
-> (VerificationKey StakeKey, 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 StakeKey -> VerificationKey StakeKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey ((SigningKey StakeKey, StdGen)
 -> (VerificationKey StakeKey, StdGen))
-> IO (SigningKey StakeKey, StdGen)
-> IO (VerificationKey StakeKey, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> AsType StakeKey -> IO (SigningKey StakeKey, StdGen)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole,
 SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> m (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g1 AsType StakeKey
AsStakeKey
  (StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
-> IO
     (StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StdGen
g2, (VerificationKey PaymentKey
paymentKeys, VerificationKey StakeKey
stakeKeys))

computeDelegation
  :: NetworkId
  -> (VerificationKey PaymentKey, VerificationKey StakeKey)
  -> L.PoolParams L.StandardCrypto
  -> Delegation
computeDelegation :: NetworkId
-> (VerificationKey PaymentKey, VerificationKey StakeKey)
-> PoolParams StandardCrypto
-> Delegation
computeDelegation NetworkId
nw (VerificationKey PaymentKey
paymentVK, VerificationKey StakeKey
stakeVK) PoolParams StandardCrypto
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 StandardCrypto
dDelegStaking = VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
L.hashKey (VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto)
-> VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey -> VKey 'Staking StandardCrypto
unStakeVerificationKey VerificationKey StakeKey
stakeVK
    , PoolParams StandardCrypto
dPoolParams :: PoolParams StandardCrypto
dPoolParams :: PoolParams StandardCrypto
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.StandardCrypto, L.PoolParams L.StandardCrypto)]
  -- ^ Pool map
  -> [(L.KeyHash 'L.Staking L.StandardCrypto, L.KeyHash 'L.StakePool L.StandardCrypto)]
  -- ^ 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 L.StandardCrypto
  -- ^ Template from which to build a genesis
  -> m (ShelleyGenesis L.StandardCrypto)
  -- ^ Updated genesis
updateOutputTemplate :: forall (m :: * -> *).
MonadError GenesisCmdError m =>
SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> m (ShelleyGenesis StandardCrypto)
updateOutputTemplate
  (SystemStart UTCTime
sgSystemStart)
  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
  Maybe Coin
mTotalSupply
  [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
  [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
pools
  [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake
  Maybe Coin
mDelegatedSupply
  Int
nUtxoAddrsDeleg
  [AddressInEra ShelleyEra]
utxoAddrsDeleg
  [AddressInEra ShelleyEra]
stuffedUtxoAddrs
  template :: ShelleyGenesis StandardCrypto
template@ShelleyGenesis{PParams (ShelleyEra StandardCrypto)
sgProtocolParams :: forall c. ShelleyGenesis c -> PParams (ShelleyEra c)
sgProtocolParams :: PParams (ShelleyEra StandardCrypto)
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 StandardCrypto -> m (ShelleyGenesis StandardCrypto)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      ShelleyGenesis StandardCrypto
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 StandardCrypto -> Word64
forall c. ShelleyGenesis c -> Word64
sgMaxLovelaceSupply ShelleyGenesis StandardCrypto
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 StandardCrypto)
sgProtocolParams PParams (ShelleyEra StandardCrypto)
-> Getting Coin (PParams (ShelleyEra StandardCrypto)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams (ShelleyEra StandardCrypto)) Coin
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams (ShelleyEra StandardCrypto)) Coin
L.ppMinUTxOValueL
    shelleyDelKeys :: Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys =
      [Item
   (Map
      (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto))]
-> Map
     (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
        [ (KeyHash 'Genesis StandardCrypto
gh, KeyHash 'GenesisDelegate StandardCrypto
-> Hash StandardCrypto (VerKeyVRF StandardCrypto)
-> GenDelegPair StandardCrypto
forall c.
KeyHash 'GenesisDelegate c
-> Hash c (VerKeyVRF c) -> GenDelegPair c
L.GenDelegPair KeyHash 'GenesisDelegate StandardCrypto
gdh Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
        | ( GenesisKeyHash KeyHash 'Genesis StandardCrypto
gh
            , (GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
gdh, VrfKeyHash Hash StandardCrypto (VerKeyVRF 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
  Map Int (VerificationKey GenesisKey)
gkm <- AsType (VerificationKey GenesisKey)
-> Map Int FilePath
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
AsType a -> Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys (AsType GenesisKey -> AsType (VerificationKey GenesisKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey) Map Int FilePath
genesisKeys
  Map Int (VerificationKey GenesisDelegateKey)
dkm <- AsType (VerificationKey GenesisDelegateKey)
-> Map Int FilePath
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
AsType a -> Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys (AsType GenesisDelegateKey
-> AsType (VerificationKey GenesisDelegateKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey) Map Int FilePath
delegateKeys
  Map Int (VerificationKey VrfKey)
vkm <- AsType (VerificationKey VrfKey)
-> Map Int FilePath
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
AsType a -> Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys (AsType VrfKey -> AsType (VerificationKey VrfKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey) Map Int FilePath
delegateVrfKeys

  let combinedMap
        :: Map
            Int
            ( VerificationKey GenesisKey
            , ( VerificationKey GenesisDelegateKey
              , VerificationKey VrfKey
              )
            )
      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)
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)
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)
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
  Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map Int (VerificationKey GenesisKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey GenesisKey)
gkmExtra Bool -> Bool -> Bool
&& Map Int (VerificationKey GenesisDelegateKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey GenesisDelegateKey)
dkmExtra Bool -> Bool -> Bool
&& Map Int (VerificationKey VrfKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey VrfKey)
vkmExtra) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a. GenesisCmdError -> ExceptT GenesisCmdError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisCmdError -> ExceptT GenesisCmdError IO ())
-> GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      [Int] -> [Int] -> [Int] -> GenesisCmdError
GenesisCmdMismatchedGenesisKeyFiles
        (Map Int (VerificationKey GenesisKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisKey)
gkm)
        (Map Int (VerificationKey GenesisDelegateKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisDelegateKey)
dkm)
        (Map Int (VerificationKey VrfKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey VrfKey)
vkm)

  let delegsMap
        :: Map
            (Hash GenesisKey)
            (Hash GenesisDelegateKey, Hash VrfKey)
      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
          ]

  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> ExceptT
     GenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegsMap

-- | Given a map @{0 -> someKey0, 1 -> someKey1}@, lift reading
-- the files to the map's values.
readKeys
  :: ()
  => HasTextEnvelope a
  => Ord k
  => AsType a
  -> Map k FilePath
  -> ExceptT GenesisCmdError IO (Map k a)
readKeys :: forall a k.
(HasTextEnvelope a, Ord k) =>
AsType a -> Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys AsType a
asType 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 Any 'In -> ExceptT (FileError TextEnvelopeError) IO a
readKey (FilePath -> File Any '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 Any '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 Any 'In -> IO (Either (FileError TextEnvelopeError) a))
-> File Any 'In
-> ExceptT (FileError TextEnvelopeError) IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType a
-> File Any 'In -> IO (Either (FileError TextEnvelopeError) a)
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType a
asType

readInitialFundAddresses
  :: [FilePath]
  -> NetworkId
  -> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses :: [FilePath]
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses [FilePath]
utxoKeyFileNames NetworkId
nw = do
  [VerificationKey GenesisUTxOKey]
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
$
            AsType (VerificationKey GenesisUTxOKey)
-> File Any 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope
              (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
              (FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
file)
        | FilePath
file <- [FilePath]
utxoKeyFileNames
        ]
  [AddressInEra ShelleyEra]
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
forall a. a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    [ AddressInEra ShelleyEra
addr
    | VerificationKey GenesisUTxOKey
vkey <- [VerificationKey GenesisUTxOKey]
vkeys
    , let vkh :: Hash PaymentKey
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 :: AddressInEra ShelleyEra
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
    ]