{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

module Cardano.CLI.EraBased.Run.Genesis
  ( runGenesisCmds
  , runGenesisAddrCmd
  , runGenesisCreateCardanoCmd
  , runGenesisCreateCmd
  , runGenesisCreateStakedCmd
  , runGenesisHashFileCmd
  , runGenesisKeyHashCmd
  , runGenesisTxInCmd
  , runGenesisVerKeyCmd
  )
where

import           Cardano.Api
import           Cardano.Api.Byron (toByronLovelace, toByronProtocolMagicId,
                   toByronRequiresNetworkMagic)
import qualified Cardano.Api.Byron as Byron hiding (GenesisParameters, SigningKey)
import           Cardano.Api.Consensus (ShelleyGenesisStaking (..))
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Shelley

import           Cardano.CLI.Byron.Delegation
import           Cardano.CLI.Byron.Genesis as Byron
import qualified Cardano.CLI.Byron.Key as Byron
import qualified Cardano.CLI.Commands.Node as Cmd
import           Cardano.CLI.EraBased.Commands.Genesis as Cmd
import           Cardano.CLI.EraBased.Run.Genesis.Common
import           Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData (WriteFileGenesis (..))
import qualified Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData as TN
import           Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd)
import qualified Cardano.CLI.IO.Lazy as Lazy
import           Cardano.CLI.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd,
                   runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd)
import           Cardano.CLI.Types.Common
import           Cardano.CLI.Types.Errors.GenesisCmdError
import           Cardano.CLI.Types.Errors.NodeCmdError
import           Cardano.CLI.Types.Errors.StakePoolCmdError
import           Cardano.CLI.Types.Key
import qualified Cardano.Crypto as CC
import qualified Cardano.Crypto.Hash as Crypto
import qualified Cardano.Crypto.Signing as Byron
import           Cardano.Slotting.Slot (EpochSize (EpochSize))

import           Control.DeepSeq (NFData, force)
import           Control.Exception (evaluate)
import           Control.Monad (forM, forM_, unless, when)
import           Data.Aeson hiding (Key)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as Aeson
import           Data.Bifunctor (Bifunctor (..))
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.Fixed (Fixed (MkFixed))
import           Data.Function (on)
import           Data.Functor (void)
import qualified Data.List as List
import qualified Data.List.Split as List
import           Data.ListMap (ListMap (..))
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.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import           Data.Word (Word64)
import qualified Data.Yaml as Yaml
import           GHC.Exts (IsList (..))
import           GHC.Generics (Generic)
import           Lens.Micro ((^.))
import           System.Directory (createDirectoryIfMissing, listDirectory)
import           System.FilePath (takeExtension, takeExtensions, (</>))
import qualified System.IO as IO
import           System.IO.Error (isDoesNotExistError)
import qualified System.Random as Random
import           System.Random (StdGen)
import           Text.Read (readMaybe)

runGenesisCmds :: GenesisCmds era -> ExceptT GenesisCmdError IO ()
runGenesisCmds :: forall era. GenesisCmds era -> ExceptT GenesisCmdError IO ()
runGenesisCmds = \case
  GenesisKeyGenGenesis GenesisKeyGenGenesisCmdArgs
args -> GenesisKeyGenGenesisCmdArgs -> ExceptT GenesisCmdError IO ()
TN.runGenesisKeyGenGenesisCmd GenesisKeyGenGenesisCmdArgs
args
  GenesisKeyGenDelegate GenesisKeyGenDelegateCmdArgs
args -> GenesisKeyGenDelegateCmdArgs -> ExceptT GenesisCmdError IO ()
TN.runGenesisKeyGenDelegateCmd GenesisKeyGenDelegateCmdArgs
args
  GenesisKeyGenUTxO GenesisKeyGenUTxOCmdArgs
args -> GenesisKeyGenUTxOCmdArgs -> ExceptT GenesisCmdError IO ()
TN.runGenesisKeyGenUTxOCmd GenesisKeyGenUTxOCmdArgs
args
  GenesisCmdKeyHash VerificationKeyFile 'In
vk -> VerificationKeyFile 'In -> ExceptT GenesisCmdError IO ()
runGenesisKeyHashCmd VerificationKeyFile 'In
vk
  GenesisVerKey GenesisVerKeyCmdArgs
args -> GenesisVerKeyCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisVerKeyCmd GenesisVerKeyCmdArgs
args
  GenesisTxIn GenesisTxInCmdArgs
args -> GenesisTxInCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisTxInCmd GenesisTxInCmdArgs
args
  GenesisAddr GenesisAddrCmdArgs
args -> GenesisAddrCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisAddrCmd GenesisAddrCmdArgs
args
  GenesisCreate GenesisCreateCmdArgs era
args -> GenesisCreateCmdArgs era -> ExceptT GenesisCmdError IO ()
forall era.
GenesisCreateCmdArgs era -> ExceptT GenesisCmdError IO ()
runGenesisCreateCmd GenesisCreateCmdArgs era
args
  GenesisCreateCardano GenesisCreateCardanoCmdArgs era
args -> GenesisCreateCardanoCmdArgs era -> ExceptT GenesisCmdError IO ()
forall era.
GenesisCreateCardanoCmdArgs era -> ExceptT GenesisCmdError IO ()
runGenesisCreateCardanoCmd GenesisCreateCardanoCmdArgs era
args
  GenesisCreateStaked GenesisCreateStakedCmdArgs era
args -> GenesisCreateStakedCmdArgs era -> ExceptT GenesisCmdError IO ()
forall era.
GenesisCreateStakedCmdArgs era -> ExceptT GenesisCmdError IO ()
runGenesisCreateStakedCmd GenesisCreateStakedCmdArgs era
args
  GenesisCreateTestNetData GenesisCreateTestNetDataCmdArgs
args -> GenesisCreateTestNetDataCmdArgs -> ExceptT GenesisCmdError IO ()
TN.runGenesisCreateTestNetDataCmd GenesisCreateTestNetDataCmdArgs
args
  GenesisHashFile GenesisFile
gf -> GenesisFile -> ExceptT GenesisCmdError IO ()
runGenesisHashFileCmd GenesisFile
gf

runGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT GenesisCmdError IO ()
runGenesisKeyHashCmd :: VerificationKeyFile 'In -> ExceptT GenesisCmdError IO ()
runGenesisKeyHashCmd VerificationKeyFile 'In
vkeyPath = do
  SomeGenesisKey VerificationKey
