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

{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{- HLINT ignore "Reduce duplication" -}
{- HLINT ignore "Redundant <$>" -}
{- HLINT ignore "Use let" -}

module Cardano.CLI.Shelley.Run.Genesis
  ( ShelleyGenesisCmdError(..)
  , readShelleyGenesisWithDefault
  , readAndDecodeShelleyGenesis
  , readAlonzoGenesis
  , runGenesisCmd

  -- * Protocol Parameters
  , ProtocolParamsError(..)
  , renderProtocolParamsError
  , readProtocolParameters
  , readProtocolParametersSourceSpec
  ) where

import           Control.DeepSeq (NFData, force)
import           Control.Exception (IOException)
import           Control.Monad (forM, forM_, unless, when)
import           Control.Monad.Except (MonadError (..), runExceptT)
import           Control.Monad.IO.Class (MonadIO (..))
import           Control.Monad.Trans.Except (ExceptT, throwE, withExceptT)
import           Data.Aeson hiding (Key)
import qualified Data.Aeson as Aeson
import           Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.Aeson.KeyMap as Aeson
import           Data.Bifunctor (Bifunctor (..))
import qualified Data.Binary.Get as Bin
import           Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.Char (isDigit)
import           Data.Coerce (coerce)
import           Data.Data (Proxy (..))
import           Data.Either (fromRight)
import           Data.Function (on)
import           Data.Functor (void)
import           Data.Functor.Identity
import qualified Data.List as List
import qualified Data.List.Split as List
import qualified Data.ListMap as ListMap
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromMaybe)
import qualified Data.Sequence.Strict as Seq
import           Data.String (fromString)
import           Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import           Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime,
                   secondsToNominalDiffTime)
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import qualified System.IO as IO
import qualified System.Random as Random
import           System.Random (StdGen)
import           Text.Read (readMaybe)

import           Cardano.Binary (Annotated (Annotated), ToCBOR (..))

import qualified Cardano.Crypto as CC
import           Cardano.Crypto.Hash (HashAlgorithm)
import qualified Cardano.Crypto.Hash as Hash
import qualified Cardano.Crypto.Random as Crypto
import           Crypto.Random as Crypto

import           System.Directory (createDirectoryIfMissing, listDirectory)
import           System.FilePath (takeExtension, takeExtensions, (</>))
import           System.IO.Error (isDoesNotExistError)

import           Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left,
                   newExceptT)

import qualified Cardano.Crypto.Hash as Crypto

import           Cardano.Api
import           Cardano.Api.Byron (toByronLovelace, toByronProtocolMagicId,
                   toByronRequiresNetworkMagic)
import           Cardano.Api.Shelley

import           Ouroboros.Consensus.Shelley.Eras (StandardShelley)
import           Ouroboros.Consensus.Shelley.Node (ShelleyGenesisStaking (..))

import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo
import qualified Cardano.Ledger.BaseTypes as Ledger
import           Cardano.Ledger.Coin (Coin (..))
import           Cardano.Ledger.Conway.Genesis ()
import qualified Cardano.Ledger.Conway.Genesis as Conway
import qualified Cardano.Ledger.Keys as Ledger
import qualified Cardano.Ledger.Shelley.API as Ledger
import qualified Cardano.Ledger.Shelley.PParams as Shelley

import           Cardano.Ledger.Crypto (ADDRHASH, Crypto, StandardCrypto)
import           Cardano.Ledger.Era ()

import           Cardano.CLI.Shelley.Commands
import           Cardano.CLI.Shelley.Key
import           Cardano.CLI.Shelley.Orphans ()
import           Cardano.CLI.Shelley.Run.Address
import           Cardano.CLI.Shelley.Run.Node (ShelleyNodeCmdError (..), renderShelleyNodeCmdError,
                   runNodeIssueOpCert, runNodeKeyGenCold, runNodeKeyGenKES, runNodeKeyGenVRF)
import           Cardano.CLI.Shelley.Run.Pool (ShelleyPoolCmdError (..), renderShelleyPoolCmdError)
import           Cardano.CLI.Shelley.Run.StakeAddress (ShelleyStakeAddressCmdError (..),
                   renderShelleyStakeAddressCmdError, runStakeAddressKeyGenToFile)
import           Cardano.CLI.Types

import qualified Cardano.Chain.Common as Byron (KeyHash, mkKnownLovelace, rationalToLovelacePortion)
import           Cardano.Chain.Genesis (FakeAvvmOptions (..), TestnetBalanceOptions (..),
                   gdProtocolParameters, gsDlgIssuersSecrets, gsPoorSecrets, gsRichSecrets)
import           Cardano.CLI.Byron.Delegation
import           Cardano.CLI.Byron.Genesis as Byron
import qualified Cardano.CLI.Byron.Key as Byron
import qualified Cardano.Crypto.Signing as Byron

import           Cardano.Chain.Common (BlockCount (unBlockCount))
import           Cardano.Chain.Delegation (delegateVK)
import qualified Cardano.Chain.Delegation as Dlg
import qualified Cardano.Chain.Genesis as Genesis
import           Cardano.Chain.Update hiding (ProtocolParameters)
import           Cardano.Slotting.Slot (EpochSize (EpochSize))
import           Data.Fixed (Fixed (MkFixed))
import qualified Data.Yaml as Yaml
import qualified Text.JSON.Canonical (ToJSON)
import           Text.JSON.Canonical (parseCanonicalJSON, renderCanonicalJSON)

import           Data.ListMap (ListMap (..))

import qualified Cardano.CLI.IO.Lazy as Lazy

import           Cardano.Prelude (canonicalEncodePretty)

data ShelleyGenesisCmdError
  = ShelleyGenesisCmdAesonDecodeError !FilePath !Text
  | ShelleyGenesisCmdGenesisFileReadError !(FileError IOException)
  | ShelleyGenesisCmdGenesisFileDecodeError !FilePath !Text
  | ShelleyGenesisCmdGenesisFileError !(FileError ())
  | ShelleyGenesisCmdFileError !(FileError ())
  | ShelleyGenesisCmdMismatchedGenesisKeyFiles [Int] [Int] [Int]
  | ShelleyGenesisCmdFilesNoIndex [FilePath]
  | ShelleyGenesisCmdFilesDupIndex [FilePath]
  | ShelleyGenesisCmdTextEnvReadFileError !(FileError TextEnvelopeError)
  | ShelleyGenesisCmdUnexpectedAddressVerificationKey !VerificationKeyFile !Text !SomeAddressVerificationKey
  | ShelleyGenesisCmdTooFewPoolsForBulkCreds !Word !Word !Word
  | ShelleyGenesisCmdAddressCmdError !ShelleyAddressCmdError
  | ShelleyGenesisCmdNodeCmdError !ShelleyNodeCmdError
  | ShelleyGenesisCmdPoolCmdError !ShelleyPoolCmdError
  | ShelleyGenesisCmdStakeAddressCmdError !ShelleyStakeAddressCmdError
  | ShelleyGenesisCmdCostModelsError !FilePath
  | ShelleyGenesisCmdByronError !ByronGenesisError
  | ShelleyGenesisStakePoolRelayFileError !FilePath !IOException
  | ShelleyGenesisStakePoolRelayJsonDecodeError !FilePath !String
  deriving Int -> ShelleyGenesisCmdError -> ShowS
[ShelleyGenesisCmdError] -> ShowS
ShelleyGenesisCmdError -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyGenesisCmdError] -> ShowS
$cshowList :: [ShelleyGenesisCmdError] -> ShowS
show :: ShelleyGenesisCmdError -> String
$cshow :: ShelleyGenesisCmdError -> String
showsPrec :: Int -> ShelleyGenesisCmdError -> ShowS
$cshowsPrec :: Int -> ShelleyGenesisCmdError -> ShowS
Show

instance Error ShelleyGenesisCmdError where
  displayError :: ShelleyGenesisCmdError -> String
displayError ShelleyGenesisCmdError
err =
    case ShelleyGenesisCmdError
err of
      ShelleyGenesisCmdAesonDecodeError String
fp Text
decErr ->
        String
"Error while decoding Shelley genesis at: " forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<> String
" Error: " forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
decErr
      ShelleyGenesisCmdGenesisFileError FileError ()
fe -> forall e. Error e => e -> String
displayError FileError ()
fe
      ShelleyGenesisCmdFileError FileError ()
fe -> forall e. Error e => e -> String
displayError FileError ()
fe
      ShelleyGenesisCmdMismatchedGenesisKeyFiles [Int]
gfiles [Int]
dfiles [Int]
vfiles ->
        String
"Mismatch between the files found:\n"
          forall a. Semigroup a => a -> a -> a
<> String
"Genesis key file indexes:      " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Int]
gfiles forall a. Semigroup a => a -> a -> a
<> String
"\n"
          forall a. Semigroup a => a -> a -> a
<> String
"Delegate key file indexes:     " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Int]
dfiles forall a. Semigroup a => a -> a -> a
<> String
"\n"
          forall a. Semigroup a => a -> a -> a
<> String
"Delegate VRF key file indexes: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show [Int]
vfiles
      ShelleyGenesisCmdFilesNoIndex [String]
files ->
        String
"The genesis keys files are expected to have a numeric index but these do not:\n"
          forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines [String]
files
      ShelleyGenesisCmdFilesDupIndex [String]
files ->
        String
"The genesis keys files are expected to have a unique numeric index but these do not:\n"
          forall a. Semigroup a => a -> a -> a
<> [String] -> String
unlines [String]
files
      ShelleyGenesisCmdTextEnvReadFileError FileError TextEnvelopeError
fileErr -> forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileErr
      ShelleyGenesisCmdUnexpectedAddressVerificationKey (VerificationKeyFile String
file) Text
expect SomeAddressVerificationKey
got -> forall a. Monoid a => [a] -> a
mconcat
        [ String
"Unexpected address verification key type in file ", String
file
        , String
", expected: ", Text -> String
Text.unpack Text
expect, String
", got: ", Text -> String
Text.unpack (SomeAddressVerificationKey -> Text
renderSomeAddressVerificationKey SomeAddressVerificationKey
got)
        ]
      ShelleyGenesisCmdTooFewPoolsForBulkCreds Word
pools Word
files Word
perPool -> forall a. Monoid a => [a] -> a
mconcat
        [ String
"Number of pools requested for generation (", forall a. Show a => a -> String
show Word
pools
        , String
") is insufficient to fill ", forall a. Show a => a -> String
show Word
files
        , String
" bulk files, with ", forall a. Show a => a -> String
show Word
perPool, String
" pools per file."
        ]
      ShelleyGenesisCmdAddressCmdError ShelleyAddressCmdError
e -> Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ ShelleyAddressCmdError -> Text
renderShelleyAddressCmdError ShelleyAddressCmdError
e
      ShelleyGenesisCmdNodeCmdError ShelleyNodeCmdError
e -> Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ ShelleyNodeCmdError -> Text
renderShelleyNodeCmdError ShelleyNodeCmdError
e
      ShelleyGenesisCmdPoolCmdError ShelleyPoolCmdError
e -> Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ ShelleyPoolCmdError -> Text
renderShelleyPoolCmdError ShelleyPoolCmdError
e
      ShelleyGenesisCmdStakeAddressCmdError ShelleyStakeAddressCmdError
e -> Text -> String
Text.unpack forall a b. (a -> b) -> a -> b
$ ShelleyStakeAddressCmdError -> Text
renderShelleyStakeAddressCmdError ShelleyStakeAddressCmdError
e
      ShelleyGenesisCmdCostModelsError String
fp -> String
"Cost model is invalid: " forall a. Semigroup a => a -> a -> a
<> String
fp
      ShelleyGenesisCmdGenesisFileDecodeError String
fp Text
e ->
       String
"Error while decoding Shelley genesis at: " forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<>
       String
" Error: " forall a. Semigroup a => a -> a -> a
<>  Text -> String
Text.unpack Text
e
      ShelleyGenesisCmdGenesisFileReadError FileError IOException
e -> forall e. Error e => e -> String
displayError FileError IOException
e
      ShelleyGenesisCmdByronError ByronGenesisError
e -> forall a. Show a => a -> String
show ByronGenesisError
e
      ShelleyGenesisStakePoolRelayFileError String
fp IOException
e ->
        String
"Error occurred while reading the stake pool relay specification file: " forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<>
        String
" Error: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show IOException
e
      ShelleyGenesisStakePoolRelayJsonDecodeError String
fp String
e ->
        String
"Error occurred while decoding the stake pool relay specification file: " forall a. Semigroup a => a -> a -> a
<> String
fp forall a. Semigroup a => a -> a -> a
<>
        String
" Error: " forall a. Semigroup a => a -> a -> a
<>  String
e

