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

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

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

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

import RIO (throwString)

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

runGenesisKeyGenGenesisCmd
  :: GenesisKeyGenGenesisCmdArgs
  -> CIO e ()
runGenesisKeyGenGenesisCmd :: forall e. GenesisKeyGenGenesisCmdArgs -> CIO e ()
runGenesisKeyGenGenesisCmd
  Cmd.GenesisKeyGenGenesisCmdArgs
    { VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenGenesisCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
    , SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenGenesisCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
    } = do
    SigningKey GenesisKey
skey <- AsType GenesisKey -> RIO e (SigningKey GenesisKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisKey
AsGenesisKey
    let vkey :: VerificationKey GenesisKey
vkey = SigningKey GenesisKey -> VerificationKey GenesisKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisKey
skey
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
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
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      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
  -> CIO e ()
runGenesisKeyGenDelegateCmd :: forall e. GenesisKeyGenDelegateCmdArgs -> CIO e ()
runGenesisKeyGenDelegateCmd
  Cmd.GenesisKeyGenDelegateCmdArgs
    { VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenDelegateCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
    , SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenDelegateCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
    , OpCertCounterFile 'Out
opCertCounterPath :: OpCertCounterFile 'Out
opCertCounterPath :: GenesisKeyGenDelegateCmdArgs -> OpCertCounterFile 'Out
Cmd.opCertCounterPath
    } = do
    SigningKey GenesisDelegateKey
skey <- AsType GenesisDelegateKey -> RIO e (SigningKey GenesisDelegateKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey
    let vkey :: VerificationKey GenesisDelegateKey
vkey = SigningKey GenesisDelegateKey -> VerificationKey GenesisDelegateKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisDelegateKey
skey
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
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
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      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 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
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      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
  -> CIO e ()
runGenesisKeyGenUTxOCmd :: forall e. GenesisKeyGenUTxOCmdArgs -> CIO e ()
runGenesisKeyGenUTxOCmd
  Cmd.GenesisKeyGenUTxOCmdArgs
    { VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenUTxOCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
    , SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenUTxOCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
    } = do
    SigningKey GenesisUTxOKey
skey <- AsType GenesisUTxOKey -> RIO e (SigningKey GenesisUTxOKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey
    let vkey :: VerificationKey GenesisUTxOKey
vkey = SigningKey GenesisUTxOKey -> VerificationKey GenesisUTxOKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisUTxOKey
skey
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      SigningKeyFile 'Out -> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
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
    forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli @(FileError ()) (IO (Either (FileError ()) ()) -> RIO e ())
-> IO (Either (FileError ()) ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      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"

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

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

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

    -- 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 -> Word32
sgNetworkMagic ShelleyGenesis
shelleyGenesisInit)
        actualNetworkWord32 :: Word32
actualNetworkWord32 = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
actualNetworkId)
        shelleyGenesis :: ShelleyGenesis
shelleyGenesis = ShelleyGenesis
shelleyGenesisInit{sgNetworkMagic = actualNetworkWord32}
        -- {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 -> RIO e ()) -> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word
1 .. Word
numGenesisKeys] ((Word -> RIO e ()) -> RIO e ()) -> (Word -> RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
      FilePath -> CIO e ()
forall e. FilePath -> CIO e ()
createGenesisKeys (FilePath
genesisDir FilePath -> FilePath -> FilePath
</> (FilePath
"genesis" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))
      Vary '[FormatBech32, FormatTextEnvelope] -> FilePath -> CIO e ()
forall e.
Vary '[FormatBech32, FormatTextEnvelope] -> FilePath -> CIO e ()
createDelegateKeys Vary '[FormatBech32, FormatTextEnvelope]
forall (f :: [*]). (FormatTextEnvelope :| f) => Vary f
desiredKeyOutputFormat (FilePath
delegateDir FilePath -> FilePath -> FilePath
</> (FilePath
"delegate" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))

    Bool -> RIO e () -> RIO e ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numGenesisKeys) (RIO e () -> RIO e ()) -> RIO e () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
      ExceptT GenesisCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO () -> RIO e ())
-> ExceptT GenesisCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
genesisDir Text
genesisREADME
      ExceptT GenesisCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO () -> RIO e ())
-> ExceptT GenesisCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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 -> RIO e ()) -> RIO e ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word
1 .. Word
numUtxoKeys] ((Word -> RIO e ()) -> RIO e ()) -> (Word -> RIO e ()) -> RIO e ()
forall a b. (a -> b) -> a -> b
$ \Word
index ->
      FilePath -> CIO e ()
forall e. FilePath -> CIO e ()
createUtxoKeys (FilePath
utxoKeysDir FilePath -> FilePath -> FilePath
</> (FilePath
"utxo" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))

    ExceptT GenesisCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO () -> RIO e ())