vkey <-
    (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (SomeGenesisKey VerificationKey)
-> ExceptT GenesisCmdError IO (SomeGenesisKey VerificationKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (SomeGenesisKey VerificationKey)
 -> ExceptT GenesisCmdError IO (SomeGenesisKey VerificationKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (SomeGenesisKey VerificationKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
-> ExceptT GenesisCmdError IO (SomeGenesisKey VerificationKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either
     (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (SomeGenesisKey VerificationKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
 -> ExceptT GenesisCmdError IO (SomeGenesisKey VerificationKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
-> ExceptT GenesisCmdError IO (SomeGenesisKey VerificationKey)
forall a b. (a -> b) -> a -> b
$
      [FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)]
-> VerificationKeyFile 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
forall b content.
[FromSomeType HasTextEnvelope b]
-> File content 'In -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
        [ AsType (VerificationKey GenesisKey)
-> (VerificationKey GenesisKey -> SomeGenesisKey VerificationKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
            (AsType GenesisKey -> AsType (VerificationKey GenesisKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey)
            VerificationKey GenesisKey -> SomeGenesisKey VerificationKey
forall (f :: * -> *). f GenesisKey -> SomeGenesisKey f
AGenesisKey
        , AsType (VerificationKey GenesisDelegateKey)
-> (VerificationKey GenesisDelegateKey
    -> SomeGenesisKey VerificationKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
            (AsType GenesisDelegateKey
-> AsType (VerificationKey GenesisDelegateKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
            VerificationKey GenesisDelegateKey
-> SomeGenesisKey VerificationKey
forall (f :: * -> *). f GenesisDelegateKey -> SomeGenesisKey f
AGenesisDelegateKey
        , AsType (VerificationKey GenesisUTxOKey)
-> (VerificationKey GenesisUTxOKey
    -> SomeGenesisKey VerificationKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
            (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
            VerificationKey GenesisUTxOKey -> SomeGenesisKey VerificationKey
forall (f :: * -> *). f GenesisUTxOKey -> SomeGenesisKey f
AGenesisUTxOKey
        ]
        VerificationKeyFile 'In
vkeyPath
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ 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) = VerificationKey GenesisKey -> ByteString
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash VerificationKey GenesisKey
vk
  renderKeyHash (AGenesisDelegateKey VerificationKey GenesisDelegateKey
vk) = VerificationKey GenesisDelegateKey -> ByteString
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash VerificationKey GenesisDelegateKey
vk
  renderKeyHash (AGenesisUTxOKey VerificationKey GenesisUTxOKey
vk) = VerificationKey GenesisUTxOKey -> ByteString
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 =
    Hash keyrole -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex
      (Hash keyrole -> ByteString)
-> (VerificationKey keyrole -> Hash keyrole)
-> VerificationKey keyrole
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey keyrole -> Hash keyrole
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash

runGenesisVerKeyCmd
  :: GenesisVerKeyCmdArgs
  -> ExceptT GenesisCmdError IO ()
runGenesisVerKeyCmd :: GenesisVerKeyCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisVerKeyCmd
  Cmd.GenesisVerKeyCmdArgs
    { VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisVerKeyCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
    , SigningKeyFile 'In
signingKeyPath :: SigningKeyFile 'In
signingKeyPath :: GenesisVerKeyCmdArgs -> SigningKeyFile 'In
Cmd.signingKeyPath
    } = do
    SomeGenesisKey SigningKey
skey <-
      (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (SomeGenesisKey SigningKey)
-> ExceptT GenesisCmdError IO (SomeGenesisKey SigningKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (SomeGenesisKey SigningKey)
 -> ExceptT GenesisCmdError IO (SomeGenesisKey SigningKey))
-> (IO
      (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (SomeGenesisKey SigningKey))
-> IO
     (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
-> ExceptT GenesisCmdError IO (SomeGenesisKey SigningKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (SomeGenesisKey SigningKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
 -> ExceptT GenesisCmdError IO (SomeGenesisKey SigningKey))
-> IO
     (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
-> ExceptT GenesisCmdError IO (SomeGenesisKey SigningKey)
forall a b. (a -> b) -> a -> b
$
        [FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)]
-> SigningKeyFile 'In
-> IO
     (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
forall b content.
[FromSomeType HasTextEnvelope b]
-> File content 'In -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
          [ AsType (SigningKey GenesisKey)
-> (SigningKey GenesisKey -> SomeGenesisKey SigningKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
              (AsType GenesisKey -> AsType (SigningKey GenesisKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisKey
AsGenesisKey)
              SigningKey GenesisKey -> SomeGenesisKey SigningKey
forall (f :: * -> *). f GenesisKey -> SomeGenesisKey f
AGenesisKey
          , AsType (SigningKey GenesisDelegateKey)
-> (SigningKey GenesisDelegateKey -> SomeGenesisKey SigningKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
              (AsType GenesisDelegateKey -> AsType (SigningKey GenesisDelegateKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
              SigningKey GenesisDelegateKey -> SomeGenesisKey SigningKey
forall (f :: * -> *). f GenesisDelegateKey -> SomeGenesisKey f
AGenesisDelegateKey
          , AsType (SigningKey GenesisUTxOKey)
-> (SigningKey GenesisUTxOKey -> SomeGenesisKey SigningKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
              (AsType GenesisUTxOKey -> AsType (SigningKey GenesisUTxOKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
              SigningKey GenesisUTxOKey -> SomeGenesisKey SigningKey
forall (f :: * -> *). f GenesisUTxOKey -> SomeGenesisKey f
AGenesisUTxOKey
          ]
          SigningKeyFile 'In
signingKeyPath

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

    (FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdGenesisFileError (ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GenesisCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> (IO (Either (FileError ()) ()) -> IO (Either (FileError ()) ()))
-> IO (Either (FileError ()) ())
-> ExceptT (FileError ()) IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> IO (Either (FileError ()) ())
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      case SomeGenesisKey VerificationKey
vkey of
        AGenesisKey VerificationKey GenesisKey
vk -> VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> VerificationKey GenesisKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing VerificationKey GenesisKey
vk
        AGenesisDelegateKey VerificationKey GenesisDelegateKey
vk -> VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr
-> VerificationKey GenesisDelegateKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing VerificationKey GenesisDelegateKey
vk
        AGenesisUTxOKey VerificationKey GenesisUTxOKey
vk -> VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr
-> VerificationKey GenesisUTxOKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing VerificationKey GenesisUTxOKey
vk

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

runGenesisTxInCmd
  :: GenesisTxInCmdArgs
  -> ExceptT GenesisCmdError IO ()
runGenesisTxInCmd :: GenesisTxInCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisTxInCmd
  Cmd.GenesisTxInCmdArgs
    { VerificationKeyFile 'In
verificationKeyPath :: VerificationKeyFile 'In
verificationKeyPath :: GenesisTxInCmdArgs -> VerificationKeyFile 'In
Cmd.verificationKeyPath
    , NetworkId
network :: NetworkId
network :: GenesisTxInCmdArgs -> NetworkId
Cmd.network
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: GenesisTxInCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    VerificationKey GenesisUTxOKey
vkey <-
      (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
-> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
 -> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
 -> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
        AsType (VerificationKey GenesisUTxOKey)
-> VerificationKeyFile 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey) VerificationKeyFile 'In
verificationKeyPath
    let txin :: TxIn
txin = NetworkId -> Hash GenesisUTxOKey -> TxIn
genesisUTxOPseudoTxIn NetworkId
network (VerificationKey GenesisUTxOKey -> Hash GenesisUTxOKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisUTxOKey
vkey)
    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> Text -> IO ()
writeOutput Maybe (File () 'Out)
mOutFile (TxIn -> Text
renderTxIn TxIn
txin)

runGenesisAddrCmd
  :: GenesisAddrCmdArgs
  -> ExceptT GenesisCmdError IO ()
runGenesisAddrCmd :: GenesisAddrCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisAddrCmd
  Cmd.GenesisAddrCmdArgs
    { VerificationKeyFile 'In
verificationKeyPath :: VerificationKeyFile 'In
verificationKeyPath :: GenesisAddrCmdArgs -> VerificationKeyFile 'In
Cmd.verificationKeyPath
    , NetworkId
network :: NetworkId
network :: GenesisAddrCmdArgs -> NetworkId
Cmd.network
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: GenesisAddrCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    VerificationKey GenesisUTxOKey
vkey <-
      (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
-> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
 -> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
 -> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT GenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
        AsType (VerificationKey GenesisUTxOKey)
-> VerificationKeyFile 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey) VerificationKeyFile 'In
verificationKeyPath
    let vkh :: Hash PaymentKey
vkh = VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey GenesisUTxOKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisUTxOKey
vkey)
        addr :: Address ShelleyAddr
addr =
          NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress
            NetworkId
network
            (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
            StakeAddressReference
NoStakeAddress
    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe (File () 'Out) -> Text -> IO ()
writeOutput Maybe (File () 'Out)
mOutFile (Address ShelleyAddr -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address ShelleyAddr
addr)

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

--
-- Create Genesis command implementation
--

runGenesisCreateCmd
  :: GenesisCreateCmdArgs era
  -> ExceptT GenesisCmdError IO ()
runGenesisCreateCmd :: forall era.
GenesisCreateCmdArgs era -> ExceptT GenesisCmdError IO ()
runGenesisCreateCmd
  Cmd.GenesisCreateCmdArgs
    { ShelleyBasedEra era
eon :: ShelleyBasedEra era
eon :: forall era. GenesisCreateCmdArgs era -> ShelleyBasedEra era
Cmd.eon
    , KeyOutputFormat
keyOutputFormat :: KeyOutputFormat
keyOutputFormat :: forall era. GenesisCreateCmdArgs era -> KeyOutputFormat
Cmd.keyOutputFormat
    , GenesisDir
genesisDir :: GenesisDir
genesisDir :: forall era. GenesisCreateCmdArgs era -> GenesisDir
Cmd.genesisDir
    , Word
numGenesisKeys :: Word
numGenesisKeys :: forall era. GenesisCreateCmdArgs era -> Word
Cmd.numGenesisKeys
    , Word
numUTxOKeys :: Word
numUTxOKeys :: forall era. GenesisCreateCmdArgs era -> Word
Cmd.numUTxOKeys
    , Maybe SystemStart
mSystemStart :: Maybe SystemStart
mSystemStart :: forall era. GenesisCreateCmdArgs era -> Maybe SystemStart
Cmd.mSystemStart
    , Maybe Coin
mSupply :: Maybe Coin
mSupply :: forall era. GenesisCreateCmdArgs era -> Maybe Coin
Cmd.mSupply
    , NetworkId
network :: NetworkId
network :: forall era. GenesisCreateCmdArgs era -> NetworkId
Cmd.network
    } = do
    let GenesisDir String
rootdir = GenesisDir
genesisDir
        gendir :: String
gendir = String
rootdir String -> String -> String
</> String
"genesis-keys"
        deldir :: String
deldir = String
rootdir String -> String -> String
</> String
"delegate-keys"
        utxodir :: String
utxodir = String
rootdir String -> String -> String
</> String
"utxo-keys"
        era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
eon
    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ 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 StandardCrypto
template <- String
-> (ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto)
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
decodeShelleyGenesisWithDefault (String
rootdir String -> String -> String
</> String
"genesis.spec.json") ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto
adjustTemplate
    AlonzoGenesis
alonzoGenesis <- Maybe (CardanoEra era)
-> String -> ExceptT GenesisCmdError IO AlonzoGenesis
forall (t :: (* -> *) -> * -> *) (m :: * -> *) era.
MonadIOTransError GenesisCmdError t m =>
Maybe (CardanoEra era) -> String -> t m AlonzoGenesis
decodeAlonzoGenesisFile (CardanoEra era -> Maybe (CardanoEra era)
forall a. a -> Maybe a
Just CardanoEra era
era) (String -> ExceptT GenesisCmdError IO AlonzoGenesis)
-> String -> ExceptT GenesisCmdError IO AlonzoGenesis
forall a b. (a -> b) -> a -> b
$ String
rootdir String -> String -> String
</> String
"genesis.alonzo.spec.json"
    ConwayGenesis StandardCrypto
conwayGenesis <- String -> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
String -> t m (ConwayGenesis StandardCrypto)
decodeConwayGenesisFile (String
 -> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto))
-> String
-> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall a b. (a -> b) -> a -> b
$ String
rootdir String -> String -> String
</> String
"genesis.conway.spec.json"

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

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

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

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

    [(String, WriteFileGenesis)]
-> ((String, WriteFileGenesis)
    -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
      [ (String
"genesis.json", ShelleyGenesis StandardCrypto -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ShelleyGenesis StandardCrypto
shelleyGenesis)
      , (String
"genesis.alonzo.json", AlonzoGenesis -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty AlonzoGenesis
alonzoGenesis)
      , (String
"genesis.conway.json", ConwayGenesis StandardCrypto -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ConwayGenesis StandardCrypto
conwayGenesis)
      ]
      (((String, WriteFileGenesis)
  -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
 -> ExceptT GenesisCmdError IO ())
-> ((String, WriteFileGenesis)
    -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \(String
filename, WriteFileGenesis
genesis) -> String
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
TN.writeFileGenesis (String
rootdir String -> String -> String
</> String
filename) WriteFileGenesis
genesis
   where
    -- TODO: rationalise the naming convention on these genesis json files.

    adjustTemplate :: ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto
adjustTemplate ShelleyGenesis StandardCrypto
t = ShelleyGenesis StandardCrypto
t{sgNetworkMagic = unNetworkMagic (toNetworkMagic network)}

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

toVkeyJSON
  :: ()
  => Key a
  => HasTypeProxy a
  => SigningKey a
  -> ByteString
toVkeyJSON :: forall a. (Key a, HasTypeProxy a) => SigningKey a -> ByteString
toVkeyJSON = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (SigningKey a -> ByteString) -> SigningKey a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TextEnvelopeDescr -> VerificationKey a -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing (VerificationKey a -> ByteString)
-> (SigningKey a -> VerificationKey a)
-> SigningKey a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey a -> VerificationKey a
forall keyrole.
(Key keyrole, HasTypeProxy 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 (ByteString -> ByteString)
-> (VerificationKey a -> ByteString)
-> VerificationKey a
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TextEnvelopeDescr -> VerificationKey a -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing

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

toCounter :: (OperationalCertificate, OperationalCertificateIssueCounter) -> ByteString
toCounter :: (OperationalCertificate, OperationalCertificateIssueCounter)
-> ByteString
toCounter = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> ((OperationalCertificate, OperationalCertificateIssueCounter)
    -> ByteString)
-> (OperationalCertificate, OperationalCertificateIssueCounter)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing (OperationalCertificateIssueCounter -> ByteString)
-> ((OperationalCertificate, OperationalCertificateIssueCounter)
    -> OperationalCertificateIssueCounter)
-> (OperationalCertificate, OperationalCertificateIssueCounter)
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OperationalCertificate, OperationalCertificateIssueCounter)
-> OperationalCertificateIssueCounter
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 = (SigningKey GenesisDelegateExtendedKey
 -> VerificationKey GenesisDelegateKey)
-> [SigningKey GenesisDelegateExtendedKey]
-> [VerificationKey GenesisDelegateKey]
forall a b. (a -> b) -> [a] -> [b]
map (VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey (VerificationKey GenesisDelegateExtendedKey
 -> VerificationKey GenesisDelegateKey)
-> (SigningKey GenesisDelegateExtendedKey
    -> VerificationKey GenesisDelegateExtendedKey)
-> SigningKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey) [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys
  [SigningKey VrfKey]
vrfKeys <- [SigningKey GenesisDelegateExtendedKey]
-> (SigningKey GenesisDelegateExtendedKey
    -> IO (SigningKey VrfKey))
-> IO [SigningKey VrfKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys ((SigningKey GenesisDelegateExtendedKey -> IO (SigningKey VrfKey))
 -> IO [SigningKey VrfKey])
-> (SigningKey GenesisDelegateExtendedKey
    -> IO (SigningKey VrfKey))
-> IO [SigningKey VrfKey]
forall a b. (a -> b) -> a -> b
$ \SigningKey GenesisDelegateExtendedKey
_ -> AsType VrfKey -> IO (SigningKey VrfKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType VrfKey
AsVrfKey
  [SigningKey KesKey]
kesKeys <- [SigningKey GenesisDelegateExtendedKey]
-> (SigningKey GenesisDelegateExtendedKey
    -> IO (SigningKey KesKey))
-> IO [SigningKey KesKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys ((SigningKey GenesisDelegateExtendedKey -> IO (SigningKey KesKey))
 -> IO [SigningKey KesKey])
-> (SigningKey GenesisDelegateExtendedKey
    -> IO (SigningKey KesKey))
-> IO [SigningKey KesKey]
forall a b. (a -> b) -> a -> b
$ \SigningKey GenesisDelegateExtendedKey
_ -> AsType KesKey -> IO (SigningKey KesKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType KesKey
AsKesKey

  let
    opCertInputs :: [(VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)]
    opCertInputs :: [(VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)]
opCertInputs = [VerificationKey KesKey]
-> [SigningKey GenesisDelegateExtendedKey]
-> [(VerificationKey KesKey,
     SigningKey GenesisDelegateExtendedKey)]
forall a b. [a] -> [b] -> [(a, b)]
zip ((SigningKey KesKey -> VerificationKey KesKey)
-> [SigningKey KesKey] -> [VerificationKey KesKey]
forall a b. (a -> b) -> [a] -> [b]
map SigningKey KesKey -> VerificationKey KesKey
forall keyrole.
(Key keyrole, HasTypeProxy 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) = (OperationalCertIssueError
 -> (OperationalCertificate, OperationalCertificateIssueCounter))
-> ((OperationalCertificate, OperationalCertificateIssueCounter)
    -> (OperationalCertificate, OperationalCertificateIssueCounter))
-> Either
     OperationalCertIssueError
     (OperationalCertificate, OperationalCertificateIssueCounter)
-> (OperationalCertificate, OperationalCertificateIssueCounter)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String
-> (OperationalCertificate, OperationalCertificateIssueCounter)
forall a. HasCallStack => String -> a
error (String
 -> (OperationalCertificate, OperationalCertificateIssueCounter))
-> (OperationalCertIssueError -> String)
-> OperationalCertIssueError
-> (OperationalCertificate, OperationalCertificateIssueCounter)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OperationalCertIssueError -> String
forall a. Show a => a -> String
show) (OperationalCertificate, OperationalCertificateIssueCounter)
-> (OperationalCertificate, OperationalCertificateIssueCounter)
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 (SigningKey GenesisDelegateExtendedKey
-> Either
     (SigningKey StakePoolKey) (SigningKey GenesisDelegateExtendedKey)
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
convertFun (VerificationKey GenesisDelegateExtendedKey
 -> VerificationKey StakePoolKey)
-> (SigningKey GenesisDelegateExtendedKey
    -> VerificationKey GenesisDelegateExtendedKey)
-> SigningKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (SigningKey GenesisDelegateExtendedKey
 -> VerificationKey StakePoolKey)
-> SigningKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
forall a b. (a -> b) -> a -> b
$ SigningKey GenesisDelegateExtendedKey
delegateKey)
      convertFun
        :: VerificationKey GenesisDelegateExtendedKey
        -> VerificationKey StakePoolKey
      convertFun :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
convertFun =
        ( VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey
            :: VerificationKey GenesisDelegateKey
            -> VerificationKey StakePoolKey
        )
          (VerificationKey GenesisDelegateKey
 -> VerificationKey StakePoolKey)
-> (VerificationKey GenesisDelegateExtendedKey
    -> VerificationKey GenesisDelegateKey)
-> VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ( VerificationKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey
                :: VerificationKey GenesisDelegateExtendedKey
                -> VerificationKey GenesisDelegateKey
            )

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

    vrfvkeys :: [VerificationKey VrfKey]
vrfvkeys = (SigningKey VrfKey -> VerificationKey VrfKey)
-> [SigningKey VrfKey] -> [VerificationKey VrfKey]
forall a b. (a -> b) -> [a] -> [b]
map SigningKey VrfKey -> VerificationKey VrfKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey [SigningKey VrfKey]
vrfKeys
    combinedMap
      :: [ ( VerificationKey GenesisKey
           , VerificationKey GenesisDelegateKey
           , VerificationKey VrfKey
           )
         ]
    combinedMap :: [(VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
  VerificationKey VrfKey)]
combinedMap = [VerificationKey GenesisKey]
-> [VerificationKey GenesisDelegateKey]
-> [VerificationKey VrfKey]
-> [(VerificationKey GenesisKey,
     VerificationKey GenesisDelegateKey, VerificationKey VrfKey)]
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) = (VerificationKey GenesisKey -> Hash GenesisKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisKey
genesis, (VerificationKey GenesisDelegateKey -> Hash GenesisDelegateKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisDelegateKey
delegate, VerificationKey VrfKey -> Hash VrfKey
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 = [(Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))]
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
[Item
   (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
forall l. IsList l => [Item l] -> l
fromList ([(Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))]
 -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
-> ([(VerificationKey GenesisKey,
      VerificationKey GenesisDelegateKey, VerificationKey VrfKey)]
    -> [(Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))])
-> [(VerificationKey GenesisKey,
     VerificationKey GenesisDelegateKey, VerificationKey VrfKey)]
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
  VerificationKey VrfKey)
 -> (Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey)))
-> [(VerificationKey GenesisKey,
     VerificationKey GenesisDelegateKey, VerificationKey VrfKey)]
-> [(Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))]
forall a b. (a -> b) -> [a] -> [b]
map (VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
 VerificationKey VrfKey)
-> (Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))
hashKeys ([(VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
   VerificationKey VrfKey)]
 -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
-> [(VerificationKey GenesisKey,
     VerificationKey GenesisDelegateKey, VerificationKey VrfKey)]
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
forall a b. (a -> b) -> a -> b
$ [(VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
  VerificationKey VrfKey)]
combinedMap

  (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
 [SigningKey VrfKey], [SigningKey KesKey],
 [(OperationalCertificate, OperationalCertificateIssueCounter)])
-> IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
      [SigningKey VrfKey], [SigningKey KesKey],
      [(OperationalCertificate, OperationalCertificateIssueCounter)])
forall a. a -> IO a
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
--

runGenesisCreateCardanoCmd
  :: GenesisCreateCardanoCmdArgs era
  -> ExceptT GenesisCmdError IO ()
runGenesisCreateCardanoCmd :: forall era.
GenesisCreateCardanoCmdArgs era -> ExceptT GenesisCmdError IO ()
runGenesisCreateCardanoCmd
  Cmd.GenesisCreateCardanoCmdArgs
    { ShelleyBasedEra era
eon :: ShelleyBasedEra era
eon :: forall era. GenesisCreateCardanoCmdArgs era -> ShelleyBasedEra era
Cmd.eon
    , GenesisDir
genesisDir :: GenesisDir
genesisDir :: forall era. GenesisCreateCardanoCmdArgs era -> GenesisDir
Cmd.genesisDir
    , Word
numGenesisKeys :: Word
numGenesisKeys :: forall era. GenesisCreateCardanoCmdArgs era -> Word
Cmd.numGenesisKeys
    , Word
numUTxOKeys :: Word
numUTxOKeys :: forall era. GenesisCreateCardanoCmdArgs era -> Word
Cmd.numUTxOKeys
    , Maybe SystemStart
mSystemStart :: Maybe SystemStart
mSystemStart :: forall era. GenesisCreateCardanoCmdArgs era -> Maybe SystemStart
Cmd.mSystemStart
    , Maybe Coin
mSupply :: Maybe Coin
mSupply :: forall era. GenesisCreateCardanoCmdArgs era -> Maybe Coin
Cmd.mSupply
    , BlockCount
security :: BlockCount
security :: forall era. GenesisCreateCardanoCmdArgs era -> BlockCount
Cmd.security
    , Word
slotLength :: Word
slotLength :: forall era. GenesisCreateCardanoCmdArgs era -> Word
Cmd.slotLength
    , Rational
slotCoeff :: Rational
slotCoeff :: forall era. GenesisCreateCardanoCmdArgs era -> Rational
Cmd.slotCoeff
    , NetworkId
network :: NetworkId
network :: forall era. GenesisCreateCardanoCmdArgs era -> NetworkId
Cmd.network
    , String
byronGenesisTemplate :: String
byronGenesisTemplate :: forall era. GenesisCreateCardanoCmdArgs era -> String
Cmd.byronGenesisTemplate
    , String
shelleyGenesisTemplate :: String
shelleyGenesisTemplate :: forall era. GenesisCreateCardanoCmdArgs era -> String
Cmd.shelleyGenesisTemplate
    , String
alonzoGenesisTemplate :: String
alonzoGenesisTemplate :: forall era. GenesisCreateCardanoCmdArgs era -> String
Cmd.alonzoGenesisTemplate
    , String
conwayGenesisTemplate :: String
conwayGenesisTemplate :: forall era. GenesisCreateCardanoCmdArgs era -> String
Cmd.conwayGenesisTemplate
    , Maybe String
mNodeConfigTemplate :: Maybe String
mNodeConfigTemplate :: forall era. GenesisCreateCardanoCmdArgs era -> Maybe String
Cmd.mNodeConfigTemplate
    } = do
    SystemStart
start <- ExceptT GenesisCmdError IO SystemStart
-> (SystemStart -> ExceptT GenesisCmdError IO SystemStart)
-> Maybe SystemStart
-> ExceptT GenesisCmdError IO SystemStart
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart)
-> ExceptT GenesisCmdError IO UTCTime
-> ExceptT GenesisCmdError IO SystemStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT GenesisCmdError IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTimePlus30) SystemStart -> ExceptT GenesisCmdError IO SystemStart
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SystemStart
mSystemStart
    (GenesisData
byronGenesis', GeneratedSecrets
byronSecrets) <- ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
-> ExceptT GenesisCmdError IO (GenesisData, GeneratedSecrets)
forall {a}.
ExceptT ByronGenesisError IO a -> ExceptT GenesisCmdError IO a
convertToShelleyError (ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
 -> ExceptT GenesisCmdError IO (GenesisData, GeneratedSecrets))
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
-> ExceptT GenesisCmdError IO (GenesisData, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$ GenesisParameters
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
Byron.mkGenesis (GenesisParameters
 -> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets))
-> GenesisParameters
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$ SystemStart -> GenesisParameters
byronParams SystemStart
start
    let
      byronGenesis :: GenesisData
byronGenesis =
        GenesisData
byronGenesis'
          { Byron.gdProtocolParameters =
              (Byron.gdProtocolParameters byronGenesis')
                { Byron.ppSlotDuration = floor (toRational slotLength * recip slotCoeff)
                }
          }

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

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

      utxoKeys :: [PoorSecret]
utxoKeys = GeneratedSecrets -> [PoorSecret]
Byron.gsPoorSecrets GeneratedSecrets
byronSecrets
      byronUtxoKeys :: [SigningKey ByronKey]
byronUtxoKeys = (PoorSecret -> SigningKey ByronKey)
-> [PoorSecret] -> [SigningKey ByronKey]
forall a b. (a -> b) -> [a] -> [b]
map (SigningKey -> SigningKey ByronKey
ByronSigningKey (SigningKey -> SigningKey ByronKey)
-> (PoorSecret -> SigningKey) -> PoorSecret -> SigningKey ByronKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoorSecret -> SigningKey
Byron.poorSecretToKey) [PoorSecret]
utxoKeys
      shelleyUtxoKeys :: [SigningKey ByronKey]
shelleyUtxoKeys = (PoorSecret -> SigningKey ByronKey)
-> [PoorSecret] -> [SigningKey ByronKey]
forall a b. (a -> b) -> [a] -> [b]
map (SigningKey -> SigningKey ByronKey
convertPoor (SigningKey -> SigningKey ByronKey)
-> (PoorSecret -> SigningKey) -> PoorSecret -> SigningKey ByronKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoorSecret -> SigningKey
Byron.poorSecretToKey) [PoorSecret]
utxoKeys
      era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
eon

    [Certificate]
dlgCerts <- ExceptT ByronGenesisError IO [Certificate]
-> ExceptT GenesisCmdError IO [Certificate]
forall {a}.
ExceptT ByronGenesisError IO a -> ExceptT GenesisCmdError IO a
convertToShelleyError (ExceptT ByronGenesisError IO [Certificate]
 -> ExceptT GenesisCmdError IO [Certificate])
-> ExceptT ByronGenesisError IO [Certificate]
-> ExceptT GenesisCmdError IO [Certificate]
forall a b. (a -> b) -> a -> b
$ (SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate)
-> [SigningKey ByronKey]
-> ExceptT ByronGenesisError IO [Certificate]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (GenesisData
-> SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert GenesisData
byronGenesis) [SigningKey ByronKey]
byronDelegateKeys
    let
      overrideShelleyGenesis :: ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto
overrideShelleyGenesis ShelleyGenesis StandardCrypto
t =
        ShelleyGenesis StandardCrypto
t
          { sgNetworkMagic = unNetworkMagic (toNetworkMagic network)
          , sgNetworkId = toShelleyNetwork network
          , sgActiveSlotsCoeff = unsafeBoundedRational slotCoeff
          , sgSecurityParam = Byron.unBlockCount security
          , sgUpdateQuorum = fromIntegral $ ((numGenesisKeys `div` 3) * 2) + 1
          , sgEpochLength = EpochSize $ floor $ (fromIntegral (Byron.unBlockCount security) * 10) / slotCoeff
          , sgMaxLovelaceSupply = 45_000_000_000_000_000
          , sgSystemStart = getSystemStart start
          , sgSlotLength = L.secondsToNominalDiffTimeMicro $ MkFixed (fromIntegral slotLength) * 1_000
          }
    ShelleyGenesis StandardCrypto
shelleyGenesisTemplate' <-
      ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto
overrideShelleyGenesis (ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto)
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
String -> t m (ShelleyGenesis StandardCrypto)
decodeShelleyGenesisFile String
shelleyGenesisTemplate
    AlonzoGenesis
alonzoGenesis <- Maybe (CardanoEra era)
-> String -> ExceptT GenesisCmdError IO AlonzoGenesis
forall (t :: (* -> *) -> * -> *) (m :: * -> *) era.
MonadIOTransError GenesisCmdError t m =>
Maybe (CardanoEra era) -> String -> t m AlonzoGenesis
decodeAlonzoGenesisFile (CardanoEra era -> Maybe (CardanoEra era)
forall a. a -> Maybe a
Just CardanoEra era
era) String
alonzoGenesisTemplate
    ConwayGenesis StandardCrypto
conwayGenesis <- String -> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
String -> t m (ConwayGenesis StandardCrypto)
decodeConwayGenesisFile String
conwayGenesisTemplate
    (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegateMap, [SigningKey VrfKey]
vrfKeys, [SigningKey KesKey]
kesKeys, [(OperationalCertificate, OperationalCertificateIssueCounter)]
opCerts) <-
      IO
  (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
   [SigningKey VrfKey], [SigningKey KesKey],
   [(OperationalCertificate, OperationalCertificateIssueCounter)])
-> ExceptT
     GenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
      [SigningKey VrfKey], [SigningKey KesKey],
      [(OperationalCertificate, OperationalCertificateIssueCounter)])
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO
   (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
    [SigningKey VrfKey], [SigningKey KesKey],
    [(OperationalCertificate, OperationalCertificateIssueCounter)])
 -> ExceptT
      GenesisCmdError
      IO
      (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
       [SigningKey VrfKey], [SigningKey KesKey],
       [(OperationalCertificate, OperationalCertificateIssueCounter)]))
-> IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
      [SigningKey VrfKey], [SigningKey KesKey],
      [(OperationalCertificate, OperationalCertificateIssueCounter)])
-> ExceptT
     GenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey),
      [SigningKey VrfKey], [SigningKey KesKey],
      [(OperationalCertificate, OperationalCertificateIssueCounter)])
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 L.StandardCrypto
      shelleyGenesis :: ShelleyGenesis StandardCrypto
shelleyGenesis = SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Coin
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> ShelleyGenesis StandardCrypto
updateTemplate SystemStart
start Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegateMap Maybe Coin
forall a. Maybe a
Nothing [] Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
forall a. Monoid a => a
mempty Coin
0 [] [] ShelleyGenesis StandardCrypto
shelleyGenesisTemplate'

    let GenesisDir String
rootdir = GenesisDir
genesisDir
        gendir :: String
gendir = String
rootdir String -> String -> String
</> String
"genesis-keys"
        deldir :: String
deldir = String
rootdir String -> String -> String
</> String
"delegate-keys"
        utxodir :: String
utxodir = String
rootdir String -> String -> String
</> String
"utxo-keys"

    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ 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

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

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

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

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

      String
-> String
-> String
-> ((OperationalCertificate, OperationalCertificateIssueCounter)
    -> ByteString)
-> [(OperationalCertificate, OperationalCertificateIssueCounter)]
-> IO ()
forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
deldir String
"shelley" String
"opcert.json" (OperationalCertificate, OperationalCertificateIssueCounter)
-> ByteString
toOpCert [(OperationalCertificate, OperationalCertificateIssueCounter)]
opCerts
      String
-> String
-> String
-> ((OperationalCertificate, OperationalCertificateIssueCounter)
    -> ByteString)
-> [(OperationalCertificate, OperationalCertificateIssueCounter)]
-> IO ()
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 GenesisCmdError IO (Hash Blake2b_256 ByteString)
TN.writeFileGenesis (String
rootdir String -> String -> String
</> String
"byron-genesis.json") (WriteFileGenesis
 -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ GenesisData -> WriteFileGenesis
forall genesis.
ToJSON Identity genesis =>
genesis -> WriteFileGenesis
WriteCanonical GenesisData
byronGenesis
    Hash Blake2b_256 ByteString
shelleyGenesisHash <-
      String
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
TN.writeFileGenesis (String
rootdir String -> String -> String
</> String
"shelley-genesis.json") (WriteFileGenesis
 -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis StandardCrypto -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ShelleyGenesis StandardCrypto
shelleyGenesis
    Hash Blake2b_256 ByteString
alonzoGenesisHash <-
      String
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
TN.writeFileGenesis (String
rootdir String -> String -> String
</> String
"alonzo-genesis.json") (WriteFileGenesis
 -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ AlonzoGenesis -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty AlonzoGenesis
alonzoGenesis
    Hash Blake2b_256 ByteString
conwayGenesisHash <-
      String
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
TN.writeFileGenesis (String
rootdir String -> String -> String
</> String
"conway-genesis.json") (WriteFileGenesis
 -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ ConwayGenesis StandardCrypto -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ConwayGenesis StandardCrypto
conwayGenesis

    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
      case Maybe String
mNodeConfigTemplate of
        Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just String
nodeCfg -> do
          let hashes :: Map Key (Hash Blake2b_256 ByteString)
hashes =
                [(Key, Hash Blake2b_256 ByteString)]
-> Map Key (Hash Blake2b_256 ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (Key
"ByronGenesisHash", Hash Blake2b_256 ByteString
byronGenesisHash)
                  , (Key
"ShelleyGenesisHash", Hash Blake2b_256 ByteString
shelleyGenesisHash)
                  , (Key
"AlonzoGenesisHash", Hash Blake2b_256 ByteString
alonzoGenesisHash)
                  , (Key
"ConwayGenesisHash", Hash Blake2b_256 ByteString
conwayGenesisHash)
                  ]
          String -> Map Key (Hash Blake2b_256 ByteString) -> String -> IO ()
forall (m :: * -> *) h a.
MonadIO m =>
String -> Map Key (Hash h a) -> String -> m ()
writeGenesisHashesToNodeConfigFile String
nodeCfg Map Key (Hash Blake2b_256 ByteString)
hashes (String
rootdir String -> String -> String
</> String
"node-config.json")
   where
    convertToShelleyError :: ExceptT ByronGenesisError IO a -> ExceptT GenesisCmdError IO a
convertToShelleyError = (ByronGenesisError -> GenesisCmdError)
-> ExceptT ByronGenesisError IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
withExceptT ByronGenesisError -> GenesisCmdError
GenesisCmdByronError
    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
byronGenesisTemplate
        BlockCount
security
        ProtocolMagic
byronNetwork
        TestnetBalanceOptions
byronBalance
        FakeAvvmOptions
byronFakeAvvm
        LovelacePortion
byronAvvmFactor
        Maybe Integer
forall a. Maybe a
Nothing
    byronNetwork :: ProtocolMagic
byronNetwork =
      Annotated ProtocolMagicId ()
-> RequiresNetworkMagic -> ProtocolMagic
forall a.
Annotated ProtocolMagicId a
-> RequiresNetworkMagic -> AProtocolMagic a
CC.AProtocolMagic
        (ProtocolMagicId -> () -> Annotated ProtocolMagicId ()
forall b a. b -> a -> Annotated b a
L.Annotated (NetworkId -> ProtocolMagicId
toByronProtocolMagicId NetworkId
network) ())
        (NetworkId -> RequiresNetworkMagic
toByronRequiresNetworkMagic NetworkId
network)
    byronBalance :: TestnetBalanceOptions
byronBalance =
      Byron.TestnetBalanceOptions
        { tboRichmen :: Word
tboRichmen = Word
numGenesisKeys
        , tboPoors :: Word
tboPoors = Word
numUTxOKeys
        , tboTotalBalance :: Lovelace
tboTotalBalance = Lovelace -> Maybe Lovelace -> Lovelace
forall a. a -> Maybe a -> a
fromMaybe Lovelace
zeroLovelace (Maybe Lovelace -> Lovelace) -> Maybe Lovelace -> Lovelace
forall a b. (a -> b) -> a -> b
$ Coin -> Maybe Lovelace
toByronLovelace (Coin -> Maybe Coin -> Coin
forall a. a -> Maybe a -> a
fromMaybe Coin
0 Maybe Coin
mSupply)
        , tboRichmenShare :: Rational
tboRichmenShare = Rational
0
        }
    byronFakeAvvm :: FakeAvvmOptions
byronFakeAvvm =
      Byron.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 -> Byron.Certificate -> Bool
    isCertForSK :: SigningKey -> Certificate -> Bool
isCertForSK SigningKey
sk Certificate
cert = Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
Byron.delegateVK Certificate
cert VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
== SigningKey -> VerificationKey
CC.toVerification SigningKey
sk

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

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

-- | @writeGenesisHashesToNodeConfigFile src hashes dest@ reads the node configuration file
-- at @src@ and the writes an augmented version of this file at @dest@, with the hashes.
writeGenesisHashesToNodeConfigFile
  :: MonadIO m
  => FilePath
  -- ^ From where to read the node configuration file
  -> Map.Map Aeson.Key (Crypto.Hash h a)
  -- ^ Key of an era's hash (like "ByronGenesisHash", "ShelleyGenesisHash", etc.), to the hash of its genesis file
  -> FilePath
  -- ^ Where to write the updated node config file
  -> m ()
writeGenesisHashesToNodeConfigFile :: forall (m :: * -> *) h a.
MonadIO m =>
String -> Map Key (Hash h a) -> String -> m ()
writeGenesisHashesToNodeConfigFile String
sourcePath Map Key (Hash h a)
hashes String
destinationPath = do
  Value
nodeConfig <- String -> m Value
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
Yaml.decodeFileThrow String
sourcePath
  let newConfig :: Value
newConfig = ((Key, Hash h a) -> Value -> Value)
-> Value -> [(Key, Hash h a)] -> Value
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (Key, Hash h a) -> Value -> Value
forall h a. (Key, Hash h a) -> Value -> Value
updateConfigHash Value
nodeConfig ([(Key, Hash h a)] -> Value) -> [(Key, Hash h a)] -> Value
forall a b. (a -> b) -> a -> b
$ Map Key (Hash h a) -> [(Key, Hash h a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Key (Hash h a)
hashes
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Value -> IO ()
forall a. ToJSON a => String -> a -> IO ()
Aeson.encodeFile String
destinationPath Value
newConfig
 where
  setHash :: Key -> Hash h a -> KeyMap Value -> KeyMap Value
setHash Key
field Hash h a
hash = Key -> Value -> KeyMap Value -> KeyMap Value
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.insert Key
field (Value -> KeyMap Value -> KeyMap Value)
-> Value -> KeyMap Value -> KeyMap Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Aeson.String (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ Hash h a -> Text
forall h a. Hash h a -> Text
Crypto.hashToTextAsHex Hash h a
hash
  updateConfigHash :: (Aeson.Key, Crypto.Hash h a) -> Yaml.Value -> Yaml.Value
  updateConfigHash :: forall h a. (Key, Hash h a) -> Value -> Value
updateConfigHash (Key
field, Hash h a
hash) =
    \case
      Aeson.Object KeyMap Value
obj -> KeyMap Value -> Value
Aeson.Object (KeyMap Value -> Value) -> KeyMap Value -> Value
forall a b. (a -> b) -> a -> b
$ Key -> Hash h a -> KeyMap Value -> KeyMap Value
forall {h} {a}. Key -> Hash h a -> KeyMap Value -> KeyMap Value
setHash Key
field Hash h a
hash KeyMap Value
obj
      Value
v -> Value
v

runGenesisCreateStakedCmd
  :: GenesisCreateStakedCmdArgs era
  -> ExceptT GenesisCmdError IO ()
runGenesisCreateStakedCmd :: forall era.
GenesisCreateStakedCmdArgs era -> ExceptT GenesisCmdError IO ()
runGenesisCreateStakedCmd
  Cmd.GenesisCreateStakedCmdArgs
    { ShelleyBasedEra era
eon :: ShelleyBasedEra era
eon :: forall era. GenesisCreateStakedCmdArgs era -> ShelleyBasedEra era
eon
    , KeyOutputFormat
keyOutputFormat :: KeyOutputFormat
keyOutputFormat :: forall era. GenesisCreateStakedCmdArgs era -> KeyOutputFormat
Cmd.keyOutputFormat
    , GenesisDir
genesisDir :: GenesisDir
genesisDir :: forall era. GenesisCreateStakedCmdArgs era -> GenesisDir
Cmd.genesisDir
    , Word
numGenesisKeys :: Word
numGenesisKeys :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numGenesisKeys
    , Word
numUTxOKeys :: Word
numUTxOKeys :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numUTxOKeys
    , Word
numPools :: Word
numPools :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numPools
    , Word
numStakeDelegators :: Word
numStakeDelegators :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numStakeDelegators
    , Maybe SystemStart
mSystemStart :: Maybe SystemStart
mSystemStart :: forall era. GenesisCreateStakedCmdArgs era -> Maybe SystemStart
Cmd.mSystemStart
    , Maybe Coin
mNonDelegatedSupply :: Maybe Coin
mNonDelegatedSupply :: forall era. GenesisCreateStakedCmdArgs era -> Maybe Coin
Cmd.mNonDelegatedSupply
    , Coin
delegatedSupply :: Coin
delegatedSupply :: forall era. GenesisCreateStakedCmdArgs era -> Coin
Cmd.delegatedSupply
    , network :: forall era. GenesisCreateStakedCmdArgs era -> NetworkId
Cmd.network = NetworkId
networkId
    , Word
numBulkPoolCredFiles :: Word
numBulkPoolCredFiles :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numBulkPoolCredFiles
    , Word
numBulkPoolsPerFile :: Word
numBulkPoolsPerFile :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numBulkPoolsPerFile
    , Word
numStuffedUtxo :: Word
numStuffedUtxo :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numStuffedUtxo
    , Maybe String
mStakePoolRelaySpecFile :: Maybe String
mStakePoolRelaySpecFile :: forall era. GenesisCreateStakedCmdArgs era -> Maybe String
Cmd.mStakePoolRelaySpecFile
    } = do
    let GenesisDir String
rootdir = GenesisDir
genesisDir
        gendir :: String
gendir = String
rootdir String -> String -> String
</> String
"genesis-keys"
        deldir :: String
deldir = String
rootdir String -> String -> String
</> String
"delegate-keys"
        pooldir :: String
pooldir = String
rootdir String -> String -> String
</> String
"pools"
        stdeldir :: String
stdeldir = String
rootdir String -> String -> String
</> String
"stake-delegator-keys"
        utxodir :: String
utxodir = String
rootdir String -> String -> String
</> String
"utxo-keys"
        era :: CardanoEra era
era = ShelleyBasedEra era -> CardanoEra era
forall era. ShelleyBasedEra era -> CardanoEra era
forall (eon :: * -> *) era.
ToCardanoEra eon =>
eon era -> CardanoEra era
toCardanoEra ShelleyBasedEra era
eon

    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ 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 StandardCrypto
template <- String
-> (ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto)
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
decodeShelleyGenesisWithDefault (String
rootdir String -> String -> String
</> String
"genesis.spec.json") ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto
adjustTemplate
    AlonzoGenesis
alonzoGenesis <- Maybe (CardanoEra era)
-> String -> ExceptT GenesisCmdError IO AlonzoGenesis
forall (t :: (* -> *) -> * -> *) (m :: * -> *) era.
MonadIOTransError GenesisCmdError t m =>
Maybe (CardanoEra era) -> String -> t m AlonzoGenesis
decodeAlonzoGenesisFile (CardanoEra era -> Maybe (CardanoEra era)
forall a. a -> Maybe a
Just CardanoEra era
era) (String -> ExceptT GenesisCmdError IO AlonzoGenesis)
-> String -> ExceptT GenesisCmdError IO AlonzoGenesis
forall a b. (a -> b) -> a -> b
$ String
rootdir String -> String -> String
</> String
"genesis.alonzo.spec.json"
    ConwayGenesis StandardCrypto
conwayGenesis <- String -> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
String -> t m (ConwayGenesis StandardCrypto)
decodeConwayGenesisFile (String
 -> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto))
-> String
-> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall a b. (a -> b) -> a -> b
$ String
rootdir String -> String -> String
</> String
"genesis.conway.spec.json"

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

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

    Maybe (Map Word [StakePoolRelay])
mStakePoolRelays <- Maybe String
-> (String
    -> ExceptT GenesisCmdError IO (Map Word [StakePoolRelay]))
-> ExceptT GenesisCmdError IO (Maybe (Map Word [StakePoolRelay]))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe String
mStakePoolRelaySpecFile String -> ExceptT GenesisCmdError IO (Map Word [StakePoolRelay])
forall (m :: * -> *).
MonadIO m =>
String -> ExceptT GenesisCmdError m (Map Word [StakePoolRelay])
readRelays

    [PoolParams StandardCrypto]
poolParams <- [Word]
-> (Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT GenesisCmdError IO [PoolParams StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Word
1 .. Word
numPools] ((Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
 -> ExceptT GenesisCmdError IO [PoolParams StandardCrypto])
-> (Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT GenesisCmdError IO [PoolParams StandardCrypto]
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
      KeyOutputFormat -> String -> Word -> ExceptT GenesisCmdError IO ()
createPoolCredentials KeyOutputFormat
keyOutputFormat String
pooldir Word
index
      NetworkId
-> String
-> Maybe Word
-> Map Word [StakePoolRelay]
-> ExceptT GenesisCmdError IO (PoolParams StandardCrypto)
buildPoolParams NetworkId
networkId String
pooldir (Word -> Maybe Word
forall a. a -> Maybe a
Just Word
index) (Map Word [StakePoolRelay]
-> Maybe (Map Word [StakePoolRelay]) -> Map Word [StakePoolRelay]
forall a. a -> Maybe a -> a
fromMaybe Map Word [StakePoolRelay]
forall a. Monoid a => a
mempty Maybe (Map Word [StakePoolRelay])
mStakePoolRelays)

    Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
numBulkPoolCredFiles Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
numBulkPoolsPerFile Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
numPools) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
left (GenesisCmdError -> ExceptT GenesisCmdError IO ())
-> GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
        Word -> Word -> Word -> GenesisCmdError
GenesisCmdTooFewPoolsForBulkCreds Word
numPools Word
numBulkPoolCredFiles Word
numBulkPoolsPerFile
    -- 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 = Word -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ Word
numPools Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
numBulkPoolCredFiles Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
numBulkPoolsPerFile
        [Word]
bulkIndices :: [Word] = [Word
1 Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
bulkOffset .. Word
numPools]
        [[Word]]
bulkSlices :: [[Word]] = Int -> [Word] -> [[Word]]
forall e. Int -> [e] -> [[e]]
List.chunksOf (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
numBulkPoolsPerFile) [Word]
bulkIndices
    [(Word, [Word])]
-> ((Word, [Word]) -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ ([Word] -> [[Word]] -> [(Word, [Word])]
forall a b. [a] -> [b] -> [(a, b)]
zip [Word
1 .. Word
numBulkPoolCredFiles] [[Word]]
bulkSlices) (((Word, [Word]) -> ExceptT GenesisCmdError IO ())
 -> ExceptT GenesisCmdError IO ())
-> ((Word, [Word]) -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      (Word -> [Word] -> ExceptT GenesisCmdError IO ())
-> (Word, [Word]) -> ExceptT GenesisCmdError IO ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (String -> Word -> [Word] -> ExceptT GenesisCmdError IO ()
writeBulkPoolCredentials String
pooldir)

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

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

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

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

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

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

    let stake :: [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake = (PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto)
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
-> (KeyHash 'Staking StandardCrypto,
    KeyHash 'StakePool StandardCrypto)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c. PoolParams c -> KeyHash 'StakePool c
L.ppId ((KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
 -> (KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto))
-> (Delegation
    -> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto))
-> Delegation
-> (KeyHash 'Staking StandardCrypto,
    KeyHash 'StakePool StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry (Delegation
 -> (KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto))
-> [Delegation]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
        stakePools :: [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
stakePools = [(PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c. PoolParams c -> KeyHash 'StakePool c
L.ppId PoolParams StandardCrypto
poolParams', PoolParams StandardCrypto
poolParams') | PoolParams StandardCrypto
poolParams' <- (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
-> PoolParams StandardCrypto
forall a b. (a, b) -> b
snd ((KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
 -> PoolParams StandardCrypto)
-> (Delegation
    -> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto))
-> Delegation
-> PoolParams StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry (Delegation -> PoolParams StandardCrypto)
-> [Delegation] -> [PoolParams StandardCrypto]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations]
        delegAddrs :: [AddressInEra ShelleyEra]
delegAddrs = Delegation -> AddressInEra ShelleyEra
dInitialUtxoAddr (Delegation -> AddressInEra ShelleyEra)
-> [Delegation] -> [AddressInEra ShelleyEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
        !shelleyGenesis :: ShelleyGenesis StandardCrypto
shelleyGenesis =
          SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> ShelleyGenesis StandardCrypto
updateOutputTemplate
            -- Shelley genesis parameters
            SystemStart
start
            Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs
            Maybe Coin
mNonDelegatedSupply
            ([AddressInEra ShelleyEra] -> Int
forall a. [a] -> Int
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
            (Coin -> Maybe Coin
forall a. a -> Maybe a
Just Coin
delegatedSupply)
            Int
numDelegations
            [AddressInEra ShelleyEra]
delegAddrs
            [AddressInEra ShelleyEra]
stuffedUtxoAddrs
            ShelleyGenesis StandardCrypto
template

    [(String, WriteFileGenesis)]
-> ((String, WriteFileGenesis)
    -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
      [ (String
"genesis.json", ShelleyGenesis StandardCrypto -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ShelleyGenesis StandardCrypto
shelleyGenesis)
      , (String
"genesis.alonzo.json", AlonzoGenesis -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty AlonzoGenesis
alonzoGenesis)
      , (String
"genesis.conway.json", ConwayGenesis StandardCrypto -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ConwayGenesis StandardCrypto
conwayGenesis)
      ]
      (((String, WriteFileGenesis)
  -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
 -> ExceptT GenesisCmdError IO ())
-> ((String, WriteFileGenesis)
    -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \(String
filename, WriteFileGenesis
genesis) -> String
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
TN.writeFileGenesis (String
rootdir String -> String -> String
</> String
filename) WriteFileGenesis
genesis
    -- TODO: rationalise the naming convention on these genesis json files.

    IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      Handle -> Text -> IO ()
Text.hPutStrLn Handle
IO.stderr (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$
        [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
          [ Text
"generated genesis with: "
          , Word -> Text
forall a. Show a => a -> Text
textShow Word
numGenesisKeys
          , Text
" genesis keys, "
          , Word -> Text
forall a. Show a => a -> Text
textShow Word
numUTxOKeys
          , Text
" non-delegating UTxO keys, "
          , Word -> Text
forall a. Show a => a -> Text
textShow Word
numPools
          , Text
" stake pools, "
          , Word -> Text
forall a. Show a => a -> Text
textShow Word
numStakeDelegators
          , Text
" delegating UTxO keys, "
          , Int -> Text
forall a. Show a => a -> Text
textShow Int
numDelegations
          , Text
" delegation map entries, "
          ]
            [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
                  [ Text
", "
                  , Word -> Text
forall a. Show a => a -> Text
textShow Word
numBulkPoolCredFiles
                  , Text
" bulk pool credential files, "
                  , Word -> Text
forall a. Show a => a -> Text
textShow Word
numBulkPoolsPerFile
                  , Text
" pools per bulk credential file, indices starting from "
                  , Word -> Text
forall a. Show a => a -> Text
textShow Word
bulkOffset
                  , Text
", "
                  , Int -> Text
forall a. Show a => a -> Text
textShow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [Word] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Word]
bulkIndices
                  , Text
" total pools in bulk nodes, each bulk node having this many entries: "
                  , [Int] -> Text
forall a. Show a => a -> Text
textShow ([Int] -> Text) -> [Int] -> Text
forall a b. (a -> b) -> a -> b
$ [Word] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Word] -> Int) -> [[Word]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Word]]
bulkSlices
                  ]
               | Word
numBulkPoolCredFiles Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
numBulkPoolsPerFile Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0
               ]
   where
    adjustTemplate :: ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto
adjustTemplate ShelleyGenesis StandardCrypto
t = ShelleyGenesis StandardCrypto
t{sgNetworkMagic = unNetworkMagic (toNetworkMagic networkId)}
    mkDelegationMapEntry
      :: Delegation -> (L.KeyHash L.Staking L.StandardCrypto, L.PoolParams L.StandardCrypto)
    mkDelegationMapEntry :: Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry Delegation
d = (Delegation -> KeyHash 'Staking StandardCrypto
dDelegStaking Delegation
d, Delegation -> PoolParams StandardCrypto
dPoolParams Delegation
d)

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

updateOutputTemplate
  :: 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
  -> [(L.KeyHash 'L.StakePool L.StandardCrypto, L.PoolParams L.StandardCrypto)]
  -- ^ Pool map
  -> [(L.KeyHash 'L.Staking L.StandardCrypto, L.KeyHash 'L.StakePool L.StandardCrypto)]
  -- ^ Delegaton map
  -> Maybe Lovelace
  -- ^ Amount of lovelace to delegate
  -> Int
  -- ^ Number of UTxO address for delegation
  -> [AddressInEra ShelleyEra]
  -- ^ UTxO address for delegation
  -> [AddressInEra ShelleyEra]
  -- ^ Stuffed UTxO addresses
  -> ShelleyGenesis L.StandardCrypto
  -- ^ Template from which to build a genesis
  -> ShelleyGenesis L.StandardCrypto
  -- ^ Updated genesis
updateOutputTemplate :: SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
     KeyHash 'StakePool StandardCrypto)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> ShelleyGenesis StandardCrypto
updateOutputTemplate
  (SystemStart UTCTime
sgSystemStart)
  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
  Maybe Coin
mAmountNonDeleg
  Int
nUtxoAddrsNonDeleg
  [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
  [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
pools
  [(KeyHash 'Staking StandardCrypto,
  KeyHash 'StakePool StandardCrypto)]
stake
  Maybe Coin
amountDeleg
  Int
nUtxoAddrsDeleg
  [AddressInEra ShelleyEra]
utxoAddrsDeleg
  [AddressInEra ShelleyEra]
stuffedUtxoAddrs
  template :: ShelleyGenesis StandardCrypto
template@ShelleyGenesis{PParams (ShelleyEra StandardCrypto)
sgProtocolParams :: PParams (ShelleyEra StandardCrypto)
sgProtocolParams :: forall c. ShelleyGenesis c -> PParams (ShelleyEra c)
sgProtocolParams} =
    ShelleyGenesis StandardCrypto
template
      { sgSystemStart
      , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin
      , sgGenDelegs = shelleyDelKeys
      , sgInitialFunds =
          fromList
            [ (toShelleyAddr addr, v)
            | (addr, v) <-
                distribute (nonDelegCoin - subtractForTreasury) nUtxoAddrsNonDeleg utxoAddrsNonDeleg
                  ++ distribute (delegCoin - subtractForTreasury) nUtxoAddrsDeleg utxoAddrsDeleg
                  ++ mkStuffedUtxo stuffedUtxoAddrs
            ]
      , sgStaking =
          ShelleyGenesisStaking
            { sgsPools = ListMap pools
            , sgsStake = ListMap stake
            }
      , sgProtocolParams
      }
   where
    maximumLovelaceSupply :: Word64
    maximumLovelaceSupply :: Word64
maximumLovelaceSupply = ShelleyGenesis StandardCrypto -> Word64
forall c. ShelleyGenesis c -> Word64
sgMaxLovelaceSupply ShelleyGenesis StandardCrypto
template
    -- If the initial funds are equal to the maximum funds, rewards cannot be created.
    subtractForTreasury :: Integer
    subtractForTreasury :: Integer
subtractForTreasury = Integer
nonDelegCoin Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
10
    nonDelegCoin, delegCoin :: Integer
    -- if --supply is not specified, non delegated supply comes from the template passed to this function:
    nonDelegCoin :: Integer
nonDelegCoin = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> (Coin -> Word64) -> Maybe Coin -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
maximumLovelaceSupply Coin -> Word64
forall a. Integral a => Coin -> a
unLovelace Maybe Coin
mAmountNonDeleg)
    delegCoin :: Integer
delegCoin = Integer -> (Coin -> Integer) -> Maybe Coin -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Integer
0 Coin -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Maybe Coin
amountDeleg

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

    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Coin)]
mkStuffedUtxo [AddressInEra ShelleyEra]
xs = (,Integer -> Coin
L.Coin Integer
minUtxoVal) (AddressInEra ShelleyEra -> (AddressInEra ShelleyEra, Coin))
-> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddressInEra ShelleyEra]
xs
     where
      L.Coin Integer
minUtxoVal = PParams (ShelleyEra StandardCrypto)
sgProtocolParams PParams (ShelleyEra StandardCrypto)
-> Getting Coin (PParams (ShelleyEra StandardCrypto)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams (ShelleyEra StandardCrypto)) Coin
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams (ShelleyEra StandardCrypto)) Coin
L.ppMinUTxOValueL

    shelleyDelKeys :: Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys =
      [Item
   (Map
      (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto))]
-> Map
     (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
        [ (KeyHash 'Genesis StandardCrypto
gh, KeyHash 'GenesisDelegate StandardCrypto
-> Hash StandardCrypto (VerKeyVRF StandardCrypto)
-> GenDelegPair StandardCrypto
forall c.
KeyHash 'GenesisDelegate c
-> Hash c (VerKeyVRF c) -> GenDelegPair c
L.GenDelegPair KeyHash 'GenesisDelegate StandardCrypto
gdh Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
        | ( GenesisKeyHash KeyHash 'Genesis StandardCrypto
gh
            , (GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
gdh, VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
            ) <-
            Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> [Item
      (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
forall l. IsList l => l -> [Item l]
toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
        ]

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

createDelegateKeys :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdError IO ()
createDelegateKeys :: KeyOutputFormat -> String -> Word -> ExceptT GenesisCmdError IO ()
createDelegateKeys KeyOutputFormat
fmt String
dir Word
index = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  GenesisKeyGenDelegateCmdArgs -> ExceptT GenesisCmdError IO ()
TN.runGenesisKeyGenDelegateCmd
    Cmd.GenesisKeyGenDelegateCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"
      , signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = File (SigningKey ()) 'InOut -> SigningKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (SigningKey ()) 'InOut
coldSK
      , opCertCounterPath :: OpCertCounterFile 'Out
Cmd.opCertCounterPath = File OpCertCounter 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File OpCertCounter 'InOut
opCertCtr
      }
  VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> ExceptT GenesisCmdError IO ()
TN.runGenesisKeyGenDelegateVRF
    (forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vrf.vkey")
    (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vrf.skey")
  (NodeCmdError -> GenesisCmdError)
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT NodeCmdError -> GenesisCmdError
GenesisCmdNodeCmdError (ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
        KeyOutputFormat
fmt
        (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (VerificationKey ()) 'InOut
kesVK)
        (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".kes.skey")
    NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> File OpCertCounter 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
        (VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (VerificationKey ()) 'InOut
kesVK))
        (File (SigningKey ()) 'InOut -> SigningKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (SigningKey ()) 'InOut
coldSK)
        File OpCertCounter 'InOut
opCertCtr
        (Word -> KESPeriod
KESPeriod Word
0)
        (String -> File () 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File () 'Out) -> String -> File () 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"opcert" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".cert")
 where
  strIndex :: String
strIndex = Word -> String
forall a. Show a => a -> String
show Word
index
  kesVK :: File (VerificationKey ()) 'InOut
kesVK = forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> File (VerificationKey ()) 'InOut)
-> String -> File (VerificationKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".kes.vkey"
  coldSK :: File (SigningKey ()) 'InOut
coldSK = forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> File (SigningKey ()) 'InOut)
-> String -> File (SigningKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey"
  opCertCtr :: File OpCertCounter 'InOut
opCertCtr = String -> File OpCertCounter 'InOut
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File OpCertCounter 'InOut)
-> String -> File OpCertCounter 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".counter"

createGenesisKeys :: FilePath -> Word -> ExceptT GenesisCmdError IO ()
createGenesisKeys :: String -> Word -> ExceptT GenesisCmdError IO ()
createGenesisKeys String
dir Word
index = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  let strIndex :: String
strIndex = Word -> String
forall a. Show a => a -> String
show Word
index
  GenesisKeyGenGenesisCmdArgs -> ExceptT GenesisCmdError IO ()
TN.runGenesisKeyGenGenesisCmd
    GenesisKeyGenGenesisCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath = forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"genesis" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"
      , signingKeyPath :: SigningKeyFile 'Out
signingKeyPath = forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"genesis" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey"
      }

createUtxoKeys :: FilePath -> Word -> ExceptT GenesisCmdError IO ()
createUtxoKeys :: String -> Word -> ExceptT GenesisCmdError IO ()
createUtxoKeys String
dir Word
index = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  let strIndex :: String
strIndex = Word -> String
forall a. Show a => a -> String
show Word
index
  GenesisKeyGenUTxOCmdArgs -> ExceptT GenesisCmdError IO ()
TN.runGenesisKeyGenUTxOCmd
    Cmd.GenesisKeyGenUTxOCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"utxo" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"
      , signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"utxo" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey"
      }

createPoolCredentials :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdError IO ()
createPoolCredentials :: KeyOutputFormat -> String -> Word -> ExceptT GenesisCmdError IO ()
createPoolCredentials KeyOutputFormat
fmt String
dir Word
index = do
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  (NodeCmdError -> GenesisCmdError)
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT NodeCmdError -> GenesisCmdError
GenesisCmdNodeCmdError (ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
        KeyOutputFormat
fmt
        (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (VerificationKey ()) 'InOut
kesVK)
        (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"kes" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey")
    NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenVrfCmd (NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenVRFCmdArgs
Cmd.NodeKeyGenVRFCmdArgs
        KeyOutputFormat
fmt
        (forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"vrf" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey")
        (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"vrf" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey")
    NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenColdCmd (NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> OpCertCounterFile 'Out
-> NodeKeyGenColdCmdArgs
Cmd.NodeKeyGenColdCmdArgs
        KeyOutputFormat
fmt
        (forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"cold" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey")
        (File (SigningKey ()) 'InOut -> SigningKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (SigningKey ()) 'InOut
coldSK)
        (File OpCertCounter 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File OpCertCounter 'InOut
opCertCtr)
    NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> File OpCertCounter 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
        (VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (VerificationKey ()) 'InOut
kesVK))
        (File (SigningKey ()) 'InOut -> SigningKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (SigningKey ()) 'InOut
coldSK)
        File OpCertCounter 'InOut
opCertCtr
        (Word -> KESPeriod
KESPeriod Word
0)
        (String -> File () 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File () 'Out) -> String -> File () 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"opcert" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".cert")
  (StakeAddressCmdError -> GenesisCmdError)
-> ExceptT StakeAddressCmdError IO ()
-> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeAddressCmdError -> GenesisCmdError
GenesisCmdStakeAddressCmdError (ExceptT StakeAddressCmdError IO ()
 -> ExceptT GenesisCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    ExceptT
  StakeAddressCmdError
  IO
  (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
   StakeAddressCmdError
   IO
   (VerificationKey StakeKey, SigningKey StakeKey)
 -> ExceptT StakeAddressCmdError IO ())
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
     StakeAddressCmdError
     IO
     (VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd
        KeyOutputFormat
fmt
        (forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"staking-reward" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey")
        (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"staking-reward" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey")
 where
  strIndex :: String
strIndex = Word -> String
forall a. Show a => a -> String
show Word
index
  kesVK :: File (VerificationKey ()) 'InOut
kesVK = forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> File (VerificationKey ()) 'InOut)
-> String -> File (VerificationKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"kes" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"
  coldSK :: File (SigningKey ()) 'InOut
coldSK = forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> File (SigningKey ()) 'InOut)
-> String -> File (SigningKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"cold" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey"
  opCertCtr :: File OpCertCounter 'InOut
opCertCtr = String -> File OpCertCounter 'InOut
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File OpCertCounter 'InOut)
-> String -> File OpCertCounter 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"opcert" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".counter"

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

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

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

  PoolParams StandardCrypto
-> ExceptT GenesisCmdError IO (PoolParams StandardCrypto)
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    L.PoolParams
      { ppId :: KeyHash 'StakePool StandardCrypto
L.ppId = VKey 'StakePool StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
L.hashKey VKey 'StakePool StandardCrypto
poolColdVK
      , ppVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
L.ppVrf = VerKeyVRF PraosVRF -> Hash Blake2b_256 (VerKeyVRF PraosVRF)
forall h.
HashAlgorithm h =>
VerKeyVRF PraosVRF -> Hash h (VerKeyVRF PraosVRF)
forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
L.hashVerKeyVRF VerKeyVRF PraosVRF
VerKeyVRF StandardCrypto
poolVrfVK
      , ppPledge :: Coin
L.ppPledge = Integer -> Coin
L.Coin Integer
0
      , ppCost :: Coin
L.ppCost = Integer -> Coin
L.Coin Integer
0
      , ppMargin :: UnitInterval
L.ppMargin = UnitInterval
forall a. Bounded a => a
minBound
      , ppRewardAccount :: RewardAccount StandardCrypto
L.ppRewardAccount =
          StakeAddress -> RewardAccount StandardCrypto
toShelleyStakeAddr (StakeAddress -> RewardAccount StandardCrypto)
-> StakeAddress -> RewardAccount StandardCrypto
forall a b. (a -> b) -> a -> b
$ NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
nw (StakeCredential -> StakeAddress)
-> StakeCredential -> StakeAddress
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
rewardsSVK)
      , ppOwners :: Set (KeyHash 'Staking StandardCrypto)
L.ppOwners = Set (KeyHash 'Staking StandardCrypto)
forall a. Monoid a => a
mempty
      , ppRelays :: StrictSeq StakePoolRelay
L.ppRelays = Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
specifiedRelays
      , ppMetadata :: StrictMaybe PoolMetadata
L.ppMetadata = StrictMaybe PoolMetadata
forall a. StrictMaybe a
L.SNothing
      }
 where
  lookupPoolRelay
    :: Map Word [L.StakePoolRelay] -> Seq.StrictSeq L.StakePoolRelay
  lookupPoolRelay :: Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
m =
    case Maybe Word
index of
      Maybe Word
Nothing -> StrictSeq StakePoolRelay
forall a. Monoid a => a
mempty
      Just Word
index' -> StrictSeq StakePoolRelay
-> ([StakePoolRelay] -> StrictSeq StakePoolRelay)
-> Maybe [StakePoolRelay]
-> StrictSeq StakePoolRelay
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StrictSeq StakePoolRelay
forall a. Monoid a => a
mempty [Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay
[StakePoolRelay] -> StrictSeq StakePoolRelay
forall l. IsList l => [Item l] -> l
fromList (Word -> Map Word [StakePoolRelay] -> Maybe [StakePoolRelay]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word
index' Map Word [StakePoolRelay]
m)

  strIndex :: String
strIndex = String -> (Word -> String) -> Maybe Word -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" Word -> String
forall a. Show a => a -> String
show Maybe Word
index
  poolColdVKF :: File Any 'In
poolColdVKF = String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File Any 'In) -> String -> File Any 'In
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"cold" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"
  poolVrfVKF :: File Any 'In
poolVrfVKF = String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File Any 'In) -> String -> File Any 'In
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"vrf" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"
  poolRewardVKF :: File Any 'In
poolRewardVKF = String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File Any 'In) -> String -> File Any 'In
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"staking-reward" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"

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

  readPoolCreds
    :: Word
    -> ExceptT
        GenesisCmdError
        IO
        (TextEnvelope, TextEnvelope, TextEnvelope)
  readPoolCreds :: Word
-> ExceptT
     GenesisCmdError IO (TextEnvelope, TextEnvelope, TextEnvelope)
readPoolCreds Word
ix = do
    (,,)
      (TextEnvelope
 -> TextEnvelope
 -> TextEnvelope
 -> (TextEnvelope, TextEnvelope, TextEnvelope))
-> ExceptT GenesisCmdError IO TextEnvelope
-> ExceptT
     GenesisCmdError
     IO
     (TextEnvelope
      -> TextEnvelope -> (TextEnvelope, TextEnvelope, TextEnvelope))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT GenesisCmdError IO TextEnvelope
readEnvelope String
poolOpCert
      ExceptT
  GenesisCmdError
  IO
  (TextEnvelope
   -> TextEnvelope -> (TextEnvelope, TextEnvelope, TextEnvelope))
-> ExceptT GenesisCmdError IO TextEnvelope
-> ExceptT
     GenesisCmdError
     IO
     (TextEnvelope -> (TextEnvelope, TextEnvelope, TextEnvelope))
forall a b.
ExceptT GenesisCmdError IO (a -> b)
-> ExceptT GenesisCmdError IO a -> ExceptT GenesisCmdError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExceptT GenesisCmdError IO TextEnvelope
readEnvelope String
poolVrfSKF
      ExceptT
  GenesisCmdError
  IO
  (TextEnvelope -> (TextEnvelope, TextEnvelope, TextEnvelope))
-> ExceptT GenesisCmdError IO TextEnvelope
-> ExceptT
     GenesisCmdError IO (TextEnvelope, TextEnvelope, TextEnvelope)
forall a b.
ExceptT GenesisCmdError IO (a -> b)
-> ExceptT GenesisCmdError IO a -> ExceptT GenesisCmdError IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExceptT GenesisCmdError IO TextEnvelope
readEnvelope String
poolKesSKF
   where
    strIndex :: String
strIndex = Word -> String
forall a. Show a => a -> String
show Word
ix
    poolOpCert :: String
poolOpCert = String
dir String -> String -> String
</> String
"opcert" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".cert"
    poolVrfSKF :: String
poolVrfSKF = String
dir String -> String -> String
</> String
"vrf" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey"
    poolKesSKF :: String
poolKesSKF = String
dir String -> String -> String
</> String
"kes" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey"
  readEnvelope :: FilePath -> ExceptT GenesisCmdError IO TextEnvelope
  readEnvelope :: String -> ExceptT GenesisCmdError IO TextEnvelope
readEnvelope String
fp = do
    ByteString
content <-
      (IOException -> GenesisCmdError)
-> IO ByteString -> ExceptT GenesisCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> GenesisCmdError
GenesisCmdFileError (FileError () -> GenesisCmdError)
-> (IOException -> FileError ()) -> IOException -> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO ByteString -> ExceptT GenesisCmdError IO ByteString)
-> IO ByteString -> ExceptT GenesisCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
        String -> IO ByteString
BS.readFile String
fp
    (String -> GenesisCmdError)
-> ExceptT String IO TextEnvelope
-> ExceptT GenesisCmdError IO TextEnvelope
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> GenesisCmdError
GenesisCmdFileDecodeError String
fp (Text -> GenesisCmdError)
-> (String -> Text) -> String -> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack) (ExceptT String IO TextEnvelope
 -> ExceptT GenesisCmdError IO TextEnvelope)
-> (Either String TextEnvelope -> ExceptT String IO TextEnvelope)
-> Either String TextEnvelope
-> ExceptT GenesisCmdError IO TextEnvelope
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Either String TextEnvelope -> ExceptT String IO TextEnvelope
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String TextEnvelope
 -> ExceptT GenesisCmdError IO TextEnvelope)
-> Either String TextEnvelope
-> ExceptT GenesisCmdError IO TextEnvelope
forall a b. (a -> b) -> a -> b
$
      ByteString -> Either String TextEnvelope
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
  -> L.PoolParams L.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) <- (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> (SigningKey PaymentKey, StdGen)
-> (VerificationKey PaymentKey, StdGen)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey ((SigningKey PaymentKey, StdGen)
 -> (VerificationKey PaymentKey, StdGen))
-> IO (SigningKey PaymentKey, StdGen)
-> IO (VerificationKey PaymentKey, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> AsType PaymentKey -> IO (SigningKey PaymentKey, StdGen)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole,
 SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> m (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g0 AsType PaymentKey
AsPaymentKey
  (VerificationKey StakeKey
stakeVK, StdGen
g2) <- (SigningKey StakeKey -> VerificationKey StakeKey)
-> (SigningKey StakeKey, StdGen)
-> (VerificationKey StakeKey, StdGen)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SigningKey StakeKey -> VerificationKey StakeKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey ((SigningKey StakeKey, StdGen)
 -> (VerificationKey StakeKey, StdGen))
-> IO (SigningKey StakeKey, StdGen)
-> IO (VerificationKey StakeKey, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> AsType StakeKey -> IO (SigningKey StakeKey, StdGen)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole,
 SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> m (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g1 AsType StakeKey
AsStakeKey

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

      delegation :: Delegation
delegation =
        Delegation
          { dInitialUtxoAddr :: AddressInEra ShelleyEra
dInitialUtxoAddr = ShelleyBasedEra ShelleyEra
-> Address ShelleyAddr -> AddressInEra ShelleyEra
forall era.
ShelleyBasedEra era -> Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley Address ShelleyAddr
initialUtxoAddr
          , dDelegStaking :: KeyHash 'Staking StandardCrypto
dDelegStaking = VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
L.hashKey (VerificationKey StakeKey -> VKey 'Staking StandardCrypto
unStakeVerificationKey VerificationKey StakeKey
stakeVK)
          , dPoolParams :: PoolParams StandardCrypto
dPoolParams = PoolParams StandardCrypto
pool
          }

  (StdGen, Delegation) -> IO (StdGen, Delegation)
forall a. a -> IO a
evaluate ((StdGen, Delegation) -> IO (StdGen, Delegation))
-> ((StdGen, Delegation) -> (StdGen, Delegation))
-> (StdGen, Delegation)
-> IO (StdGen, Delegation)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StdGen, Delegation) -> (StdGen, Delegation)
forall a. NFData a => a -> a
force ((StdGen, Delegation) -> IO (StdGen, Delegation))
-> (StdGen, Delegation) -> IO (StdGen, Delegation)
forall a b. (a -> b) -> a -> b
$ (StdGen
g2, Delegation
delegation)

-- | Attempts to read Shelley genesis from disk
-- and if not found creates a default Shelley genesis.
decodeShelleyGenesisWithDefault
  :: FilePath
  -> (ShelleyGenesis L.StandardCrypto -> ShelleyGenesis L.StandardCrypto)
  -> ExceptT GenesisCmdError IO (ShelleyGenesis L.StandardCrypto)
decodeShelleyGenesisWithDefault :: String
-> (ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto)
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
decodeShelleyGenesisWithDefault String
fpath ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto
adjustDefaults = do
  String
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
String -> t m (ShelleyGenesis StandardCrypto)
decodeShelleyGenesisFile String
fpath
    ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
-> (GenesisCmdError
    -> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto))
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall a.
ExceptT GenesisCmdError IO a
-> (GenesisCmdError -> ExceptT GenesisCmdError IO a)
-> ExceptT GenesisCmdError IO a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \GenesisCmdError
err ->
      case GenesisCmdError
err of
        GenesisCmdGenesisFileError (FileIOError String
_ IOException
ioe)
          | IOException -> Bool
isDoesNotExistError IOException
ioe -> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
writeDefault
        GenesisCmdError
_ -> GenesisCmdError
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
left GenesisCmdError
err
 where
  defaults :: ShelleyGenesis L.StandardCrypto
  defaults :: ShelleyGenesis StandardCrypto
defaults = ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto
adjustDefaults ShelleyGenesis StandardCrypto
shelleyGenesisDefaults

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

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 (L.KeyHash 'L.Staking L.StandardCrypto) (L.PoolParams L.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 L.StandardCrypto
  -- ^ Template from which to build a genesis
  -> ShelleyGenesis L.StandardCrypto
  -- ^ Updated genesis
updateTemplate :: SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Coin
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> ShelleyGenesis StandardCrypto
updateTemplate
  (SystemStart UTCTime
start)
  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
  Maybe Coin
mAmountNonDeleg
  [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
  Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs
  (L.Coin Integer
amountDeleg)
  [AddressInEra ShelleyEra]
utxoAddrsDeleg
  [AddressInEra ShelleyEra]
stuffedUtxoAddrs
  ShelleyGenesis StandardCrypto
template = do
    let pparamsFromTemplate :: PParams (ShelleyEra StandardCrypto)
pparamsFromTemplate = ShelleyGenesis StandardCrypto
-> PParams (ShelleyEra StandardCrypto)
forall c. ShelleyGenesis c -> PParams (ShelleyEra c)
sgProtocolParams ShelleyGenesis StandardCrypto
template
        shelleyGenesis :: ShelleyGenesis StandardCrypto
shelleyGenesis =
          ShelleyGenesis StandardCrypto
template
            { sgSystemStart = start
            , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin
            , sgGenDelegs = shelleyDelKeys
            , sgInitialFunds =
                fromList
                  [ (toShelleyAddr addr, v)
                  | (addr, v) <-
                      distribute (nonDelegCoin - subtractForTreasury) utxoAddrsNonDeleg
                        ++ distribute (delegCoin - subtractForTreasury) utxoAddrsDeleg
                        ++ mkStuffedUtxo stuffedUtxoAddrs
                  ]
            , sgStaking =
                ShelleyGenesisStaking
                  { sgsPools =
                      fromList
                        [ (L.ppId poolParams, poolParams)
                        | poolParams <- Map.elems poolSpecs
                        ]
                  , sgsStake = ListMap.fromMap $ L.ppId <$> poolSpecs
                  }
            , sgProtocolParams = pparamsFromTemplate
            }
    ShelleyGenesis StandardCrypto
shelleyGenesis
   where
    maximumLovelaceSupply :: Word64
    maximumLovelaceSupply :: Word64
maximumLovelaceSupply = ShelleyGenesis StandardCrypto -> Word64
forall c. ShelleyGenesis c -> Word64
sgMaxLovelaceSupply ShelleyGenesis StandardCrypto
template
    -- If the initial funds are equal to the maximum funds, rewards cannot be created.
    subtractForTreasury :: Integer
    subtractForTreasury :: Integer
subtractForTreasury = Integer
nonDelegCoin Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
10
    nonDelegCoin, delegCoin :: Integer
    nonDelegCoin :: Integer
nonDelegCoin = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> (Coin -> Word64) -> Maybe Coin -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
maximumLovelaceSupply Coin -> Word64
forall a. Integral a => Coin -> a
unLovelace Maybe Coin
mAmountNonDeleg)
    delegCoin :: Integer
delegCoin = Integer -> Integer
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, Coin)]
distribute Integer
funds [AddressInEra ShelleyEra]
addrs =
      ([(AddressInEra ShelleyEra, Coin)], Integer)
-> [(AddressInEra ShelleyEra, Coin)]
forall a b. (a, b) -> a
fst (([(AddressInEra ShelleyEra, Coin)], Integer)
 -> [(AddressInEra ShelleyEra, Coin)])
-> ([(AddressInEra ShelleyEra, Coin)], Integer)
-> [(AddressInEra ShelleyEra, Coin)]
forall a b. (a -> b) -> a -> b
$ (([(AddressInEra ShelleyEra, Coin)], Integer)
 -> AddressInEra ShelleyEra
 -> ([(AddressInEra ShelleyEra, Coin)], Integer))
-> ([(AddressInEra ShelleyEra, Coin)], Integer)
-> [AddressInEra ShelleyEra]
-> ([(AddressInEra ShelleyEra, Coin)], Integer)
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ([(AddressInEra ShelleyEra, Coin)], Integer)
-> AddressInEra ShelleyEra
-> ([(AddressInEra ShelleyEra, Coin)], Integer)
folder ([], Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
funds) [AddressInEra ShelleyEra]
addrs
     where
      nAddrs, coinPerAddr, splitThreshold :: Integer
      nAddrs :: Integer
nAddrs = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ [AddressInEra ShelleyEra] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AddressInEra ShelleyEra]
addrs
      coinPerAddr :: Integer
coinPerAddr = Integer
funds Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
nAddrs
      splitThreshold :: Integer
splitThreshold = Integer
coinPerAddr Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
nAddrs

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

    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Coin)]
mkStuffedUtxo [AddressInEra ShelleyEra]
xs = (,Integer -> Coin
L.Coin Integer
minUtxoVal) (AddressInEra ShelleyEra -> (AddressInEra ShelleyEra, Coin))
-> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddressInEra ShelleyEra]
xs
     where
      L.Coin Integer
minUtxoVal = ShelleyGenesis StandardCrypto
-> PParams (ShelleyEra StandardCrypto)
forall c. ShelleyGenesis c -> PParams (ShelleyEra c)
sgProtocolParams ShelleyGenesis StandardCrypto
template PParams (ShelleyEra StandardCrypto)
-> Getting Coin (PParams (ShelleyEra StandardCrypto)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams (ShelleyEra StandardCrypto)) Coin
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams (ShelleyEra StandardCrypto)) Coin
L.ppMinUTxOValueL

    shelleyDelKeys :: Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys =
      [Item
   (Map
      (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto))]
-> Map
     (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
        [ (KeyHash 'Genesis StandardCrypto
gh, KeyHash 'GenesisDelegate StandardCrypto
-> Hash StandardCrypto (VerKeyVRF StandardCrypto)
-> GenDelegPair StandardCrypto
forall c.
KeyHash 'GenesisDelegate c
-> Hash c (VerKeyVRF c) -> GenDelegPair c
L.GenDelegPair KeyHash 'GenesisDelegate StandardCrypto
gdh Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
        | ( GenesisKeyHash KeyHash 'Genesis StandardCrypto
gh
            , (GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
gdh, VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
            ) <-
            Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> [Item
      (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
forall l. IsList l => l -> [Item l]
toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
        ]

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

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

readGenDelegsMap
  :: FilePath
  -> FilePath
  -> ExceptT
      GenesisCmdError
      IO
      ( Map
          (Hash GenesisKey)
          (Hash GenesisDelegateKey, Hash VrfKey)
      )
readGenDelegsMap :: String
-> String
-> ExceptT
     GenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap String
gendir String
deldir = do
  Map Int (VerificationKey GenesisKey)
gkm <- String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
readGenesisKeys String
gendir
  Map Int (VerificationKey GenesisDelegateKey)
dkm <- String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys String
deldir
  Map Int (VerificationKey VrfKey)
vkm <- String
-> ExceptT GenesisCmdError 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 =
        (VerificationKey GenesisKey
 -> (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
 -> (VerificationKey GenesisKey,
     (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)))
-> Map Int (VerificationKey GenesisKey)
-> Map
     Int (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
          (,)
          Map Int (VerificationKey GenesisKey)
gkm
          ( (VerificationKey GenesisDelegateKey
 -> VerificationKey VrfKey
 -> (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisDelegateKey)
-> Map Int (VerificationKey VrfKey)
-> Map
     Int (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
              (,)
              Map Int (VerificationKey GenesisDelegateKey)
dkm
              Map Int (VerificationKey VrfKey)
vkm
          )

  -- All the maps should have an identical set of keys. Complain if not.
  let gkmExtra :: Map Int (VerificationKey GenesisKey)
gkmExtra = Map Int (VerificationKey GenesisKey)
gkm Map Int (VerificationKey GenesisKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
      dkmExtra :: Map Int (VerificationKey GenesisDelegateKey)
dkmExtra = Map Int (VerificationKey GenesisDelegateKey)
dkm Map Int (VerificationKey GenesisDelegateKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisDelegateKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
      vkmExtra :: Map Int (VerificationKey VrfKey)
vkmExtra = Map Int (VerificationKey VrfKey)
vkm Map Int (VerificationKey VrfKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey VrfKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
  Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map Int (VerificationKey GenesisKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey GenesisKey)
gkmExtra Bool -> Bool -> Bool
&& Map Int (VerificationKey GenesisDelegateKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey GenesisDelegateKey)
dkmExtra Bool -> Bool -> Bool
&& Map Int (VerificationKey VrfKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey VrfKey)
vkmExtra) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a. GenesisCmdError -> ExceptT GenesisCmdError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisCmdError -> ExceptT GenesisCmdError IO ())
-> GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      [Int] -> [Int] -> [Int] -> GenesisCmdError
GenesisCmdMismatchedGenesisKeyFiles
        (Map Int (VerificationKey GenesisKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisKey)
gkm)
        (Map Int (VerificationKey GenesisDelegateKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisDelegateKey)
dkm)
        (Map Int (VerificationKey VrfKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey VrfKey)
vkm)

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

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

readGenesisKeys
  :: FilePath
  -> ExceptT
      GenesisCmdError
      IO
      (Map Int (VerificationKey GenesisKey))
readGenesisKeys :: String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
readGenesisKeys String
gendir = do
  [String]
files <- IO [String] -> ExceptT GenesisCmdError IO [String]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
gendir)
  [(String, Int)]
fileIxs <-
    [String] -> ExceptT GenesisCmdError IO [(String, Int)]
extractFileNameIndexes
      [ String
gendir String -> String -> String
</> String
file
      | String
file <- [String]
files
      , String -> String
takeExtension String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey"
      ]
  (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisKey))
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError)
   IO
   (Map Int (VerificationKey GenesisKey))
 -> ExceptT
      GenesisCmdError IO (Map Int (VerificationKey GenesisKey)))
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisKey))
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall a b. (a -> b) -> a -> b
$
    [(Int, VerificationKey GenesisKey)]
-> Map Int (VerificationKey GenesisKey)
[Item (Map Int (VerificationKey GenesisKey))]
-> Map Int (VerificationKey GenesisKey)
forall l. IsList l => [Item l] -> l
fromList
      ([(Int, VerificationKey GenesisKey)]
 -> Map Int (VerificationKey GenesisKey))
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     [(Int, VerificationKey GenesisKey)]
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExceptT
   (FileError TextEnvelopeError) IO (Int, VerificationKey GenesisKey)]
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     [(Int, VerificationKey GenesisKey)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ (,) Int
ix (VerificationKey GenesisKey -> (Int, VerificationKey GenesisKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
-> ExceptT
     (FileError TextEnvelopeError) IO (Int, VerificationKey GenesisKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> File Any 'In
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
forall {content}.
File content 'In
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
readKey (String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File String
file)
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs
        ]
 where
  readKey :: File content 'In
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
readKey =
    IO
  (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
 -> ExceptT
      (FileError TextEnvelopeError) IO (VerificationKey GenesisKey))
-> (File content 'In
    -> IO
         (Either
            (FileError TextEnvelopeError) (VerificationKey GenesisKey)))
-> File content 'In
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (VerificationKey GenesisKey)
-> File content 'In
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisKey -> AsType (VerificationKey GenesisKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey)

readDelegateKeys
  :: FilePath
  -> ExceptT
      GenesisCmdError
      IO
      (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys :: String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys String
deldir = do
  [String]
files <- IO [String] -> ExceptT GenesisCmdError IO [String]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
deldir)
  [(String, Int)]
fileIxs <-
    [String] -> ExceptT GenesisCmdError IO [(String, Int)]
extractFileNameIndexes
      [ String
deldir String -> String -> String
</> String
file
      | String
file <- [String]
files
      , String -> String
takeExtensions String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey"
      ]
  (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError)
   IO
   (Map Int (VerificationKey GenesisDelegateKey))
 -> ExceptT
      GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey)))
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
forall a b. (a -> b) -> a -> b
$
    [(Int, VerificationKey GenesisDelegateKey)]
-> Map Int (VerificationKey GenesisDelegateKey)
[Item (Map Int (VerificationKey GenesisDelegateKey))]
-> Map Int (VerificationKey GenesisDelegateKey)
forall l. IsList l => [Item l] -> l
fromList
      ([(Int, VerificationKey GenesisDelegateKey)]
 -> Map Int (VerificationKey GenesisDelegateKey))
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     [(Int, VerificationKey GenesisDelegateKey)]
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExceptT
   (FileError TextEnvelopeError)
   IO
   (Int, VerificationKey GenesisDelegateKey)]
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     [(Int, VerificationKey GenesisDelegateKey)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ (,) Int
ix (VerificationKey GenesisDelegateKey
 -> (Int, VerificationKey GenesisDelegateKey))
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Int, VerificationKey GenesisDelegateKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> File Any 'In
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
forall {content}.
File content 'In
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
readKey (String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File String
file)
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs
        ]
 where
  readKey :: File content 'In
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
readKey =
    IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey GenesisDelegateKey))
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey GenesisDelegateKey))
 -> ExceptT
      (FileError TextEnvelopeError)
      IO
      (VerificationKey GenesisDelegateKey))
-> (File content 'In
    -> IO
         (Either
            (FileError TextEnvelopeError)
            (VerificationKey GenesisDelegateKey)))
-> File content 'In
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (VerificationKey GenesisDelegateKey)
-> File content 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisDelegateKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisDelegateKey
-> AsType (VerificationKey GenesisDelegateKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey)

readDelegateVrfKeys
  :: FilePath
  -> ExceptT
      GenesisCmdError
      IO
      (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys :: String
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys String
deldir = do
  [String]
files <- IO [String] -> ExceptT GenesisCmdError IO [String]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
deldir)
  [(String, Int)]
fileIxs <-
    [String] -> ExceptT GenesisCmdError IO [(String, Int)]
extractFileNameIndexes
      [ String
deldir String -> String -> String
</> String
file
      | String
file <- [String]
files
      , String -> String
takeExtensions String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vrf.vkey"
      ]
  (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (Map Int (VerificationKey VrfKey))
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (Map Int (VerificationKey VrfKey))
 -> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey)))
-> ExceptT
     (FileError TextEnvelopeError) IO (Map Int (VerificationKey VrfKey))
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
forall a b. (a -> b) -> a -> b
$
    [(Int, VerificationKey VrfKey)] -> Map Int (VerificationKey VrfKey)
[Item (Map Int (VerificationKey VrfKey))]
-> Map Int (VerificationKey VrfKey)
forall l. IsList l => [Item l] -> l
fromList
      ([(Int, VerificationKey VrfKey)]
 -> Map Int (VerificationKey VrfKey))
-> ExceptT
     (FileError TextEnvelopeError) IO [(Int, VerificationKey VrfKey)]
-> ExceptT
     (FileError TextEnvelopeError) IO (Map Int (VerificationKey VrfKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExceptT
   (FileError TextEnvelopeError) IO (Int, VerificationKey VrfKey)]
-> ExceptT
     (FileError TextEnvelopeError) IO [(Int, VerificationKey VrfKey)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ (,) Int
ix (VerificationKey VrfKey -> (Int, VerificationKey VrfKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
-> ExceptT
     (FileError TextEnvelopeError) IO (Int, VerificationKey VrfKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> File Any 'In
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
forall {content}.
File content 'In
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
readKey (String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File String
file)
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs
        ]
 where
  readKey :: File content 'In
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
readKey =
    IO (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
 -> ExceptT
      (FileError TextEnvelopeError) IO (VerificationKey VrfKey))
-> (File content 'In
    -> IO
         (Either (FileError TextEnvelopeError) (VerificationKey VrfKey)))
-> File content 'In
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (VerificationKey VrfKey)
-> File content 'In
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType VrfKey -> AsType (VerificationKey VrfKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey)

-- | 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 (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isDigit String
fp of
    [] -> Maybe Int
forall a. Maybe a
Nothing
    String
xs -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
xs

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

  [(String, Int)] -> ExceptT GenesisCmdError IO [(String, Int)]
forall a. a -> ExceptT GenesisCmdError IO a
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 GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses :: String
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses String
utxodir NetworkId
nw = do
  [String]
files <- IO [String] -> ExceptT GenesisCmdError IO [String]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
utxodir)
  [VerificationKey GenesisUTxOKey]
vkeys <-
    (FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
 -> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey])
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall a b. (a -> b) -> a -> b
$
      [ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)]
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
        [ IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
 -> ExceptT
      (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
            AsType (VerificationKey GenesisUTxOKey)
-> File Any 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope
              (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
              (String -> File Any 'In
forall content (direction :: FileDirection).
String -> File content direction
File (String
utxodir String -> String -> String
</> String
file))
        | String
file <- [String]
files
        , String -> String
takeExtension String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey"
        ]
  [AddressInEra ShelleyEra]
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
forall a. a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
    [ AddressInEra ShelleyEra
addr
    | VerificationKey GenesisUTxOKey
vkey <- [VerificationKey GenesisUTxOKey]
vkeys
    , let vkh :: Hash PaymentKey
vkh = VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey GenesisUTxOKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisUTxOKey
vkey)
          addr :: AddressInEra ShelleyEra
addr =
            ShelleyBasedEra ShelleyEra
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra ShelleyEra
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra
              ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
              NetworkId
nw
              (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
              StakeAddressReference
NoStakeAddress
    ]

-- | Hash a genesis file
runGenesisHashFileCmd :: GenesisFile -> ExceptT GenesisCmdError IO ()
runGenesisHashFileCmd :: GenesisFile -> ExceptT GenesisCmdError IO ()
runGenesisHashFileCmd (GenesisFile String
fpath) = do
  ByteString
content <-
    (IOException -> GenesisCmdError)
-> IO ByteString -> ExceptT GenesisCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> GenesisCmdError
GenesisCmdGenesisFileError (FileError () -> GenesisCmdError)
-> (IOException -> FileError ()) -> IOException -> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO ByteString -> ExceptT GenesisCmdError IO ByteString)
-> IO ByteString -> ExceptT GenesisCmdError IO ByteString
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 = (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
content
  IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (Hash Blake2b_256 ByteString -> Text
forall h a. Hash h a -> Text
Crypto.hashToTextAsHex Hash Blake2b_256 ByteString
gh)