runGenesisCmd :: GenesisCmd -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCmd :: GenesisCmd -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCmd (GenesisKeyGenGenesis VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenGenesis VerificationKeyFile
vk SigningKeyFile
sk
runGenesisCmd (GenesisKeyGenDelegate VerificationKeyFile
vk SigningKeyFile
sk OpCertCounterFile
ctr) = VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenDelegate VerificationKeyFile
vk SigningKeyFile
sk OpCertCounterFile
ctr
runGenesisCmd (GenesisKeyGenUTxO VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenUTxO VerificationKeyFile
vk SigningKeyFile
sk
runGenesisCmd (GenesisCmdKeyHash VerificationKeyFile
vk) = VerificationKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyHash VerificationKeyFile
vk
runGenesisCmd (GenesisVerKey VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisVerKey VerificationKeyFile
vk SigningKeyFile
sk
runGenesisCmd (GenesisTxIn VerificationKeyFile
vk NetworkId
nw Maybe OutputFile
mOutFile) = VerificationKeyFile
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisTxIn VerificationKeyFile
vk NetworkId
nw Maybe OutputFile
mOutFile
runGenesisCmd (GenesisAddr VerificationKeyFile
vk NetworkId
nw Maybe OutputFile
mOutFile) = VerificationKeyFile
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisAddr VerificationKeyFile
vk NetworkId
nw Maybe OutputFile
mOutFile
runGenesisCmd (GenesisCreate GenesisDir
gd Word
gn Word
un Maybe SystemStart
ms Maybe Lovelace
am NetworkId
nw) = GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Lovelace
-> NetworkId
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreate GenesisDir
gd Word
gn Word
un Maybe SystemStart
ms Maybe Lovelace
am NetworkId
nw
runGenesisCmd (GenesisCreateCardano GenesisDir
gd Word
gn Word
un Maybe SystemStart
ms Maybe Lovelace
am BlockCount
k Word
slotLength Rational
sc NetworkId
nw String
bg String
sg String
ag String
cg Maybe String
mNodeCfg) = GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Lovelace
-> BlockCount
-> Word
-> Rational
-> NetworkId
-> String
-> String
-> String
-> String
-> Maybe String
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreateCardano GenesisDir
gd Word
gn Word
un Maybe SystemStart
ms Maybe Lovelace
am BlockCount
k Word
slotLength Rational
sc NetworkId
nw String
bg String
sg String
ag String
cg Maybe String
mNodeCfg
runGenesisCmd (GenesisCreateStaked GenesisDir
gd Word
gn Word
gp Word
gl Word
un Maybe SystemStart
ms Maybe Lovelace
am Lovelace
ds NetworkId
nw Word
bf Word
bp Word
su Maybe String
relayJsonFp) =
  GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Lovelace
-> Lovelace
-> NetworkId
-> Word
-> Word
-> Word
-> Maybe String
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreateStaked GenesisDir
gd Word
gn Word
gp Word
gl Word
un Maybe SystemStart
ms Maybe Lovelace
am Lovelace
ds NetworkId
nw Word
bf Word
bp Word
su Maybe String
relayJsonFp
runGenesisCmd (GenesisHashFile GenesisFile
gf) = GenesisFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisHashFile GenesisFile
gf

--
-- Genesis command implementations
--

runGenesisKeyGenGenesis :: VerificationKeyFile -> SigningKeyFile
                        -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenGenesis :: VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenGenesis (VerificationKeyFile String
vkeyPath)
                        (SigningKeyFile String
skeyPath) = do
    SigningKey GenesisKey
skey <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType GenesisKey
AsGenesisKey
    let vkey :: VerificationKey GenesisKey
vkey = forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisKey
skey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
skeyPath (forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisKey
skey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath (forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey GenesisKey
vkey
  where
    skeyDesc, vkeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis Signing Key"
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Genesis Verification Key"


runGenesisKeyGenDelegate :: VerificationKeyFile
                         -> SigningKeyFile
                         -> OpCertCounterFile
                         -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenDelegate :: VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenDelegate (VerificationKeyFile String
vkeyPath)
                         (SigningKeyFile String
skeyPath)
                         (OpCertCounterFile String
ocertCtrPath) = do
    SigningKey GenesisDelegateKey
skey <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey
    let vkey :: VerificationKey GenesisDelegateKey
vkey = forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisDelegateKey
skey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
skeyPath (forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisDelegateKey
skey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath (forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey GenesisDelegateKey
vkey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
ocertCtrPath (forall a. a -> Maybe a
Just TextEnvelopeDescr
certCtrDesc)
      forall a b. (a -> b) -> a -> b
$ Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter
          Word64
initialCounter
          (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisDelegateKey
vkey)  -- Cast to a 'StakePoolKey'
  where
    skeyDesc, vkeyDesc, certCtrDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis delegate operator key"
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Genesis delegate operator key"
    certCtrDesc :: TextEnvelopeDescr
certCtrDesc = TextEnvelopeDescr
"Next certificate issue number: "
               forall a. Semigroup a => a -> a -> a
<> forall a. IsString a => String -> a
fromString (forall a. Show a => a -> String
show Word64
initialCounter)

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


runGenesisKeyGenDelegateVRF :: VerificationKeyFile -> SigningKeyFile
                            -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenDelegateVRF :: VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenDelegateVRF (VerificationKeyFile String
vkeyPath)
                            (SigningKeyFile String
skeyPath) = do
    SigningKey VrfKey
skey <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType VrfKey
AsVrfKey
    let vkey :: VerificationKey VrfKey
vkey = forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey VrfKey
skey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
skeyPath (forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey VrfKey
skey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath (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"


runGenesisKeyGenUTxO :: VerificationKeyFile -> SigningKeyFile
                     -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenUTxO :: VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenUTxO (VerificationKeyFile String
vkeyPath)
                     (SigningKeyFile String
skeyPath) = do
    SigningKey GenesisUTxOKey
skey <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey
    let vkey :: VerificationKey GenesisUTxOKey
vkey = forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisUTxOKey
skey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
skeyPath (forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisUTxOKey
skey
    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath (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"


runGenesisKeyHash :: VerificationKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyHash :: VerificationKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyHash (VerificationKeyFile String
vkeyPath) = do
    SomeGenesisKey VerificationKey
vkey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
            forall b.
[FromSomeType HasTextEnvelope b]
-> String -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
              [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey)
                             forall (f :: * -> *). f GenesisKey -> SomeGenesisKey f
AGenesisKey
              , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
                             forall (f :: * -> *). f GenesisDelegateKey -> SomeGenesisKey f
AGenesisDelegateKey
              , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
                             forall (f :: * -> *). f GenesisUTxOKey -> SomeGenesisKey f
AGenesisUTxOKey
              ]
              String
vkeyPath
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ByteString -> IO ()
BS.putStrLn (SomeGenesisKey VerificationKey -> ByteString
renderKeyHash SomeGenesisKey VerificationKey
vkey)
  where
    renderKeyHash :: SomeGenesisKey VerificationKey -> ByteString
    renderKeyHash :: SomeGenesisKey VerificationKey -> ByteString
renderKeyHash (AGenesisKey         VerificationKey GenesisKey
vk) = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash VerificationKey GenesisKey
vk
    renderKeyHash (AGenesisDelegateKey VerificationKey GenesisDelegateKey
vk) = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash VerificationKey GenesisDelegateKey
vk
    renderKeyHash (AGenesisUTxOKey     VerificationKey GenesisUTxOKey
vk) = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash VerificationKey GenesisUTxOKey
vk

    renderVerificationKeyHash :: Key keyrole => VerificationKey keyrole -> ByteString
    renderVerificationKeyHash :: forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash = forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex
                              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash


runGenesisVerKey :: VerificationKeyFile -> SigningKeyFile
                 -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisVerKey :: VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisVerKey (VerificationKeyFile String
vkeyPath) (SigningKeyFile String
skeyPath) = do
    SomeGenesisKey SigningKey
skey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
            forall b.
[FromSomeType HasTextEnvelope b]
-> String -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
              [ forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisKey
AsGenesisKey)
                             forall (f :: * -> *). f GenesisKey -> SomeGenesisKey f
AGenesisKey
              , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
                             forall (f :: * -> *). f GenesisDelegateKey -> SomeGenesisKey f
AGenesisDelegateKey
              , forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType (forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
                             forall (f :: * -> *). f GenesisUTxOKey -> SomeGenesisKey f
AGenesisUTxOKey
              ]
              String
skeyPath

    let vkey :: SomeGenesisKey VerificationKey
        vkey :: SomeGenesisKey VerificationKey
vkey = case SomeGenesisKey SigningKey
skey of
          AGenesisKey         SigningKey GenesisKey
sk -> forall (f :: * -> *). f GenesisKey -> SomeGenesisKey f
AGenesisKey         (forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisKey
sk)
          AGenesisDelegateKey SigningKey GenesisDelegateKey
sk -> forall (f :: * -> *). f GenesisDelegateKey -> SomeGenesisKey f
AGenesisDelegateKey (forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisDelegateKey
sk)
          AGenesisUTxOKey     SigningKey GenesisUTxOKey
sk -> forall (f :: * -> *). f GenesisUTxOKey -> SomeGenesisKey f
AGenesisUTxOKey     (forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisUTxOKey
sk)

    forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$
      case SomeGenesisKey VerificationKey
vkey of
        AGenesisKey         VerificationKey GenesisKey
vk -> forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath forall a. Maybe a
Nothing VerificationKey GenesisKey
vk
        AGenesisDelegateKey VerificationKey GenesisDelegateKey
vk -> forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath forall a. Maybe a
Nothing VerificationKey GenesisDelegateKey
vk
        AGenesisUTxOKey     VerificationKey GenesisUTxOKey
vk -> forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath forall a. Maybe a
Nothing VerificationKey GenesisUTxOKey
vk

data SomeGenesisKey f
     = AGenesisKey         (f GenesisKey)
     | AGenesisDelegateKey (f GenesisDelegateKey)
     | AGenesisUTxOKey     (f GenesisUTxOKey)


runGenesisTxIn :: VerificationKeyFile -> NetworkId -> Maybe OutputFile
               -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisTxIn :: VerificationKeyFile
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisTxIn (VerificationKeyFile String
vkeyPath) NetworkId
network Maybe OutputFile
mOutFile = do
    VerificationKey GenesisUTxOKey
vkey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
            forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey) String
vkeyPath
    let txin :: TxIn
txin = NetworkId -> Hash GenesisUTxOKey -> TxIn
genesisUTxOPseudoTxIn NetworkId
network (forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisUTxOKey
vkey)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe OutputFile -> Text -> IO ()
writeOutput Maybe OutputFile
mOutFile (TxIn -> Text
renderTxIn TxIn
txin)


runGenesisAddr :: VerificationKeyFile -> NetworkId -> Maybe OutputFile
               -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisAddr :: VerificationKeyFile
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisAddr (VerificationKeyFile String
vkeyPath) NetworkId
network Maybe OutputFile
mOutFile = do
    VerificationKey GenesisUTxOKey
vkey <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
            forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey) String
vkeyPath
    let vkh :: Hash PaymentKey
vkh  = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisUTxOKey
vkey)
        addr :: Address ShelleyAddr
addr = NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress NetworkId
network (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
                                  StakeAddressReference
NoStakeAddress
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Maybe OutputFile -> Text -> IO ()
writeOutput Maybe OutputFile
mOutFile (forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address ShelleyAddr
addr)

writeOutput :: Maybe OutputFile -> Text -> IO ()
writeOutput :: Maybe OutputFile -> Text -> IO ()
writeOutput (Just (OutputFile String
fpath)) = String -> Text -> IO ()
Text.writeFile String
fpath
writeOutput Maybe OutputFile
Nothing                   = Text -> IO ()
Text.putStrLn


--
-- Create Genesis command implementation
--

runGenesisCreate :: GenesisDir
                 -> Word  -- ^ num genesis & delegate keys to make
                 -> Word  -- ^ num utxo keys to make
                 -> Maybe SystemStart
                 -> Maybe Lovelace
                 -> NetworkId
                 -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreate :: GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Lovelace
-> NetworkId
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreate (GenesisDir String
rootdir)
                 Word
genNumGenesisKeys Word
genNumUTxOKeys
                 Maybe SystemStart
mStart Maybe Lovelace
mAmount NetworkId
network = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
rootdir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
gendir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
deldir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
utxodir

  ShelleyGenesis StandardShelley
template <- String
-> (ShelleyGenesis StandardShelley
    -> ShelleyGenesis StandardShelley)
-> ExceptT
     ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
readShelleyGenesisWithDefault (String
rootdir String -> ShowS
</> String
"genesis.spec.json") ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustTemplate
  AlonzoGenesis
alonzoGenesis <- String -> ExceptT ShelleyGenesisCmdError IO AlonzoGenesis
readAlonzoGenesis (String
rootdir String -> ShowS
</> String
"genesis.alonzo.spec.json")
  ConwayGenesis StandardCrypto
conwayGenesis <- String
-> ExceptT ShelleyGenesisCmdError IO (ConwayGenesis StandardCrypto)
readConwayGenesis (String
rootdir String -> ShowS
</> String
"genesis.conway.spec.json")

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ Word
1 .. Word
genNumGenesisKeys ] forall a b. (a -> b) -> a -> b
$ \Word
index -> do
    String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createGenesisKeys  String
gendir  Word
index
    String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createDelegateKeys String
deldir Word
index

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ Word
1 .. Word
genNumUTxOKeys ] forall a b. (a -> b) -> a -> b
$ \Word
index ->
    String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createUtxoKeys String
utxodir Word
index

  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs <- String
-> String
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap String
gendir String
deldir
  [AddressInEra ShelleyEra]
utxoAddrs <- String
-> NetworkId
-> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses String
utxodir NetworkId
network
  SystemStart
start <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> SystemStart
SystemStart forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ExceptT a IO UTCTime
getCurrentTimePlus30) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SystemStart
mStart

  let shelleyGenesis :: ShelleyGenesis StandardShelley
shelleyGenesis =
        SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Lovelace
-> [AddressInEra ShelleyEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Lovelace
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardShelley
-> ShelleyGenesis StandardShelley
updateTemplate
          -- Shelley genesis parameters
          SystemStart
start Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs Maybe Lovelace
mAmount [AddressInEra ShelleyEra]
utxoAddrs forall a. Monoid a => a
mempty (Integer -> Lovelace
Lovelace Integer
0) [] [] ShelleyGenesis StandardShelley
template

  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.json")        forall a b. (a -> b) -> a -> b
$ forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ShelleyGenesis StandardShelley
shelleyGenesis
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.alonzo.json") forall a b. (a -> b) -> a -> b
$ forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty AlonzoGenesis
alonzoGenesis
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.conway.json") forall a b. (a -> b) -> a -> b
$ forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ConwayGenesis StandardCrypto
conwayGenesis
  --TODO: rationalise the naming convention on these genesis json files.
  where
    adjustTemplate :: ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustTemplate ShelleyGenesis StandardShelley
t = ShelleyGenesis StandardShelley
t { sgNetworkMagic :: Word32
sgNetworkMagic = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
network) }
    gendir :: String
gendir  = String
rootdir String -> ShowS
</> String
"genesis-keys"
    deldir :: String
deldir  = String
rootdir String -> ShowS
</> String
"delegate-keys"
    utxodir :: String
utxodir = String
rootdir String -> ShowS
</> String
"utxo-keys"

toSKeyJSON :: Key a => SigningKey a -> ByteString
toSKeyJSON :: forall a. Key a => SigningKey a -> ByteString
toSKeyJSON = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON forall a. Maybe a
Nothing

toVkeyJSON :: Key a => SigningKey a -> ByteString
toVkeyJSON :: forall a. Key a => SigningKey a -> ByteString
toVkeyJSON = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey

toVkeyJSON' :: Key a => VerificationKey a -> ByteString
toVkeyJSON' :: forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
toVkeyJSON' = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON forall a. Maybe a
Nothing

toOpCert :: (OperationalCertificate, OperationalCertificateIssueCounter) -> ByteString
toOpCert :: (OperationalCertificate, OperationalCertificateIssueCounter)
-> ByteString
toOpCert = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst

toCounter :: (OperationalCertificate, OperationalCertificateIssueCounter) -> ByteString
toCounter :: (OperationalCertificate, OperationalCertificateIssueCounter)
-> ByteString
toCounter = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON forall a. Maybe a
Nothing forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd

generateShelleyNodeSecrets :: [SigningKey GenesisDelegateExtendedKey] -> [VerificationKey GenesisKey]
    -> IO (Map (Hash GenesisKey)
      ( Hash GenesisDelegateKey, Hash VrfKey)
      , [SigningKey VrfKey]
      , [SigningKey KesKey]
      , [(OperationalCertificate, OperationalCertificateIssueCounter)])
generateShelleyNodeSecrets :: [SigningKey GenesisDelegateExtendedKey]
-> [VerificationKey GenesisKey]
-> IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
      [SigningKey VrfKey], [SigningKey KesKey],
      [(OperationalCertificate, OperationalCertificateIssueCounter)])
generateShelleyNodeSecrets [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys [VerificationKey GenesisKey]
shelleyGenesisvkeys = do
  let
    shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey]
    shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey]
shelleyDelegatevkeys = forall a b. (a -> b) -> [a] -> [b]
map (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey) [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys
  [SigningKey VrfKey]
vrfKeys <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys forall a b. (a -> b) -> a -> b
$ \SigningKey GenesisDelegateExtendedKey
_ -> forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType VrfKey
AsVrfKey
  [SigningKey KesKey]
kesKeys <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys forall a b. (a -> b) -> a -> b
$ \SigningKey GenesisDelegateExtendedKey
_ -> forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType KesKey
AsKesKey

  let
    opCertInputs :: [(VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)]
    opCertInputs :: [(VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)]
opCertInputs = forall a b. [a] -> [b] -> [(a, b)]
zip (forall a b. (a -> b) -> [a] -> [b]
map forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey [SigningKey KesKey]
kesKeys) [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys
    createOpCert :: (VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey) -> (OperationalCertificate, OperationalCertificateIssueCounter)
    createOpCert :: (VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)
-> (OperationalCertificate, OperationalCertificateIssueCounter)
createOpCert (VerificationKey KesKey
kesKey, SigningKey GenesisDelegateExtendedKey
delegateKey) = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. HasCallStack => String -> a
error forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a. a -> a
id Either
  OperationalCertIssueError
  (OperationalCertificate, OperationalCertificateIssueCounter)
eResult
      where
        eResult :: Either
  OperationalCertIssueError
  (OperationalCertificate, OperationalCertificateIssueCounter)
eResult = VerificationKey KesKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
-> KESPeriod
-> OperationalCertificateIssueCounter
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
issueOperationalCertificate VerificationKey KesKey
kesKey (forall a b. b -> Either a b
Right SigningKey GenesisDelegateExtendedKey
delegateKey) (Word -> KESPeriod
KESPeriod Word
0) OperationalCertificateIssueCounter
counter
        counter :: OperationalCertificateIssueCounter
counter = Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter Word64
0 (VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey forall a b. (a -> b) -> a -> b
$ SigningKey GenesisDelegateExtendedKey
delegateKey)
        convert :: VerificationKey GenesisDelegateExtendedKey
                -> VerificationKey StakePoolKey
        convert :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
convert = (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey :: VerificationKey GenesisDelegateKey
                                       -> VerificationKey StakePoolKey)
                forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey :: VerificationKey GenesisDelegateExtendedKey
                                       -> VerificationKey GenesisDelegateKey)

    opCerts :: [(OperationalCertificate, OperationalCertificateIssueCounter)]
    opCerts :: [(OperationalCertificate, OperationalCertificateIssueCounter)]
opCerts = forall a b. (a -> b) -> [a] -> [b]
map (VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)
-> (OperationalCertificate, OperationalCertificateIssueCounter)
createOpCert [(VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)]
opCertInputs

    vrfvkeys :: [VerificationKey VrfKey]
vrfvkeys = forall a b. (a -> b) -> [a] -> [b]
map forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey [SigningKey VrfKey]
vrfKeys
    combinedMap :: [ ( VerificationKey GenesisKey
                     , VerificationKey GenesisDelegateKey
                     , VerificationKey VrfKey
                     )
                   ]
    combinedMap :: [(VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
  VerificationKey VrfKey)]
combinedMap = forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [VerificationKey GenesisKey]
shelleyGenesisvkeys [VerificationKey GenesisDelegateKey]
shelleyDelegatevkeys [VerificationKey VrfKey]
vrfvkeys
    hashKeys :: (VerificationKey GenesisKey, VerificationKey GenesisDelegateKey, VerificationKey VrfKey) -> (Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))
    hashKeys :: (VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
 VerificationKey VrfKey)
-> (Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))
hashKeys (VerificationKey GenesisKey
genesis,VerificationKey GenesisDelegateKey
delegate,VerificationKey VrfKey
vrf) = (forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisKey
genesis, (forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisDelegateKey
delegate, forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VrfKey
vrf));
    delegateMap :: Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
    delegateMap :: Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegateMap = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
 VerificationKey VrfKey)
-> (Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))
hashKeys forall a b. (a -> b) -> a -> b
$ [(VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
  VerificationKey VrfKey)]