-> ExceptT GenesisCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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 -> RIO e (Map Word [StakePoolRelay]))
-> RIO e (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 (ExceptT GenesisCmdError IO (Map Word [StakePoolRelay])
-> RIO e (Map Word [StakePoolRelay])
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO (Map Word [StakePoolRelay])
 -> RIO e (Map Word [StakePoolRelay]))
-> (FilePath
    -> ExceptT GenesisCmdError IO (Map Word [StakePoolRelay]))
-> FilePath
-> RIO e (Map Word [StakePoolRelay])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, Show e, Typeable e, Error e, MonadIO m) =>
e -> m a
throwCliError (GenesisCmdError -> RIO e ()) -> GenesisCmdError -> RIO e ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Int -> GenesisCmdError
GenesisCmdTooManyRelaysError FilePath
fp (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
numPools) (Map Word [StakePoolRelay] -> Int
forall k a. Map k a -> Int
Map.size Map Word [StakePoolRelay]
stakePoolRelays)
      (Maybe FilePath, Maybe (Map Word [StakePoolRelay]))
_ -> () -> RIO e ()
forall a. a -> RIO e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    -- Pools
    [PoolParams]
poolParams <- [Word] -> (Word -> RIO e PoolParams) -> RIO e [PoolParams]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Word
1 .. Word
numPools] ((Word -> RIO e PoolParams) -> RIO e [PoolParams])
-> (Word -> RIO e PoolParams) -> RIO e [PoolParams]
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
      let poolDir :: FilePath
poolDir = Word -> FilePath
mkPoolDir Word
index

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

    ExceptT GenesisCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO () -> RIO e ())
-> ExceptT GenesisCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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

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

    ExceptT GenesisCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO () -> RIO e ())