combinedMap

  forall (m :: * -> *) a. Monad m => a -> m a
return (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegateMap, [SigningKey VrfKey]
vrfKeys, [SigningKey KesKey]
kesKeys, [(OperationalCertificate, OperationalCertificateIssueCounter)]
opCerts)

--
-- Create Genesis Cardano command implementation
--

runGenesisCreateCardano :: GenesisDir
                 -> Word  -- ^ num genesis & delegate keys to make
                 -> Word  -- ^ num utxo keys to make
                 -> Maybe SystemStart
                 -> Maybe Lovelace
                 -> BlockCount
                 -> Word     -- ^ slot length in ms
                 -> Rational
                 -> NetworkId
                 -> FilePath -- ^ Byron Genesis
                 -> FilePath -- ^ Shelley Genesis
                 -> FilePath -- ^ Alonzo Genesis
                 -> FilePath -- ^ Conway Genesis
                 -> Maybe FilePath
                 -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreateCardano :: GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Lovelace
-> BlockCount
-> Word
-> Rational
-> NetworkId
-> String
-> String
-> String
-> String
-> Maybe String
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreateCardano (GenesisDir String
rootdir)
                 Word
genNumGenesisKeys Word
genNumUTxOKeys
                 Maybe SystemStart
mStart Maybe Lovelace
mAmount BlockCount
mSecurity Word
slotLength Rational
mSlotCoeff
                 NetworkId
network String
byronGenesisT String
shelleyGenesisT String
alonzoGenesisT String
conwayGenesisT Maybe String
mNodeCfg = do
  SystemStart
start <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> SystemStart
SystemStart forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ExceptT a IO UTCTime
getCurrentTimePlus30) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SystemStart
mStart
  (GenesisData
byronGenesis', GeneratedSecrets
byronSecrets) <- forall {a}.
ExceptT ByronGenesisError IO a
-> ExceptT ShelleyGenesisCmdError IO a
convertToShelleyError forall a b. (a -> b) -> a -> b
$ GenesisParameters
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
Byron.mkGenesis forall a b. (a -> b) -> a -> b
$ SystemStart -> GenesisParameters
byronParams SystemStart
start
  let
    byronGenesis :: GenesisData
byronGenesis = GenesisData
byronGenesis'
      { gdProtocolParameters :: ProtocolParameters
gdProtocolParameters = (GenesisData -> ProtocolParameters
gdProtocolParameters GenesisData
byronGenesis') {
          ppSlotDuration :: Natural
ppSlotDuration = forall a b. (RealFrac a, Integral b) => a -> b
floor ( forall a. Real a => a -> Rational
toRational Word
slotLength forall a. Num a => a -> a -> a
* forall a. Fractional a => a -> a
recip Rational
mSlotCoeff )
        }
      }

    genesisKeys :: [SigningKey]
genesisKeys = GeneratedSecrets -> [SigningKey]
gsDlgIssuersSecrets GeneratedSecrets
byronSecrets
    byronGenesisKeys :: [SigningKey ByronKey]
byronGenesisKeys = forall a b. (a -> b) -> [a] -> [b]
map SigningKey -> SigningKey ByronKey
ByronSigningKey [SigningKey]
genesisKeys
    shelleyGenesisKeys :: [SigningKey GenesisExtendedKey]
shelleyGenesisKeys = forall a b. (a -> b) -> [a] -> [b]
map SigningKey -> SigningKey GenesisExtendedKey
convertGenesisKey [SigningKey]
genesisKeys
    shelleyGenesisvkeys :: [VerificationKey GenesisKey]
    shelleyGenesisvkeys :: [VerificationKey GenesisKey]
shelleyGenesisvkeys = forall a b. (a -> b) -> [a] -> [b]
map (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey) [SigningKey GenesisExtendedKey]
shelleyGenesisKeys

    delegateKeys :: [SigningKey]
delegateKeys = GeneratedSecrets -> [SigningKey]
gsRichSecrets GeneratedSecrets
byronSecrets
    byronDelegateKeys :: [SigningKey ByronKey]
byronDelegateKeys = forall a b. (a -> b) -> [a] -> [b]
map SigningKey -> SigningKey ByronKey
ByronSigningKey [SigningKey]
delegateKeys
    shelleyDelegateKeys :: [SigningKey GenesisDelegateExtendedKey]
    shelleyDelegateKeys :: [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys = forall a b. (a -> b) -> [a] -> [b]
map SigningKey -> SigningKey GenesisDelegateExtendedKey
convertDelegate [SigningKey]
delegateKeys
    shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey]
    shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey]
shelleyDelegatevkeys = forall a b. (a -> b) -> [a] -> [b]
map (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey) [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys

    utxoKeys :: [PoorSecret]
utxoKeys = GeneratedSecrets -> [PoorSecret]
gsPoorSecrets GeneratedSecrets
byronSecrets
    byronUtxoKeys :: [SigningKey ByronKey]
byronUtxoKeys = forall a b. (a -> b) -> [a] -> [b]
map (SigningKey -> SigningKey ByronKey
ByronSigningKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoorSecret -> SigningKey
Genesis.poorSecretToKey) [PoorSecret]
utxoKeys
    shelleyUtxoKeys :: [SigningKey ByronKey]
shelleyUtxoKeys = forall a b. (a -> b) -> [a] -> [b]
map (SigningKey -> SigningKey ByronKey
convertPoor forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoorSecret -> SigningKey
Genesis.poorSecretToKey) [PoorSecret]
utxoKeys

  [Certificate]
dlgCerts <- forall {a}.
ExceptT ByronGenesisError IO a
-> ExceptT ShelleyGenesisCmdError IO a
convertToShelleyError forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (GenesisData
-> SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert GenesisData
byronGenesis) [SigningKey ByronKey]
byronDelegateKeys
  let
    overrideShelleyGenesis :: ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
overrideShelleyGenesis ShelleyGenesis StandardShelley
t = ShelleyGenesis StandardShelley
t
      { sgNetworkMagic :: Word32
sgNetworkMagic = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
network)
      , sgNetworkId :: Network
sgNetworkId = NetworkId -> Network
toShelleyNetwork NetworkId
network
      , sgActiveSlotsCoeff :: PositiveUnitInterval
sgActiveSlotsCoeff = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Could not convert from Rational: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rational
mSlotCoeff) forall a b. (a -> b) -> a -> b
$ forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
mSlotCoeff
      , sgSecurityParam :: Word64
sgSecurityParam = BlockCount -> Word64
unBlockCount BlockCount
mSecurity
      , sgUpdateQuorum :: Word64
sgUpdateQuorum = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ((Word
genNumGenesisKeys forall a. Integral a => a -> a -> a
`div` Word
3) forall a. Num a => a -> a -> a
* Word
2) forall a. Num a => a -> a -> a
+ Word
1
      , sgEpochLength :: EpochSize
sgEpochLength = Word64 -> EpochSize
EpochSize forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (BlockCount -> Word64
unBlockCount BlockCount
mSecurity) forall a. Num a => a -> a -> a
* Rational
10) forall a. Fractional a => a -> a -> a
/ Rational
mSlotCoeff
      , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = Word64
45000000000000000
      , sgSystemStart :: UTCTime
sgSystemStart = SystemStart -> UTCTime
getSystemStart SystemStart
start
      , sgSlotLength :: NominalDiffTime
sgSlotLength = Pico -> NominalDiffTime
secondsToNominalDiffTime forall a b. (a -> b) -> a -> b
$ forall k (a :: k). Integer -> Fixed a
MkFixed (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
slotLength) forall a. Num a => a -> a -> a
* Pico
1000000000
      }
  ShelleyGenesis StandardShelley
shelleyGenesisTemplate <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
overrideShelleyGenesis forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => String -> a
error String
"shelley genesis template not found") forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> IO
     (Either ShelleyGenesisCmdError (ShelleyGenesis StandardShelley))
readAndDecodeShelleyGenesis String
shelleyGenesisT
  AlonzoGenesis
alonzoGenesis <- String -> ExceptT ShelleyGenesisCmdError IO AlonzoGenesis
readAlonzoGenesis String
alonzoGenesisT
  ConwayGenesis StandardCrypto
conwayGenesis <- String
-> ExceptT ShelleyGenesisCmdError IO (ConwayGenesis StandardCrypto)
readConwayGenesis String
conwayGenesisT
  (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegateMap, [SigningKey VrfKey]
vrfKeys, [SigningKey KesKey]
kesKeys, [(OperationalCertificate, OperationalCertificateIssueCounter)]
opCerts) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ [SigningKey GenesisDelegateExtendedKey]
-> [VerificationKey GenesisKey]
-> IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
      [SigningKey VrfKey], [SigningKey KesKey],
      [(OperationalCertificate, OperationalCertificateIssueCounter)])
generateShelleyNodeSecrets [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys [VerificationKey GenesisKey]
shelleyGenesisvkeys
  let
    shelleyGenesis :: ShelleyGenesis StandardShelley
    shelleyGenesis :: ShelleyGenesis StandardShelley
shelleyGenesis = SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Lovelace
-> [AddressInEra ShelleyEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Lovelace
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardShelley
-> ShelleyGenesis StandardShelley
updateTemplate SystemStart
start Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegateMap forall a. Maybe a
Nothing [] forall a. Monoid a => a
mempty Lovelace
0 [] [] ShelleyGenesis StandardShelley
shelleyGenesisTemplate

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
rootdir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
gendir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
deldir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
utxodir

    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
gendir String
"byron" String
"key" forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes [SigningKey ByronKey]
byronGenesisKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
gendir String
"shelley" String
"skey" forall a. Key a => SigningKey a -> ByteString
toSKeyJSON [SigningKey GenesisExtendedKey]
shelleyGenesisKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
gendir String
"shelley" String
"vkey" forall a. Key a => SigningKey a -> ByteString
toVkeyJSON [SigningKey GenesisExtendedKey]
shelleyGenesisKeys

    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"byron" String
"key" forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes [SigningKey ByronKey]
byronDelegateKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"skey" forall a. Key a => SigningKey a -> ByteString
toSKeyJSON [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"vkey" forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
toVkeyJSON' [VerificationKey GenesisDelegateKey]
shelleyDelegatevkeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"vrf.skey" forall a. Key a => SigningKey a -> ByteString
toSKeyJSON [SigningKey VrfKey]
vrfKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"vrf.vkey" forall a. Key a => SigningKey a -> ByteString
toVkeyJSON [SigningKey VrfKey]
vrfKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"kes.skey" forall a. Key a => SigningKey a -> ByteString
toSKeyJSON [SigningKey KesKey]
kesKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"kes.vkey" forall a. Key a => SigningKey a -> ByteString
toVkeyJSON [SigningKey KesKey]
kesKeys

    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
utxodir String
"byron" String
"key" forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes [SigningKey ByronKey]
byronUtxoKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
utxodir String
"shelley" String
"skey" forall a. Key a => SigningKey a -> ByteString
toSKeyJSON [SigningKey ByronKey]
shelleyUtxoKeys
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
utxodir String
"shelley" String
"vkey" forall a. Key a => SigningKey a -> ByteString
toVkeyJSON [SigningKey ByronKey]
shelleyUtxoKeys

    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"byron" String
"cert.json" Certificate -> ByteString
serialiseDelegationCert [Certificate]
dlgCerts

    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"opcert.json" (OperationalCertificate, OperationalCertificateIssueCounter)
-> ByteString
toOpCert [(OperationalCertificate, OperationalCertificateIssueCounter)]
opCerts
    forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"counter.json" (OperationalCertificate, OperationalCertificateIssueCounter)
-> ByteString
toCounter [(OperationalCertificate, OperationalCertificateIssueCounter)]
opCerts

  Hash Blake2b_256 ByteString
byronGenesisHash <- String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"byron-genesis.json") forall a b. (a -> b) -> a -> b
$ forall genesis.
ToJSON Identity genesis =>
genesis -> WriteFileGenesis
WriteCanonical GenesisData
byronGenesis
  Hash Blake2b_256 ByteString
shelleyGenesisHash <- String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"shelley-genesis.json") forall a b. (a -> b) -> a -> b
$ forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ShelleyGenesis StandardShelley
shelleyGenesis
  Hash Blake2b_256 ByteString
alonzoGenesisHash <- String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"alonzo-genesis.json") forall a b. (a -> b) -> a -> b
$ forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty AlonzoGenesis
alonzoGenesis
  Hash Blake2b_256 ByteString
conwayGenesisHash <- String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"conway-genesis.json") forall a b. (a -> b) -> a -> b
$ forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ConwayGenesis StandardCrypto
conwayGenesis

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    case Maybe String
mNodeCfg of
      Maybe String
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just String
nodeCfg -> do
        Value
nodeConfig <- forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
Yaml.decodeFileThrow String
nodeCfg
        let
          setHash :: Key -> Hash h a -> KeyMap Value -> KeyMap Value
setHash Key
field Hash h a
hash = forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.insert Key
field forall a b. (a -> b) -> a -> b
$ Text -> Value
String forall a b. (a -> b) -> a -> b
$ forall h a. Hash h a -> Text
Crypto.hashToTextAsHex Hash h a
hash
          updateConfig :: Yaml.Value -> Yaml.Value
          updateConfig :: Value -> Value
updateConfig (Object KeyMap Value
obj) = KeyMap Value -> Value
Object
              forall a b. (a -> b) -> a -> b
$ forall {h} {a}. Key -> Hash h a -> KeyMap Value -> KeyMap Value
setHash Key
"ByronGenesisHash" Hash Blake2b_256 ByteString
byronGenesisHash
              forall a b. (a -> b) -> a -> b
$ forall {h} {a}. Key -> Hash h a -> KeyMap Value -> KeyMap Value
setHash Key
"ShelleyGenesisHash" Hash Blake2b_256 ByteString
shelleyGenesisHash
              forall a b. (a -> b) -> a -> b
$ forall {h} {a}. Key -> Hash h a -> KeyMap Value -> KeyMap Value
setHash Key
"AlonzoGenesisHash" Hash Blake2b_256 ByteString
alonzoGenesisHash
              forall a b. (a -> b) -> a -> b
$ forall {h} {a}. Key -> Hash h a -> KeyMap Value -> KeyMap Value
setHash Key
"ConwayGenesisHash" Hash Blake2b_256 ByteString
conwayGenesisHash
              KeyMap Value
obj
          updateConfig Value
x = Value
x
          newConfig :: Yaml.Value
          newConfig :: Value
newConfig = Value -> Value
updateConfig Value
nodeConfig
        forall a. ToJSON a => String -> a -> IO ()
encodeFile (String
rootdir String -> ShowS
</> String
"node-config.json") Value
newConfig

  where
    convertToShelleyError :: ExceptT ByronGenesisError IO a
-> ExceptT ShelleyGenesisCmdError IO a
convertToShelleyError = forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
withExceptT ByronGenesisError -> ShelleyGenesisCmdError
ShelleyGenesisCmdByronError
    convertGenesisKey :: Byron.SigningKey -> SigningKey GenesisExtendedKey
    convertGenesisKey :: SigningKey -> SigningKey GenesisExtendedKey
convertGenesisKey (Byron.SigningKey XPrv
xsk) = XPrv -> SigningKey GenesisExtendedKey
GenesisExtendedSigningKey XPrv
xsk

    convertDelegate :: Byron.SigningKey -> SigningKey GenesisDelegateExtendedKey
    convertDelegate :: SigningKey -> SigningKey GenesisDelegateExtendedKey
convertDelegate (Byron.SigningKey XPrv
xsk) = XPrv -> SigningKey GenesisDelegateExtendedKey
GenesisDelegateExtendedSigningKey XPrv
xsk

    convertPoor :: Byron.SigningKey -> SigningKey ByronKey
    convertPoor :: SigningKey -> SigningKey ByronKey
convertPoor = SigningKey -> SigningKey ByronKey
ByronSigningKey

    byronParams :: SystemStart -> GenesisParameters
byronParams SystemStart
start = UTCTime
-> String
-> BlockCount
-> ProtocolMagic
-> TestnetBalanceOptions
-> FakeAvvmOptions
-> LovelacePortion
-> Maybe Integer
-> GenesisParameters
Byron.GenesisParameters (SystemStart -> UTCTime
getSystemStart SystemStart
start) String
byronGenesisT BlockCount
mSecurity ProtocolMagic
byronNetwork TestnetBalanceOptions
byronBalance FakeAvvmOptions
byronFakeAvvm LovelacePortion
byronAvvmFactor forall a. Maybe a
Nothing
    gendir :: String
gendir  = String
rootdir String -> ShowS
</> String
"genesis-keys"
    deldir :: String
deldir  = String
rootdir String -> ShowS
</> String
"delegate-keys"
    utxodir :: String
utxodir = String
rootdir String -> ShowS
</> String
"utxo-keys"
    byronNetwork :: ProtocolMagic
byronNetwork = forall a.
Annotated ProtocolMagicId a
-> RequiresNetworkMagic -> AProtocolMagic a
CC.AProtocolMagic
                      (forall b a. b -> a -> Annotated b a
Annotated (NetworkId -> ProtocolMagicId
toByronProtocolMagicId NetworkId
network) ())
                      (NetworkId -> RequiresNetworkMagic
toByronRequiresNetworkMagic NetworkId
network)
    byronBalance :: TestnetBalanceOptions
byronBalance = TestnetBalanceOptions
        { tboRichmen :: Word
tboRichmen = Word
genNumGenesisKeys
        , tboPoors :: Word
tboPoors = Word
genNumUTxOKeys
        , tboTotalBalance :: Lovelace
tboTotalBalance = forall a. a -> Maybe a -> a
fromMaybe Lovelace
zeroLovelace forall a b. (a -> b) -> a -> b
$ Lovelace -> Maybe Lovelace
toByronLovelace (forall a. a -> Maybe a -> a
fromMaybe Lovelace
0 Maybe Lovelace
mAmount)
        , tboRichmenShare :: Rational
tboRichmenShare = Rational
0
        }
    byronFakeAvvm :: FakeAvvmOptions
byronFakeAvvm = FakeAvvmOptions
        { faoCount :: Word
faoCount = Word
0
        , faoOneBalance :: Lovelace
faoOneBalance = Lovelace
zeroLovelace
        }
    byronAvvmFactor :: LovelacePortion
byronAvvmFactor = Rational -> LovelacePortion
Byron.rationalToLovelacePortion Rational
0.0
    zeroLovelace :: Lovelace
zeroLovelace = forall (n :: Natural).
(KnownNat n, n <= 45000000000000000) =>
Lovelace
Byron.mkKnownLovelace @0

    -- Compare a given 'SigningKey' with a 'Certificate' 'VerificationKey'
    isCertForSK :: CC.SigningKey -> Dlg.Certificate -> Bool
    isCertForSK :: SigningKey -> Certificate -> Bool