-> ExceptT GenesisCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ 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
numCommitteeKeys) (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
committeesDir Text
committeeREADME

    -- DReps. We don't need to look at the eon, because the command's parser guarantees
    -- that before Conway, the number of DReps at this point is 0.
    StdGen
g <- RIO e StdGen
forall (m :: * -> *). MonadIO m => m StdGen
Random.getStdGen

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

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

    let (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]
distribution = [PoolParams
pool | (PoolParams
pool, Word
poolIx) <- [PoolParams] -> [Word] -> [(PoolParams, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PoolParams]
poolParams [Word
1 ..], Word
_ <- [Word
1 .. Word -> Word
delegsForPool Word
poolIx]]

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

    Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs <- ExceptT
  GenesisCmdError
  IO
  (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
-> RIO
     e (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT
   GenesisCmdError
   IO
   (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
 -> RIO
      e (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)))
-> ExceptT
     GenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
-> RIO
     e (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
forall a b. (a -> b) -> a -> b
$ 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 <- ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
-> RIO e [AddressInEra ShelleyEra]
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
 -> RIO e [AddressInEra ShelleyEra])
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
-> RIO e [AddressInEra ShelleyEra]
forall a b. (a -> b) -> a -> b
$ [FilePath]
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses [FilePath]
utxoKeyFileNames NetworkId
actualNetworkId
    SystemStart
start <- RIO e SystemStart
-> (SystemStart -> RIO e SystemStart)
-> Maybe SystemStart
-> RIO e SystemStart
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> RIO e UTCTime -> RIO e SystemStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO e UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTimePlus30) SystemStart -> RIO e SystemStart
forall a. a -> RIO e 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] -> RIO e [AddressInEra ShelleyEra]
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AddressInEra ShelleyEra] -> RIO e [AddressInEra ShelleyEra])
-> IO [AddressInEra ShelleyEra] -> RIO e [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

    ConwayGenesis
conwayGenesis' <-
      [VerificationKey DRepKey]
-> [VerificationKey StakeKey]
-> ConwayGenesis
-> RIO e ConwayGenesis
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
[VerificationKey DRepKey]
-> [VerificationKey StakeKey] -> ConwayGenesis -> m ConwayGenesis
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
conwayGenesis
        RIO e ConwayGenesis
-> (ConwayGenesis -> ConwayGenesis) -> RIO e ConwayGenesis
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [VerificationKey CommitteeColdKey]
-> ConwayGenesis -> ConwayGenesis
addCommitteeToConwayGenesis [VerificationKey CommitteeColdKey]
ccColdKeys

    let stake :: [(KeyHash 'Staking, KeyHash 'StakePool)]
stake = (PoolParams -> KeyHash 'StakePool)
-> (KeyHash 'Staking, PoolParams)
-> (KeyHash 'Staking, KeyHash 'StakePool)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second PoolParams -> KeyHash 'StakePool
L.ppId ((KeyHash 'Staking, PoolParams)
 -> (KeyHash 'Staking, KeyHash 'StakePool))
-> (Delegation -> (KeyHash 'Staking, PoolParams))
-> Delegation
-> (KeyHash 'Staking, KeyHash 'StakePool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation -> (KeyHash 'Staking, PoolParams)
mkDelegationMapEntry (Delegation -> (KeyHash 'Staking, KeyHash 'StakePool))
-> [Delegation] -> [(KeyHash 'Staking, KeyHash 'StakePool)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
        stakePools :: [(KeyHash 'StakePool, PoolParams)]
stakePools = [(PoolParams -> KeyHash 'StakePool
L.ppId PoolParams
poolParams', PoolParams
poolParams') | PoolParams
poolParams' <- (KeyHash 'Staking, PoolParams) -> PoolParams
forall a b. (a, b) -> b
snd ((KeyHash 'Staking, PoolParams) -> PoolParams)
-> (Delegation -> (KeyHash 'Staking, PoolParams))
-> Delegation
-> PoolParams
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation -> (KeyHash 'Staking, PoolParams)
mkDelegationMapEntry (Delegation -> PoolParams) -> [Delegation] -> [PoolParams]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations]
        delegAddrs :: [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
shelleyGenesis' <-
      ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis)
-> ExceptT GenesisCmdError IO ShelleyGenesis
-> RIO e ShelleyGenesis
forall a b. (a -> b) -> a -> b
$
        SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool, PoolParams)]
-> [(KeyHash 'Staking, KeyHash 'StakePool)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis
-> ExceptT GenesisCmdError IO ShelleyGenesis
forall (m :: * -> *).
MonadError GenesisCmdError m =>
SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool, PoolParams)]
-> [(KeyHash 'Staking, KeyHash 'StakePool)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis
-> m ShelleyGenesis
updateOutputTemplate
          SystemStart
start
          Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs
          Maybe Coin
totalSupply
          [AddressInEra ShelleyEra]
nonDelegAddrs
          [(KeyHash 'StakePool, PoolParams)]
stakePools
          [(KeyHash 'Staking, KeyHash 'StakePool)]
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
shelleyGenesis

    let byronGenesisFp :: FilePath
byronGenesisFp = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"byron.genesis.spec.json" -- This file is used by the performance testing team.
    RIO e (Hash Blake2b_256 ByteString) -> RIO e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO e (Hash Blake2b_256 ByteString) -> RIO e ())
-> RIO e (Hash Blake2b_256 ByteString) -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> RIO e (Hash Blake2b_256 ByteString)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
 -> RIO e (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> RIO e (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$
        FilePath
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis FilePath
byronGenesisFp (WriteFileGenesis
 -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$
          Value -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty Value
Byron.defaultProtocolParamsJsonValue

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

    ExceptT ByronGenesisError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ByronGenesisError IO () -> RIO e ())
-> ExceptT ByronGenesisError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$
      NewDirectory
-> GenesisData
-> GeneratedSecrets
-> ExceptT ByronGenesisError IO ()
Byron.dumpGenesis (FilePath -> NewDirectory
NewDirectory FilePath
byronOutputDir) GenesisData
byronGenesis GeneratedSecrets
byronSecrets

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

  VrfVerificationKey VerKeyVRF (VRF 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
$ File Any 'In
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope 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
$ File Any 'In
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope File Any 'In
poolRewardVKF

  PoolParams -> ExceptT GenesisCmdError IO PoolParams
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    L.PoolParams
      { ppId :: KeyHash 'StakePool
L.ppId = VKey 'StakePool -> KeyHash 'StakePool
forall (kd :: KeyRole). VKey kd -> KeyHash kd
L.hashKey VKey 'StakePool
poolColdVK
      , ppVrf :: VRFVerKeyHash 'StakePoolVRF
L.ppVrf = forall c (r :: KeyRoleVRF).
Crypto c =>
VerKeyVRF (VRF c) -> VRFVerKeyHash r
C.hashVerKeyVRF @StandardCrypto VerKeyVRF (VRF 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
L.ppRewardAccount =
          StakeAddress -> RewardAccount
toShelleyStakeAddr (StakeAddress -> RewardAccount) -> StakeAddress -> RewardAccount
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)
L.ppOwners = Set (KeyHash 'Staking)
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
  -> Delegation
computeDelegation :: NetworkId
-> (VerificationKey PaymentKey, VerificationKey StakeKey)
-> PoolParams
-> Delegation
computeDelegation NetworkId
nw (VerificationKey PaymentKey
paymentVK, VerificationKey StakeKey
stakeVK) PoolParams
dPoolParams = do
  let paymentCredential :: PaymentCredential
paymentCredential = Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
paymentVK)
  let stakeAddressReference :: StakeAddressReference
stakeAddressReference = StakeCredential -> StakeAddressReference
StakeAddressByValue (StakeCredential -> StakeAddressReference)
-> (VerificationKey StakeKey -> StakeCredential)
-> VerificationKey StakeKey
-> StakeAddressReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash StakeKey -> StakeCredential
StakeCredentialByKey (Hash StakeKey -> StakeCredential)
-> (VerificationKey StakeKey -> Hash StakeKey)
-> VerificationKey StakeKey
-> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey StakeKey -> StakeAddressReference)
-> VerificationKey StakeKey -> StakeAddressReference
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey
stakeVK
  Delegation
    { dInitialUtxoAddr :: AddressInEra ShelleyEra
dInitialUtxoAddr =
        ShelleyBasedEra ShelleyEra
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra ShelleyEra
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley NetworkId
nw PaymentCredential
paymentCredential StakeAddressReference
stakeAddressReference
    , dDelegStaking :: KeyHash 'Staking
dDelegStaking = VKey 'Staking -> KeyHash 'Staking
forall (kd :: KeyRole). VKey kd -> KeyHash kd
L.hashKey (VKey 'Staking -> KeyHash 'Staking)
-> VKey 'Staking -> KeyHash 'Staking
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey -> VKey 'Staking
unStakeVerificationKey VerificationKey StakeKey
stakeVK
    , PoolParams
dPoolParams :: PoolParams
dPoolParams :: PoolParams
dPoolParams
    }

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

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

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

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

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

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

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

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

readGenDelegsMap
  :: Map Int FilePath
  -> Map Int FilePath
  -> Map Int FilePath
  -> ExceptT
       GenesisCmdError
       IO
       ( Map
           (Hash GenesisKey)
           (Hash GenesisDelegateKey, Hash VrfKey)
       )
readGenDelegsMap :: Map Int FilePath
-> Map Int FilePath
-> Map Int FilePath
-> ExceptT
     GenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap Map Int FilePath
genesisKeys Map Int FilePath
delegateKeys Map Int FilePath
delegateVrfKeys = do
  Map Int (VerificationKey GenesisKey)
gkm <- Map Int FilePath
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys Map Int FilePath
genesisKeys
  Map Int (VerificationKey GenesisDelegateKey)
dkm <- Map Int FilePath
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys Map Int FilePath
delegateKeys
  Map Int (VerificationKey VrfKey)
vkm <- Map Int FilePath
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys 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
  => Map k FilePath
  -> ExceptT GenesisCmdError IO (Map k a)
readKeys :: forall a k.
(HasTextEnvelope a, Ord k) =>
Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys Map k FilePath
genesisVKeys = do
  (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
-> ExceptT GenesisCmdError IO (Map k a)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT (FileError TextEnvelopeError) IO (Map k a)
 -> ExceptT GenesisCmdError IO (Map k a))
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
-> ExceptT GenesisCmdError IO (Map k a)
forall a b. (a -> b) -> a -> b
$
    [(k, a)] -> Map k a
[Item (Map k a)] -> Map k a
forall l. IsList l => [Item l] -> l
fromList
      ([(k, a)] -> Map k a)
-> ExceptT (FileError TextEnvelopeError) IO [(k, a)]
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExceptT (FileError TextEnvelopeError) IO (k, a)]
-> ExceptT (FileError TextEnvelopeError) IO [(k, a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ (,) k
ix (a -> (k, a))
-> ExceptT (FileError TextEnvelopeError) IO a
-> ExceptT (FileError TextEnvelopeError) IO (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> File Any 'In -> ExceptT (FileError TextEnvelopeError) IO a
forall {content}.
File content '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 content 'In -> ExceptT (FileError TextEnvelopeError) IO a
readKey = IO (Either (FileError TextEnvelopeError) a)
-> ExceptT (FileError TextEnvelopeError) IO a
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) a)
 -> ExceptT (FileError TextEnvelopeError) IO a)
-> (File content 'In
    -> IO (Either (FileError TextEnvelopeError) a))
-> File content 'In
-> ExceptT (FileError TextEnvelopeError) IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File content 'In -> IO (Either (FileError TextEnvelopeError) a)
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope

readInitialFundAddresses
  :: [FilePath]
  -> NetworkId
  -> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses :: [FilePath]
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses [FilePath]
utxoKeyFileNames NetworkId
nw = do
  [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
$
            forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope
              @(VerificationKey GenesisUTxOKey)
              (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
    ]