isCertForSK SigningKey
sk Certificate
cert = forall a. ACertificate a -> VerificationKey
delegateVK Certificate
cert forall a. Eq a => a -> a -> Bool
== SigningKey -> VerificationKey
CC.toVerification SigningKey
sk

    findDelegateCert :: Genesis.GenesisData -> SigningKey ByronKey -> ExceptT ByronGenesisError IO Dlg.Certificate
    findDelegateCert :: GenesisData
-> SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert GenesisData
byronGenesis bSkey :: SigningKey ByronKey
bSkey@(ByronSigningKey SigningKey
sk) = do
      case forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (SigningKey -> Certificate -> Bool
isCertForSK SigningKey
sk) (forall k a. Map k a -> [a]
Map.elems forall a b. (a -> b) -> a -> b
$ GenesisData -> Map KeyHash Certificate
dlgCertMap GenesisData
byronGenesis) of
        Maybe Certificate
Nothing -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
throwE forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByronGenesisError
NoGenesisDelegationForKey
                   forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey ByronKey -> Text
Byron.prettyPublicKey forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey ByronKey
bSkey
        Just Certificate
x  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Certificate
x

    dlgCertMap :: Genesis.GenesisData -> Map Byron.KeyHash Dlg.Certificate
    dlgCertMap :: GenesisData -> Map KeyHash Certificate
dlgCertMap GenesisData
byronGenesis = GenesisDelegation -> Map KeyHash Certificate
Genesis.unGenesisDelegation forall a b. (a -> b) -> a -> b
$ GenesisData -> GenesisDelegation
Genesis.gdHeavyDelegation GenesisData
byronGenesis

runGenesisCreateStaked
  :: GenesisDir
  -> Word           -- ^ num genesis & delegate keys to make
  -> Word           -- ^ num utxo keys to make
  -> Word           -- ^ num pools to make
  -> Word           -- ^ num delegators to make
  -> Maybe SystemStart
  -> Maybe Lovelace -- ^ supply going to non-delegators
  -> Lovelace       -- ^ supply going to delegators
  -> NetworkId
  -> Word           -- ^ bulk credential files to write
  -> Word           -- ^ pool credentials per bulk file
  -> Word           -- ^ num stuffed UTxO entries
  -> Maybe FilePath -- ^ Specified stake pool relays
  -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreateStaked :: GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Lovelace
-> Lovelace
-> NetworkId
-> Word
-> Word
-> Word
-> Maybe String
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreateStaked (GenesisDir String
rootdir)
                 Word
genNumGenesisKeys Word
genNumUTxOKeys Word
genNumPools Word
genNumStDelegs
                 Maybe SystemStart
mStart Maybe Lovelace
mNonDlgAmount Lovelace
stDlgAmount NetworkId
network
                 Word
numBulkPoolCredFiles Word
bulkPoolsPerFile Word
numStuffedUtxo
                 Maybe String
sPoolRelayFp = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
rootdir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
gendir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
deldir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
pooldir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
stdeldir
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
utxodir

  ShelleyGenesis StandardShelley
template <- String
-> (ShelleyGenesis StandardShelley
    -> ShelleyGenesis StandardShelley)
-> ExceptT
     ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
readShelleyGenesisWithDefault (String
rootdir String -> ShowS
</> String
"genesis.spec.json") ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustTemplate
  AlonzoGenesis
alonzoGenesis <- String -> ExceptT ShelleyGenesisCmdError IO AlonzoGenesis
readAlonzoGenesis (String
rootdir String -> ShowS
</> String
"genesis.alonzo.spec.json")
  ConwayGenesis StandardCrypto
conwayGenesis <- String
-> ExceptT ShelleyGenesisCmdError IO (ConwayGenesis StandardCrypto)
readConwayGenesis (String
rootdir String -> ShowS
</> String
"genesis.conway.spec.json")

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ Word
1 .. Word
genNumGenesisKeys ] forall a b. (a -> b) -> a -> b
$ \Word
index -> do
    String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createGenesisKeys String
gendir Word
index
    String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createDelegateKeys String
deldir Word
index

  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [ Word
1 .. Word
genNumUTxOKeys ] forall a b. (a -> b) -> a -> b
$ \Word
index ->
    String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createUtxoKeys String
utxodir Word
index

  Maybe (Map Word [StakePoolRelay])
mayStakePoolRelays
    <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe String
sPoolRelayFp forall a b. (a -> b) -> a -> b
$
       \String
fp -> do
         ByteString
relaySpecJsonBs <-
           forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (String -> IOException -> ShelleyGenesisCmdError
ShelleyGenesisStakePoolRelayFileError String
fp) (String -> IO ByteString
LBS.readFile String
fp)
         forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> String -> ShelleyGenesisCmdError
ShelleyGenesisStakePoolRelayJsonDecodeError String
fp)
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode ByteString
relaySpecJsonBs

  [PoolParams StandardCrypto]
poolParams <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ Word
1 .. Word
genNumPools ] forall a b. (a -> b) -> a -> b
$ \Word
index -> do
    String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createPoolCredentials String
pooldir Word
index
    NetworkId
-> String
-> Word
-> Map Word [StakePoolRelay]
-> ExceptT ShelleyGenesisCmdError IO (PoolParams StandardCrypto)
buildPoolParams NetworkId
network String
pooldir Word
index (forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty Maybe (Map Word [StakePoolRelay])
mayStakePoolRelays)

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
numBulkPoolCredFiles forall a. Num a => a -> a -> a
* Word
bulkPoolsPerFile forall a. Ord a => a -> a -> Bool
> Word
genNumPools) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
left forall a b. (a -> b) -> a -> b
$ Word -> Word -> Word -> ShelleyGenesisCmdError
ShelleyGenesisCmdTooFewPoolsForBulkCreds  Word
genNumPools Word
numBulkPoolCredFiles Word
bulkPoolsPerFile
  -- We generate the bulk files for the last pool indices,
  -- so that all the non-bulk pools have stable indices at beginning:
  let bulkOffset :: Word
bulkOffset  = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word
genNumPools forall a. Num a => a -> a -> a
- Word
numBulkPoolCredFiles forall a. Num a => a -> a -> a
* Word
bulkPoolsPerFile
      [Word]
bulkIndices :: [Word]   = [ Word
1 forall a. Num a => a -> a -> a
+ Word
bulkOffset .. Word
genNumPools ]
      [[Word]]
bulkSlices  :: [[Word]] = forall e. Int -> [e] -> [[e]]
List.chunksOf (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
bulkPoolsPerFile) [Word]
bulkIndices
  forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (forall a b. [a] -> [b] -> [(a, b)]
zip [ Word
1 .. Word
numBulkPoolCredFiles ] [[Word]]
bulkSlices) forall a b. (a -> b) -> a -> b
$
    forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> Word -> [Word] -> ExceptT ShelleyGenesisCmdError IO ()
writeBulkPoolCredentials String
pooldir)

  let (Word
delegsPerPool, Word
delegsRemaining) = forall a. Integral a => a -> a -> (a, a)
divMod Word
genNumStDelegs Word
genNumPools
      delegsForPool :: Word -> Word
delegsForPool Word
poolIx = if Word
delegsRemaining forall a. Eq a => a -> a -> Bool
/= Word
0 Bool -> Bool -> Bool
&& Word
poolIx forall a. Eq a => a -> a -> Bool
== Word
genNumPools
        then Word
delegsPerPool
        else Word
delegsPerPool forall a. Num a => a -> a -> a
+ Word
delegsRemaining
      distribution :: [PoolParams StandardCrypto]
distribution = [PoolParams StandardCrypto
pool | (PoolParams StandardCrypto
pool, Word
poolIx) <- forall a b. [a] -> [b] -> [(a, b)]
zip [PoolParams StandardCrypto]
poolParams [Word
1 ..], Word
_ <- [Word
1 .. Word -> Word
delegsForPool Word
poolIx]]

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

  -- Distribute M delegates across N pools:
  [Delegation]
delegations <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) s a b.
MonadUnliftIO m =>
s -> [a] -> (s -> a -> m (s, b)) -> m [b]
Lazy.forStateM StdGen
g [PoolParams StandardCrypto]
distribution forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip StdGen
-> NetworkId
-> PoolParams StandardCrypto
-> IO (StdGen, Delegation)
computeInsecureDelegation NetworkId
network

  let numDelegations :: Int
numDelegations = forall (t :: * -> *) a. Foldable t => t a -> Int
length [Delegation]
delegations

  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs <- String
-> String
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap String
gendir String
deldir
  [AddressInEra ShelleyEra]
nonDelegAddrs <- String
-> NetworkId
-> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses String
utxodir NetworkId
network
  SystemStart
start <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> SystemStart
SystemStart forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ExceptT a IO UTCTime
getCurrentTimePlus30) forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SystemStart
mStart

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

  let stake :: [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Ledger._poolId forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
      stakePools :: [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
stakePools = [ (forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Ledger._poolId PoolParams StandardCrypto
poolParams', PoolParams StandardCrypto
poolParams') | PoolParams StandardCrypto
poolParams' <- forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations ]
      delegAddrs :: [AddressInEra ShelleyEra]
delegAddrs = Delegation -> AddressInEra ShelleyEra
dInitialUtxoAddr forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
      !shelleyGenesis :: ShelleyGenesis StandardShelley
shelleyGenesis =
        SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Lovelace
-> Int
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
-> Lovelace
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardShelley
-> ShelleyGenesis StandardShelley
updateCreateStakedOutputTemplate
          -- Shelley genesis parameters
          SystemStart
start Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs Maybe Lovelace
mNonDlgAmount (forall (t :: * -> *) a. Foldable t => t a -> Int
length [AddressInEra ShelleyEra]
nonDelegAddrs) [AddressInEra ShelleyEra]
nonDelegAddrs [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
stakePools [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake
          Lovelace
stDlgAmount Int
numDelegations [AddressInEra ShelleyEra]
delegAddrs [AddressInEra ShelleyEra]
stuffedUtxoAddrs ShelleyGenesis StandardShelley
template

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LBS.writeFile (String
rootdir String -> ShowS
</> String
"genesis.json") forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
Aeson.encode ShelleyGenesis StandardShelley
shelleyGenesis

  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.alonzo.json") forall a b. (a -> b) -> a -> b
$ forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty AlonzoGenesis
alonzoGenesis
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ String
-> WriteFileGenesis
-> ExceptT ShelleyGenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.conway.json") forall a b. (a -> b) -> a -> b
$ forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ConwayGenesis StandardCrypto
conwayGenesis
  --TODO: rationalise the naming convention on these genesis json files.

  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Handle -> Text -> IO ()
Text.hPutStrLn Handle
IO.stderr forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$
    [ Text
"generated genesis with: "
    , forall a. Show a => a -> Text
textShow Word
genNumGenesisKeys, Text
" genesis keys, "
    , forall a. Show a => a -> Text
textShow Word
genNumUTxOKeys, Text
" non-delegating UTxO keys, "
    , forall a. Show a => a -> Text
textShow Word
genNumPools, Text
" stake pools, "
    , forall a. Show a => a -> Text
textShow Word
genNumStDelegs, Text
" delegating UTxO keys, "
    , forall a. Show a => a -> Text
textShow Int
numDelegations, Text
" delegation map entries, "
    ] forall a. [a] -> [a] -> [a]
++
    [ forall a. Monoid a => [a] -> a
mconcat
      [ Text
", "
      , forall a. Show a => a -> Text
textShow Word
numBulkPoolCredFiles, Text
" bulk pool credential files, "
      , forall a. Show a => a -> Text
textShow Word
bulkPoolsPerFile, Text
" pools per bulk credential file, indices starting from "
      , forall a. Show a => a -> Text
textShow Word
bulkOffset, Text
", "
      , forall a. Show a => a -> Text
textShow forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
bulkIndices, Text
" total pools in bulk nodes, each bulk node having this many entries: "
      , forall a. Show a => a -> Text
textShow forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Word]]
bulkSlices
      ]
    | Word
numBulkPoolCredFiles forall a. Num a => a -> a -> a
* Word
bulkPoolsPerFile forall a. Ord a => a -> a -> Bool
> Word
0 ]

  where
    adjustTemplate :: ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustTemplate ShelleyGenesis StandardShelley
t = ShelleyGenesis StandardShelley
t { sgNetworkMagic :: Word32
sgNetworkMagic = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
network) }
    mkDelegationMapEntry :: Delegation -> (Ledger.KeyHash Ledger.Staking StandardCrypto, Ledger.PoolParams StandardCrypto)
    mkDelegationMapEntry :: Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry Delegation
d = (Delegation -> KeyHash 'Staking StandardCrypto
dDelegStaking Delegation
d, Delegation -> PoolParams StandardCrypto
dPoolParams Delegation
d)

    gendir :: String
gendir   = String
rootdir String -> ShowS
</> String
"genesis-keys"
    deldir :: String
deldir   = String
rootdir String -> ShowS
</> String
"delegate-keys"
    pooldir :: String
pooldir  = String
rootdir String -> ShowS
</> String
"pools"
    stdeldir :: String
stdeldir = String
rootdir String -> ShowS
</> String
"stake-delegator-keys"
    utxodir :: String
utxodir  = String
rootdir String -> ShowS
</> String
"utxo-keys"

    genStuffedAddress :: IO (AddressInEra ShelleyEra)
    genStuffedAddress :: IO (AddressInEra ShelleyEra)
genStuffedAddress =
      forall era.
IsShelleyBasedEra era =>
Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      (Network
-> PaymentCredential StandardCrypto
-> StakeReference StandardCrypto
-> Address ShelleyAddr
ShelleyAddress
       forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Applicative f => a -> f a
pure Network
Ledger.Testnet
       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall (kr :: KeyRole) crypto.
KeyHash kr crypto -> Credential kr crypto
Ledger.KeyHashObj forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int
read64BitInt
             forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. SecureRandom a -> IO a
Crypto.runSecureRandom (forall (m :: * -> *) byteArray.
(MonadRandom m, ByteArray byteArray) =>
Int -> m byteArray
getRandomBytes Int
8))
       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall crypto. StakeReference crypto
Ledger.StakeRefNull)

    read64BitInt :: ByteString -> Int
    read64BitInt :: ByteString -> Int
read64BitInt = (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Word64 -> Int)
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Get a -> ByteString -> a
Bin.runGet Get Word64
Bin.getWord64le forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.fromStrict

    mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash.Hash h a
    mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash h a
mkDummyHash Proxy h
_ = coerce :: forall a b. Coercible a b => a -> b
coerce forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
Ledger.hashWithSerialiser @h forall a. ToCBOR a => a -> Encoding
toCBOR

    mkKeyHash :: forall c discriminator. Crypto c => Int -> Ledger.KeyHash discriminator c
    mkKeyHash :: forall c (discriminator :: KeyRole).
Crypto c =>
Int -> KeyHash discriminator c
mkKeyHash = forall (discriminator :: KeyRole) crypto.
Hash (ADDRHASH crypto) (VerKeyDSIGN (DSIGN crypto))
-> KeyHash discriminator crypto
Ledger.KeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => Proxy h -> Int -> Hash h a
mkDummyHash (forall {k} (t :: k). Proxy t
Proxy @(ADDRHASH c))

-- -------------------------------------------------------------------------------------------------

createDelegateKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createDelegateKeys :: String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createDelegateKeys String
dir Word
index = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenDelegate
        (String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"delegate" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey")
        SigningKeyFile
coldSK
        OpCertCounterFile
opCertCtr
  VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenDelegateVRF
        (String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"delegate" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vrf.vkey")
        (String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"delegate" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vrf.skey")
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyNodeCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdNodeCmdError forall a b. (a -> b) -> a -> b
$ do
    VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenKES
        VerificationKeyFile
kesVK
        (String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"delegate" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".kes.skey")
    VerificationKeyOrFile KesKey
-> SigningKeyFile
-> OpCertCounterFile
-> KESPeriod
-> OutputFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeIssueOpCert
        (forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath VerificationKeyFile
kesVK)
        SigningKeyFile
coldSK
        OpCertCounterFile
opCertCtr
        (Word -> KESPeriod
KESPeriod Word
0)
        (String -> OutputFile
OutputFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"opcert" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".cert")
 where
   strIndex :: String
strIndex = forall a. Show a => a -> String
show Word
index
   kesVK :: VerificationKeyFile
kesVK = String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"delegate" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".kes.vkey"
   coldSK :: SigningKeyFile
coldSK = String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"delegate" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey"
   opCertCtr :: OpCertCounterFile
opCertCtr = String -> OpCertCounterFile
OpCertCounterFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"delegate" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".counter"

createGenesisKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createGenesisKeys :: String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createGenesisKeys String
dir Word
index = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  let strIndex :: String
strIndex = forall a. Show a => a -> String
show Word
index
  VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenGenesis
        (String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"genesis" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey")
        (String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"genesis" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey")


createUtxoKeys :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createUtxoKeys :: String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createUtxoKeys String
dir Word
index = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  let strIndex :: String
strIndex = forall a. Show a => a -> String
show Word
index
  VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyGenUTxO
        (String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"utxo" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey")
        (String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"utxo" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey")

createPoolCredentials :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createPoolCredentials :: String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createPoolCredentials String
dir Word
index = do
  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyNodeCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdNodeCmdError forall a b. (a -> b) -> a -> b
$ do
    VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenKES
        VerificationKeyFile
kesVK
        (String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"kes" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey")
    VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenVRF
        (String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"vrf" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey")
        (String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"vrf" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey")
    VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeKeyGenCold
        (String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"cold" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey")
        SigningKeyFile
coldSK
        OpCertCounterFile
opCertCtr
    VerificationKeyOrFile KesKey
-> SigningKeyFile
-> OpCertCounterFile
-> KESPeriod
-> OutputFile
-> ExceptT ShelleyNodeCmdError IO ()
runNodeIssueOpCert
        (forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath VerificationKeyFile
kesVK)
        SigningKeyFile
coldSK
        OpCertCounterFile
opCertCtr
        (Word -> KESPeriod
KESPeriod Word
0)
        (String -> OutputFile
OutputFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"opcert" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".cert")
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyStakeAddressCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdStakeAddressCmdError forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressKeyGenToFile
        (String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"staking-reward" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey")
        (String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"staking-reward" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey")
 where
   strIndex :: String
strIndex = forall a. Show a => a -> String
show Word
index
   kesVK :: VerificationKeyFile
kesVK = String -> VerificationKeyFile
VerificationKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"kes" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey"
   coldSK :: SigningKeyFile
coldSK = String -> SigningKeyFile
SigningKeyFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"cold" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey"
   opCertCtr :: OpCertCounterFile
opCertCtr = String -> OpCertCounterFile
OpCertCounterFile forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"opcert" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".counter"

data Delegation = Delegation
  { Delegation -> AddressInEra ShelleyEra
dInitialUtxoAddr  :: !(AddressInEra ShelleyEra)
  , Delegation -> KeyHash 'Staking StandardCrypto
dDelegStaking     :: !(Ledger.KeyHash Ledger.Staking StandardCrypto)
  , Delegation -> PoolParams StandardCrypto
dPoolParams       :: !(Ledger.PoolParams StandardCrypto)
  }
  deriving (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
$cto :: forall x. Rep Delegation x -> Delegation
$cfrom :: forall x. Delegation -> Rep Delegation x
Generic, Delegation -> ()
forall a. (a -> ()) -> NFData a
rnf :: Delegation -> ()
$crnf :: Delegation -> ()
NFData)

buildPoolParams
  :: NetworkId
  -> FilePath -- ^ File directory where the necessary pool credentials were created
  -> Word
  -> Map Word [Ledger.StakePoolRelay] -- ^ User submitted stake pool relay map
  -> ExceptT ShelleyGenesisCmdError IO (Ledger.PoolParams StandardCrypto)
buildPoolParams :: NetworkId
-> String
-> Word
-> Map Word [StakePoolRelay]
-> ExceptT ShelleyGenesisCmdError IO (PoolParams StandardCrypto)
buildPoolParams NetworkId
nw String
dir Word
index Map Word [StakePoolRelay]
specifiedRelays = do
    StakePoolVerificationKey VKey 'StakePool StandardCrypto
poolColdVK
      <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (ShelleyPoolCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdPoolCmdError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadFileError)
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolKey
AsStakePoolKey) String
poolColdVKF

    VrfVerificationKey VerKeyVRF StandardCrypto
poolVrfVK
      <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (ShelleyNodeCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdNodeCmdError forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> ShelleyNodeCmdError
ShelleyNodeCmdReadFileError)
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey) String
poolVrfVKF
    VerificationKey StakeKey
rewardsSVK
      <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError
           forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$ forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakeKey
AsStakeKey) String
poolRewardVKF

    forall (f :: * -> *) a. Applicative f => a -> f a
pure Ledger.PoolParams
      { _poolId :: KeyHash 'StakePool StandardCrypto
Ledger._poolId     = forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
Ledger.hashKey VKey 'StakePool StandardCrypto
poolColdVK
      , _poolVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
Ledger._poolVrf    = forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
Ledger.hashVerKeyVRF VerKeyVRF StandardCrypto
poolVrfVK
      , _poolPledge :: Coin
Ledger._poolPledge = Integer -> Coin
Ledger.Coin Integer
0
      , _poolCost :: Coin
Ledger._poolCost   = Integer -> Coin
Ledger.Coin Integer
0
      , _poolMargin :: UnitInterval
Ledger._poolMargin = forall a. Bounded a => a
minBound
      , _poolRAcnt :: RewardAcnt StandardCrypto
Ledger._poolRAcnt  =
          StakeAddress -> RewardAcnt StandardCrypto
toShelleyStakeAddr forall a b. (a -> b) -> a -> b
$ NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
nw forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey (forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
rewardsSVK)
      , _poolOwners :: Set (KeyHash 'Staking StandardCrypto)
Ledger._poolOwners = forall a. Monoid a => a
mempty
      , _poolRelays :: StrictSeq StakePoolRelay
Ledger._poolRelays = Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
specifiedRelays
      , _poolMD :: StrictMaybe PoolMetadata
Ledger._poolMD     = forall a. StrictMaybe a
Ledger.SNothing
      }
 where
   lookupPoolRelay
     :: Map Word [Ledger.StakePoolRelay] -> Seq.StrictSeq Ledger.StakePoolRelay
   lookupPoolRelay :: Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
m = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty forall a. [a] -> StrictSeq a
Seq.fromList (forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word
index Map Word [StakePoolRelay]
m)

   strIndex :: String
strIndex = forall a. Show a => a -> String
show Word
index
   poolColdVKF :: String
poolColdVKF = String
dir String -> ShowS
</> String
"cold" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey"
   poolVrfVKF :: String
poolVrfVKF = String
dir String -> ShowS
</> String
"vrf" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey"
   poolRewardVKF :: String
poolRewardVKF = String
dir String -> ShowS
</> String
"staking-reward" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".vkey"

writeBulkPoolCredentials :: FilePath -> Word -> [Word] -> ExceptT ShelleyGenesisCmdError IO ()
writeBulkPoolCredentials :: String -> Word -> [Word] -> ExceptT ShelleyGenesisCmdError IO ()
writeBulkPoolCredentials String
dir Word
bulkIx [Word]
poolIxs = do
  [(TextEnvelope, TextEnvelope, TextEnvelope)]
creds <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (TextEnvelope, TextEnvelope, TextEnvelope)
readPoolCreds [Word]
poolIxs
  forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
bulkFile) forall a b. (a -> b) -> a -> b
$
    String -> ByteString -> IO ()
LBS.writeFile String
bulkFile forall a b. (a -> b) -> a -> b
$ forall a. ToJSON a => a -> ByteString
Aeson.encode [(TextEnvelope, TextEnvelope, TextEnvelope)]
creds
 where
   bulkFile :: String
bulkFile = String
dir String -> ShowS
</> String
"bulk" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word
bulkIx forall a. [a] -> [a] -> [a]
++ String
".creds"

   readPoolCreds :: Word -> ExceptT ShelleyGenesisCmdError IO
                                   (TextEnvelope, TextEnvelope, TextEnvelope)
   readPoolCreds :: Word
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (TextEnvelope, TextEnvelope, TextEnvelope)
readPoolCreds Word
ix = do
     (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
readEnvelope String
poolOpCert
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
readEnvelope String
poolVrfSKF
          forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
readEnvelope String
poolKesSKF
    where
      strIndex :: String
strIndex = forall a. Show a => a -> String
show Word
ix
      poolOpCert :: String
poolOpCert = String
dir String -> ShowS
</> String
"opcert" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".cert"
      poolVrfSKF :: String
poolVrfSKF = String
dir String -> ShowS
</> String
"vrf" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey"
      poolKesSKF :: String
poolKesSKF = String
dir String -> ShowS
</> String
"kes" forall a. [a] -> [a] -> [a]
++ String
strIndex forall a. [a] -> [a] -> [a]
++ String
".skey"
   readEnvelope :: FilePath -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
   readEnvelope :: String -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
readEnvelope String
fp = do
     ByteString
content <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fp) forall a b. (a -> b) -> a -> b
$
                  String -> IO ByteString
BS.readFile String
fp
     forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> ShelleyGenesisCmdError
ShelleyGenesisCmdAesonDecodeError String
fp forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$
       forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecodeStrict' ByteString
content

-- | This function should only be used for testing purposes.
-- Keys returned by this function are not cryptographically secure.
computeInsecureDelegation
  :: StdGen
  -> NetworkId
  -> Ledger.PoolParams StandardCrypto
  -> IO (StdGen, Delegation)
computeInsecureDelegation :: StdGen
-> NetworkId
-> PoolParams StandardCrypto
-> IO (StdGen, Delegation)
computeInsecureDelegation StdGen
g0 NetworkId
nw PoolParams StandardCrypto
pool = do
    (VerificationKey PaymentKey
paymentVK, StdGen
g1) <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall keyrole.
(Key keyrole, SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> IO (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g0 AsType PaymentKey
AsPaymentKey
    (VerificationKey StakeKey
stakeVK  , StdGen
g2) <- forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall keyrole.
(Key keyrole, SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> IO (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g1 AsType StakeKey
AsStakeKey

    let stakeAddressReference :: StakeAddressReference
stakeAddressReference = StakeCredential -> StakeAddressReference
StakeAddressByValue forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash StakeKey -> StakeCredential
StakeCredentialByKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey
stakeVK
    let initialUtxoAddr :: Address ShelleyAddr
initialUtxoAddr = NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress NetworkId
nw (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
paymentVK)) StakeAddressReference
stakeAddressReference

    Delegation
delegation <- forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. NFData a => a -> a
force Delegation
      { dInitialUtxoAddr :: AddressInEra ShelleyEra
dInitialUtxoAddr = forall era.
IsShelleyBasedEra era =>
Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra Address ShelleyAddr
initialUtxoAddr
      , dDelegStaking :: KeyHash 'Staking StandardCrypto
dDelegStaking = forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
Ledger.hashKey (VerificationKey StakeKey -> VKey 'Staking StandardCrypto
unStakeVerificationKey VerificationKey StakeKey
stakeVK)
      , dPoolParams :: PoolParams StandardCrypto
dPoolParams = PoolParams StandardCrypto
pool
      }

    forall (f :: * -> *) a. Applicative f => a -> f a
pure (StdGen
g2, Delegation
delegation)

-- | Current UTCTime plus 30 seconds
getCurrentTimePlus30 :: ExceptT a IO UTCTime
getCurrentTimePlus30 :: forall a. ExceptT a IO UTCTime
getCurrentTimePlus30 =
    UTCTime -> UTCTime
plus30sec forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
getCurrentTime
  where
    plus30sec :: UTCTime -> UTCTime
    plus30sec :: UTCTime -> UTCTime
plus30sec = NominalDiffTime -> UTCTime -> UTCTime
addUTCTime (NominalDiffTime
30 :: NominalDiffTime)

-- | Attempts to read Shelley genesis from disk
-- and if not found creates a default Shelley genesis.
readShelleyGenesisWithDefault
  :: FilePath
  -> (ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley)
  -> ExceptT ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
readShelleyGenesisWithDefault :: String
-> (ShelleyGenesis StandardShelley
    -> ShelleyGenesis StandardShelley)
-> ExceptT
     ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
readShelleyGenesisWithDefault String
fpath ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustDefaults = do
    forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (String
-> IO
     (Either ShelleyGenesisCmdError (ShelleyGenesis StandardShelley))
readAndDecodeShelleyGenesis String
fpath)
      forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \ShelleyGenesisCmdError
err ->
        case ShelleyGenesisCmdError
err of
          ShelleyGenesisCmdGenesisFileReadError (FileIOError String
_ IOException
ioe)
            | IOException -> Bool
isDoesNotExistError IOException
ioe -> ExceptT ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
writeDefault
          ShelleyGenesisCmdError
_                           -> forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
left ShelleyGenesisCmdError
err
  where
    defaults :: ShelleyGenesis StandardShelley
    defaults :: ShelleyGenesis StandardShelley
defaults = ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustDefaults forall crypto. ShelleyGenesis crypto
shelleyGenesisDefaults

    writeDefault :: ExceptT ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
writeDefault = do
      forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fpath) forall a b. (a -> b) -> a -> b
$
        String -> ByteString -> IO ()
LBS.writeFile String
fpath (forall a. ToJSON a => a -> ByteString
encode ShelleyGenesis StandardShelley
defaults)
      forall (m :: * -> *) a. Monad m => a -> m a
return ShelleyGenesis StandardShelley
defaults

readAndDecodeShelleyGenesis
  :: FilePath
  -> IO (Either ShelleyGenesisCmdError (ShelleyGenesis StandardShelley))
readAndDecodeShelleyGenesis :: String
-> IO
     (Either ShelleyGenesisCmdError (ShelleyGenesis StandardShelley))
readAndDecodeShelleyGenesis String
fpath = forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT forall a b. (a -> b) -> a -> b
$ do
  ByteString
lbs <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError IOException -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileReadError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fpath) forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fpath
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileDecodeError String
fpath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
lbs

updateTemplate
    :: SystemStart  -- ^ System start time
    -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based)
    -> Maybe Lovelace -- ^ Amount of lovelace not delegated
    -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating
    -> Map (Ledger.KeyHash 'Ledger.Staking StandardCrypto) (Ledger.PoolParams StandardCrypto) -- ^ Genesis staking: pools/delegation map & delegated initial UTxO spec
    -> Lovelace -- ^ Number of UTxO Addresses for delegation
    -> [AddressInEra ShelleyEra] -- ^ UTxO Addresses for delegation
    -> [AddressInEra ShelleyEra] -- ^ Stuffed UTxO addresses
    -> ShelleyGenesis StandardShelley -- ^ Template from which to build a genesis
    -> ShelleyGenesis StandardShelley -- ^ Updated genesis
updateTemplate :: SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Lovelace
-> [AddressInEra ShelleyEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Lovelace
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardShelley
-> ShelleyGenesis StandardShelley
updateTemplate (SystemStart UTCTime
start)
               Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap Maybe Lovelace
mAmountNonDeleg [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
               Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs (Lovelace Integer
amountDeleg) [AddressInEra ShelleyEra]
utxoAddrsDeleg [AddressInEra ShelleyEra]
stuffedUtxoAddrs
               ShelleyGenesis StandardShelley
template = do

    let pparamsFromTemplate :: ShelleyPParams StandardShelley
pparamsFromTemplate = forall era. ShelleyGenesis era -> ShelleyPParams era
sgProtocolParams ShelleyGenesis StandardShelley
template
        shelleyGenesis :: ShelleyGenesis StandardShelley
shelleyGenesis = ShelleyGenesis StandardShelley
template
          { sgSystemStart :: UTCTime
sgSystemStart = UTCTime
start
          , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
nonDelegCoin forall a. Num a => a -> a -> a
+ Integer
delegCoin
          , sgGenDelegs :: Map
  (KeyHash 'Genesis (Crypto StandardShelley))
  (GenDelegPair (Crypto StandardShelley))
sgGenDelegs = Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys
          , sgInitialFunds :: ListMap (Addr (Crypto StandardShelley)) Coin
sgInitialFunds = forall k v. [(k, v)] -> ListMap k v
ListMap.fromList
                              [ (forall era. AddressInEra era -> Addr StandardCrypto
toShelleyAddr AddressInEra ShelleyEra
addr, Lovelace -> Coin
toShelleyLovelace Lovelace
v)
                              | (AddressInEra ShelleyEra
addr, Lovelace
v) <-
                                Integer
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Lovelace)]
distribute (Integer
nonDelegCoin forall a. Num a => a -> a -> a
- Integer
subtractForTreasury) [AddressInEra ShelleyEra]
utxoAddrsNonDeleg forall a. [a] -> [a] -> [a]
++
                                Integer
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Lovelace)]
distribute (Integer
delegCoin forall a. Num a => a -> a -> a
- Integer
subtractForTreasury)    [AddressInEra ShelleyEra]
utxoAddrsDeleg forall a. [a] -> [a] -> [a]
++
                                [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
mkStuffedUtxo [AddressInEra ShelleyEra]
stuffedUtxoAddrs ]
          , sgStaking :: ShelleyGenesisStaking (Crypto StandardShelley)
sgStaking =
            ShelleyGenesisStaking
              { sgsPools :: ListMap
  (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
sgsPools = forall k v. [(k, v)] -> ListMap k v
ListMap.fromList
                            [ (forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Ledger._poolId PoolParams StandardCrypto
poolParams, PoolParams StandardCrypto
poolParams)
                            | PoolParams StandardCrypto
poolParams <- forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs ]
              , sgsStake :: ListMap
  (KeyHash 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
sgsStake = forall k v. Map k v -> ListMap k v
ListMap.fromMap forall a b. (a -> b) -> a -> b
$ forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Ledger._poolId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs
              }
          , sgProtocolParams :: ShelleyPParams StandardShelley
sgProtocolParams = ShelleyPParams StandardShelley
pparamsFromTemplate
          }
    ShelleyGenesis StandardShelley
shelleyGenesis
  where
    maximumLovelaceSupply :: Word64
    maximumLovelaceSupply :: Word64
maximumLovelaceSupply = forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis StandardShelley
template
    -- If the initial funds are equal to the maximum funds, rewards cannot be created.
    subtractForTreasury :: Integer
    subtractForTreasury :: Integer
subtractForTreasury = Integer
nonDelegCoin forall a. Integral a => a -> a -> a
`quot` Integer
10
    nonDelegCoin, delegCoin :: Integer
    nonDelegCoin :: Integer
nonDelegCoin = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
maximumLovelaceSupply forall a. Integral a => Lovelace -> a
unLovelace Maybe Lovelace
mAmountNonDeleg)
    delegCoin :: Integer
delegCoin = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
amountDeleg

    distribute :: Integer -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
    distribute :: Integer
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Lovelace)]
distribute Integer
funds [AddressInEra ShelleyEra]
addrs =
      forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ([(AddressInEra ShelleyEra, Lovelace)], Integer)
-> AddressInEra ShelleyEra
-> ([(AddressInEra ShelleyEra, Lovelace)], Integer)
folder ([], forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
funds) [AddressInEra ShelleyEra]
addrs
     where
       nAddrs, coinPerAddr, splitThreshold :: Integer
       nAddrs :: Integer
nAddrs = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [AddressInEra ShelleyEra]
addrs
       coinPerAddr :: Integer
coinPerAddr = Integer
funds forall a. Integral a => a -> a -> a
`div` Integer
nAddrs
       splitThreshold :: Integer
splitThreshold = Integer
coinPerAddr forall a. Num a => a -> a -> a
+ Integer
nAddrs

       folder :: ([(AddressInEra ShelleyEra, Lovelace)], Integer)
              -> AddressInEra ShelleyEra
              -> ([(AddressInEra ShelleyEra, Lovelace)], Integer)
       folder :: ([(AddressInEra ShelleyEra, Lovelace)], Integer)
-> AddressInEra ShelleyEra
-> ([(AddressInEra ShelleyEra, Lovelace)], Integer)
folder ([(AddressInEra ShelleyEra, Lovelace)]
acc, Integer
rest) AddressInEra ShelleyEra
addr
         | Integer
rest forall a. Ord a => a -> a -> Bool
> Integer
splitThreshold =
             ((AddressInEra ShelleyEra
addr, Integer -> Lovelace
Lovelace Integer
coinPerAddr) forall a. a -> [a] -> [a]
: [(AddressInEra ShelleyEra, Lovelace)]
acc, Integer
rest forall a. Num a => a -> a -> a
- Integer
coinPerAddr)
         | Bool
otherwise = ((AddressInEra ShelleyEra
addr, Integer -> Lovelace
Lovelace Integer
rest) forall a. a -> [a] -> [a]
: [(AddressInEra ShelleyEra, Lovelace)]
acc, Integer
0)

    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
mkStuffedUtxo [AddressInEra ShelleyEra]
xs = (, Integer -> Lovelace
Lovelace Integer
minUtxoVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddressInEra ShelleyEra]
xs
      where Coin Integer
minUtxoVal = forall (f :: * -> *) era. ShelleyPParamsHKD f era -> HKD f Coin
Shelley._minUTxOValue forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGenesis era -> ShelleyPParams era
sgProtocolParams ShelleyGenesis StandardShelley
template

    shelleyDelKeys :: Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys =
      forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (KeyHash 'Genesis StandardCrypto
gh, forall crypto.
KeyHash 'GenesisDelegate crypto
-> Hash crypto (VerKeyVRF crypto) -> GenDelegPair crypto
Ledger.GenDelegPair KeyHash 'GenesisDelegate StandardCrypto
gdh Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
        | (GenesisKeyHash KeyHash 'Genesis StandardCrypto
gh,
           (GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
gdh, VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
        ]

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

updateCreateStakedOutputTemplate
    :: SystemStart -- ^ System start time
    -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based)
    -> Maybe Lovelace -- ^ Amount of lovelace not delegated
    -> Int -- ^ Number of UTxO addresses that are delegating
    -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating
    -> [(Ledger.KeyHash 'Ledger.StakePool StandardCrypto, Ledger.PoolParams StandardCrypto)] -- ^ Pool map
    -> [(Ledger.KeyHash 'Ledger.Staking StandardCrypto, Ledger.KeyHash 'Ledger.StakePool StandardCrypto)] -- ^ Delegaton map
    -> Lovelace -- ^ Amount of lovelace to delegate
    -> Int -- ^ Number of UTxO address for delegationg
    -> [AddressInEra ShelleyEra] -- ^ UTxO address for delegationg
    -> [AddressInEra ShelleyEra] -- ^ Stuffed UTxO addresses
    -> ShelleyGenesis StandardShelley -- ^ Template from which to build a genesis
    -> ShelleyGenesis StandardShelley -- ^ Updated genesis
updateCreateStakedOutputTemplate :: SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Lovelace
-> Int
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
-> Lovelace
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardShelley
-> ShelleyGenesis StandardShelley
updateCreateStakedOutputTemplate
  (SystemStart UTCTime
start)
  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap Maybe Lovelace
mAmountNonDeleg Int
nUtxoAddrsNonDeleg [AddressInEra ShelleyEra]
utxoAddrsNonDeleg [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
pools [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake
  (Lovelace Integer
amountDeleg)
  Int
nUtxoAddrsDeleg [AddressInEra ShelleyEra]
utxoAddrsDeleg [AddressInEra ShelleyEra]
stuffedUtxoAddrs
  ShelleyGenesis StandardShelley
template = do
    let pparamsFromTemplate :: ShelleyPParams StandardShelley
pparamsFromTemplate = forall era. ShelleyGenesis era -> ShelleyPParams era
sgProtocolParams ShelleyGenesis StandardShelley
template
        shelleyGenesis :: ShelleyGenesis StandardShelley
shelleyGenesis = ShelleyGenesis StandardShelley
template
          { sgSystemStart :: UTCTime
sgSystemStart = UTCTime
start
          , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Integer
nonDelegCoin forall a. Num a => a -> a -> a
+ Integer
delegCoin
          , sgGenDelegs :: Map
  (KeyHash 'Genesis (Crypto StandardShelley))
  (GenDelegPair (Crypto StandardShelley))
sgGenDelegs = Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys
          , sgInitialFunds :: ListMap (Addr (Crypto StandardShelley)) Coin
sgInitialFunds = forall k v. [(k, v)] -> ListMap k v
ListMap.fromList
                              [ (forall era. AddressInEra era -> Addr StandardCrypto
toShelleyAddr AddressInEra ShelleyEra
addr, Lovelace -> Coin
toShelleyLovelace Lovelace
v)
                              | (AddressInEra ShelleyEra
addr, Lovelace
v) <-
                                Integer
-> Int
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Lovelace)]
distribute (Integer
nonDelegCoin forall a. Num a => a -> a -> a
- Integer
subtractForTreasury) Int
nUtxoAddrsNonDeleg  [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
                                forall a. [a] -> [a] -> [a]
++
                                Integer
-> Int
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Lovelace)]
distribute (Integer
delegCoin forall a. Num a => a -> a -> a
- Integer
subtractForTreasury)    Int
nUtxoAddrsDeleg     [AddressInEra ShelleyEra]
utxoAddrsDeleg
                                forall a. [a] -> [a] -> [a]
++
                                [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
mkStuffedUtxo [AddressInEra ShelleyEra]
stuffedUtxoAddrs
                                ]
          , sgStaking :: ShelleyGenesisStaking (Crypto StandardShelley)
sgStaking =
            ShelleyGenesisStaking
              { sgsPools :: ListMap
  (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
sgsPools = forall k v. [(k, v)] -> ListMap k v
ListMap [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
pools
              , sgsStake :: ListMap
  (KeyHash 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
sgsStake = forall k v. [(k, v)] -> ListMap k v
ListMap [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake
              }
          , sgProtocolParams :: ShelleyPParams StandardShelley
sgProtocolParams = ShelleyPParams StandardShelley
pparamsFromTemplate
          }
    ShelleyGenesis StandardShelley
shelleyGenesis
  where
    maximumLovelaceSupply :: Word64
    maximumLovelaceSupply :: Word64
maximumLovelaceSupply = forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis StandardShelley
template
    -- If the initial funds are equal to the maximum funds, rewards cannot be created.
    subtractForTreasury :: Integer
    subtractForTreasury :: Integer
subtractForTreasury = Integer
nonDelegCoin forall a. Integral a => a -> a -> a
`quot` Integer
10
    nonDelegCoin, delegCoin :: Integer
    nonDelegCoin :: Integer
nonDelegCoin = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
maximumLovelaceSupply forall a. Integral a => Lovelace -> a
unLovelace Maybe Lovelace
mAmountNonDeleg)
    delegCoin :: Integer
delegCoin = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
amountDeleg

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

    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
mkStuffedUtxo [AddressInEra ShelleyEra]
xs = (, Integer -> Lovelace
Lovelace Integer
minUtxoVal) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddressInEra ShelleyEra]
xs
      where Coin Integer
minUtxoVal = forall (f :: * -> *) era. ShelleyPParamsHKD f era -> HKD f Coin
Shelley._minUTxOValue forall a b. (a -> b) -> a -> b
$ forall era. ShelleyGenesis era -> ShelleyPParams era
sgProtocolParams ShelleyGenesis StandardShelley
template

    shelleyDelKeys :: Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      [ (KeyHash 'Genesis StandardCrypto
gh, forall crypto.
KeyHash 'GenesisDelegate crypto
-> Hash crypto (VerKeyVRF crypto) -> GenDelegPair crypto
Ledger.GenDelegPair KeyHash 'GenesisDelegate StandardCrypto
gdh Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
      | (GenesisKeyHash KeyHash 'Genesis StandardCrypto
gh,
          (GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
gdh, VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)) <- forall k a. Map k a -> [(k, a)]
Map.toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
      ]

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

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

-- ----------------------------------------------------------------------------

readGenDelegsMap :: FilePath -> FilePath
                 -> ExceptT ShelleyGenesisCmdError IO
                            (Map (Hash GenesisKey)
                                 (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap :: String
-> String
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap String
gendir String
deldir = do
    Map Int (VerificationKey GenesisKey)
gkm <- String
-> ExceptT
     ShelleyGenesisCmdError IO (Map Int (VerificationKey GenesisKey))
readGenesisKeys String
gendir
    Map Int (VerificationKey GenesisDelegateKey)
dkm <- String
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys String
deldir
    Map Int (VerificationKey VrfKey)
vkm <- String
-> ExceptT
     ShelleyGenesisCmdError IO (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys String
deldir

    let combinedMap :: Map Int (VerificationKey GenesisKey,
                                (VerificationKey GenesisDelegateKey,
                                 VerificationKey VrfKey))
        combinedMap :: Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap =
          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
            (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 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 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 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
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey GenesisKey)
gkmExtra Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey GenesisDelegateKey)
dkmExtra Bool -> Bool -> Bool
&& forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey VrfKey)
vkmExtra) forall a b. (a -> b) -> a -> b
$
      forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int] -> ShelleyGenesisCmdError
ShelleyGenesisCmdMismatchedGenesisKeyFiles
                     (forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisKey)
gkm) (forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisDelegateKey)
dkm) (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 =
          forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Hash GenesisKey
gh, (Hash GenesisDelegateKey
dh, Hash VrfKey
vh))
                       | (VerificationKey GenesisKey
g,(VerificationKey GenesisDelegateKey
d,VerificationKey VrfKey
v)) <- forall k a. Map k a -> [a]
Map.elems Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
                       , let gh :: Hash GenesisKey
gh = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisKey
g
                             dh :: Hash GenesisDelegateKey
dh = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisDelegateKey
d
                             vh :: Hash VrfKey
vh = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VrfKey
v
                       ]

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


readGenesisKeys :: FilePath -> ExceptT ShelleyGenesisCmdError IO
                                       (Map Int (VerificationKey GenesisKey))
readGenesisKeys :: String
-> ExceptT
     ShelleyGenesisCmdError IO (Map Int (VerificationKey GenesisKey))
readGenesisKeys String
gendir = do
  [String]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
gendir)
  [(String, Int)]
fileIxs <- [String] -> ExceptT ShelleyGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [ String
gendir String -> ShowS
</> String
file
                                    | String
file <- [String]
files
                                    , ShowS
takeExtension String
file forall a. Eq a => a -> a -> Bool
== String
".vkey" ]
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ (,) Int
ix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
readKey String
file
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs ]
  where
    readKey :: String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
readKey = forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
              forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey)

readDelegateKeys :: FilePath
                 -> ExceptT ShelleyGenesisCmdError IO
                            (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys :: String
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys String
deldir = do
  [String]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
deldir)
  [(String, Int)]
fileIxs <- [String] -> ExceptT ShelleyGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [ String
deldir String -> ShowS
</> String
file
                                    | String
file <- [String]
files
                                    , ShowS
takeExtensions String
file forall a. Eq a => a -> a -> Bool
== String
".vkey" ]
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ (,) Int
ix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
readKey String
file
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs ]
  where
    readKey :: String
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
readKey = forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey)

readDelegateVrfKeys :: FilePath -> ExceptT ShelleyGenesisCmdError IO
                                           (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys :: String
-> ExceptT
     ShelleyGenesisCmdError IO (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys String
deldir = do
  [String]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
deldir)
  [(String, Int)]
fileIxs <- [String] -> ExceptT ShelleyGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [ String
deldir String -> ShowS
</> String
file
                                    | String
file <- [String]
files
                                    , ShowS
takeExtensions String
file forall a. Eq a => a -> a -> Bool
== String
".vrf.vkey" ]
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError forall a b. (a -> b) -> a -> b
$
    forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
        [ (,) Int
ix forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
readKey String
file
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs ]
  where
    readKey :: String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
readKey = forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey)


-- | The file path is of the form @"delegate-keys/delegate3.vkey"@.
-- This function reads the file and extracts the index (in this case 3).
--
extractFileNameIndex :: FilePath -> Maybe Int
extractFileNameIndex :: String -> Maybe Int
extractFileNameIndex String
fp =
  case forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit String
fp of
    [] -> forall a. Maybe a
Nothing
    String
xs -> forall a. Read a => String -> Maybe a
readMaybe String
xs

extractFileNameIndexes :: [FilePath]
                       -> ExceptT ShelleyGenesisCmdError IO [(FilePath, Int)]
extractFileNameIndexes :: [String] -> ExceptT ShelleyGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [String]
files = do
    case [ String
file | (String
file, Maybe Int
Nothing) <- [(String, Maybe Int)]
filesIxs ] of
      []     -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [String]
files' -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([String] -> ShelleyGenesisCmdError
ShelleyGenesisCmdFilesNoIndex [String]
files')
    case forall a. (a -> Bool) -> [a] -> [a]
filter (\[(String, Int)]
g -> forall (t :: * -> *) a. Foldable t => t a -> Int
length [(String, Int)]
g forall a. Ord a => a -> a -> Bool
> Int
1)
       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Bool) -> [a] -> [[a]]
List.groupBy (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd)
       forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
List.sortBy (forall a. Ord a => a -> a -> Ordering
compare forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a, b) -> b
snd)
       forall a b. (a -> b) -> a -> b
$ [ (String
file, Int
ix) | (String
file, Just Int
ix) <- [(String, Maybe Int)]
filesIxs ] of
      [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ([(String, Int)]
g:[[(String, Int)]]
_) -> forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([String] -> ShelleyGenesisCmdError
ShelleyGenesisCmdFilesDupIndex (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(String, Int)]
g))

    forall (m :: * -> *) a. Monad m => a -> m a
return [ (String
file, Int
ix) | (String
file, Just Int
ix) <- [(String, Maybe Int)]
filesIxs ]
  where
    filesIxs :: [(String, Maybe Int)]
filesIxs = [ (String
file, String -> Maybe Int
extractFileNameIndex String
file) | String
file <- [String]
files ]

readInitialFundAddresses :: FilePath -> NetworkId
                         -> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses :: String
-> NetworkId
-> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses String
utxodir NetworkId
nw = do
    [String]
files <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
utxodir)
    [VerificationKey GenesisUTxOKey]
vkeys <- forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError forall a b. (a -> b) -> a -> b
$
               forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                 [ forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT forall a b. (a -> b) -> a -> b
$
                     forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
                                          (String
utxodir String -> ShowS
</> String
file)
                 | String
file <- [String]
files
                 , ShowS
takeExtension String
file forall a. Eq a => a -> a -> Bool
== String
".vkey" ]
    forall (m :: * -> *) a. Monad m => a -> m a
return [ AddressInEra ShelleyEra
addr | VerificationKey GenesisUTxOKey
vkey <- [VerificationKey GenesisUTxOKey]
vkeys
           , let vkh :: Hash PaymentKey
vkh  = forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisUTxOKey
vkey)
                 addr :: AddressInEra ShelleyEra
addr = forall era.
IsShelleyBasedEra era =>
NetworkId
-> PaymentCredential -> StakeAddressReference -> AddressInEra era
makeShelleyAddressInEra NetworkId
nw (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
                                                StakeAddressReference
NoStakeAddress
           ]


-- | Hash a genesis file
runGenesisHashFile :: GenesisFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisHashFile :: GenesisFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisHashFile (GenesisFile String
fpath) = do
   ByteString
content <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fpath) forall a b. (a -> b) -> a -> b
$
              String -> IO ByteString
BS.readFile String
fpath
   let gh :: Crypto.Hash Crypto.Blake2b_256 ByteString
       gh :: Hash Blake2b_256 ByteString
gh = forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith forall a. a -> a
id ByteString
content
   forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (forall h a. Hash h a -> Text
Crypto.hashToTextAsHex Hash Blake2b_256 ByteString
gh)

readAlonzoGenesis
  :: FilePath
  -> ExceptT ShelleyGenesisCmdError IO Alonzo.AlonzoGenesis
readAlonzoGenesis :: String -> ExceptT ShelleyGenesisCmdError IO AlonzoGenesis
readAlonzoGenesis String
fpath = do
  ByteString
lbs <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fpath) forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fpath
  forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> ShelleyGenesisCmdError
ShelleyGenesisCmdAesonDecodeError String
fpath forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
lbs

readConwayGenesis
  :: FilePath
  -> ExceptT ShelleyGenesisCmdError IO (Conway.ConwayGenesis StandardCrypto)
readConwayGenesis :: String
-> ExceptT ShelleyGenesisCmdError IO (ConwayGenesis StandardCrypto)
readConwayGenesis String
fpath = do
  ByteString
lbs <- forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e. String -> IOException -> FileError e
FileIOError String
fpath) forall a b. (a -> b) -> a -> b
$