{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}

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

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

import           Cardano.Prelude hiding (unlines)
import           Prelude (id, unlines, zip3, error)

import           Data.Aeson hiding (Key)
import qualified Data.Aeson as Aeson
import qualified Data.Aeson.KeyMap as Aeson
import           Data.Aeson.Encode.Pretty (encodePretty)
import qualified Data.Binary.Get as Bin
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import           Data.Coerce (coerce)
import qualified Data.List as List
import qualified Data.List.Split as List
import           Data.ListMap (ListMap(ListMap))
import qualified Data.ListMap as ListMap
import qualified Data.Map.Strict as Map

import qualified Data.Sequence.Strict as Seq
import           Data.String (fromString)
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import           Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime, secondsToNominalDiffTime)

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

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

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

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

import qualified Cardano.Crypto.Hash as Crypto

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

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

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

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

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

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

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

{- HLINT ignore "Reduce duplication" -}

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

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

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

--
-- Genesis command implementations
--

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


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

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


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


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


runGenesisKeyHash :: VerificationKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyHash :: VerificationKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisKeyHash (VerificationKeyFile String
vkeyPath) = do
    SomeGenesisKey VerificationKey
vkey <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (SomeGenesisKey VerificationKey)
-> ExceptT
     ShelleyGenesisCmdError IO (SomeGenesisKey VerificationKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (SomeGenesisKey VerificationKey)
 -> ExceptT
      ShelleyGenesisCmdError IO (SomeGenesisKey VerificationKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (SomeGenesisKey VerificationKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
-> ExceptT
     ShelleyGenesisCmdError IO (SomeGenesisKey VerificationKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
      ShelleyGenesisCmdError IO (SomeGenesisKey VerificationKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
-> ExceptT
     ShelleyGenesisCmdError IO (SomeGenesisKey VerificationKey)
forall a b. (a -> b) -> a -> b
$
            [FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)]
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
forall b.
[FromSomeType HasTextEnvelope b]
-> String -> 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
              ]
              String
vkeyPath
    IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError 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 :: 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VerificationKey keyrole -> Hash keyrole
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash


runGenesisVerKey :: VerificationKeyFile -> SigningKeyFile
                 -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisVerKey :: VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisVerKey (VerificationKeyFile String
vkeyPath) (SigningKeyFile String
skeyPath) = do
    SomeGenesisKey SigningKey
skey <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (SomeGenesisKey SigningKey)
-> ExceptT ShelleyGenesisCmdError IO (SomeGenesisKey SigningKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (SomeGenesisKey SigningKey)
 -> ExceptT ShelleyGenesisCmdError IO (SomeGenesisKey SigningKey))
-> (IO
      (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (SomeGenesisKey SigningKey))
-> IO
     (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
-> ExceptT ShelleyGenesisCmdError IO (SomeGenesisKey SigningKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyGenesisCmdError IO (SomeGenesisKey SigningKey))
-> IO
     (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
-> ExceptT ShelleyGenesisCmdError IO (SomeGenesisKey SigningKey)
forall a b. (a -> b) -> a -> b
$
            [FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)]
-> String
-> IO
     (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
forall b.
[FromSomeType HasTextEnvelope b]
-> String -> 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
              ]
              String
skeyPath

    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 =>
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 =>
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 =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisUTxOKey
sk)

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

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


runGenesisTxIn :: VerificationKeyFile -> NetworkId -> Maybe OutputFile
               -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisTxIn :: VerificationKeyFile
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisTxIn (VerificationKeyFile String
vkeyPath) NetworkId
network Maybe OutputFile
mOutFile = do
    VerificationKey GenesisUTxOKey
vkey <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
-> ExceptT
     ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
 -> ExceptT
      ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
      ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
            AsType (VerificationKey GenesisUTxOKey)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey) String
vkeyPath
    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 ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe OutputFile -> Text -> IO ()
writeOutput Maybe OutputFile
mOutFile (TxIn -> Text
renderTxIn TxIn
txin)


runGenesisAddr :: VerificationKeyFile -> NetworkId -> Maybe OutputFile
               -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisAddr :: VerificationKeyFile
-> NetworkId
-> Maybe OutputFile
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisAddr (VerificationKeyFile String
vkeyPath) NetworkId
network Maybe OutputFile
mOutFile = do
    VerificationKey GenesisUTxOKey
vkey <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
-> ExceptT
     ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
 -> ExceptT
      ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
      ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     ShelleyGenesisCmdError IO (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
            AsType (VerificationKey GenesisUTxOKey)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey) String
vkeyPath
    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 ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Maybe OutputFile -> Text -> IO ()
writeOutput Maybe OutputFile
mOutFile (Address ShelleyAddr -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress Address ShelleyAddr
addr)

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


--
-- Create Genesis command implementation
--

runGenesisCreate :: GenesisDir
                 -> Word  -- ^ num genesis & delegate keys to make
                 -> Word  -- ^ num utxo keys to make
                 -> Maybe SystemStart
                 -> Maybe Lovelace
                 -> NetworkId
                 -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreate :: GenesisDir
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Lovelace
-> NetworkId
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreate (GenesisDir String
rootdir)
                 Word
genNumGenesisKeys Word
genNumUTxOKeys
                 Maybe SystemStart
mStart Maybe Lovelace
mAmount NetworkId
network = do
  IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError 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 StandardShelley
template <- String
-> (ShelleyGenesis StandardShelley
    -> ShelleyGenesis StandardShelley)
-> ExceptT
     ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
readShelleyGenesisWithDefault (String
rootdir String -> ShowS
</> String
"genesis.spec.json") ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustTemplate
  AlonzoGenesis
alonzoGenesis <- String -> ExceptT ShelleyGenesisCmdError IO AlonzoGenesis
readAlonzoGenesis (String
rootdir String -> ShowS
</> String
"genesis.alonzo.spec.json")

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

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

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

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

  String
-> ShelleyGenesis StandardShelley
-> ExceptT ShelleyGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT ShelleyGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.json")        ShelleyGenesis StandardShelley
shelleyGenesis
  String -> AlonzoGenesis -> ExceptT ShelleyGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT ShelleyGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.alonzo.json") AlonzoGenesis
alonzoGenesis
  --TODO: rationalise the naming convention on these genesis json files.
  where
    adjustTemplate :: ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustTemplate ShelleyGenesis StandardShelley
t = ShelleyGenesis StandardShelley
t { sgNetworkMagic :: Word32
sgNetworkMagic = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
network) }
    gendir :: String
gendir  = String
rootdir String -> ShowS
</> String
"genesis-keys"
    deldir :: String
deldir  = String
rootdir String -> ShowS
</> String
"delegate-keys"
    utxodir :: String
utxodir = String
rootdir String -> ShowS
</> String
"utxo-keys"


toSKeyJSON :: Key a => SigningKey a -> ByteString
toSKeyJSON :: SigningKey a -> ByteString
toSKeyJSON = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (SigningKey a -> ByteString) -> SigningKey a -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 => SigningKey a -> ByteString
toVkeyJSON :: SigningKey a -> ByteString
toVkeyJSON = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (SigningKey a -> ByteString) -> SigningKey a -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey a -> VerificationKey a
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey

toVkeyJSON' :: Key a => VerificationKey a -> ByteString
toVkeyJSON' :: VerificationKey a -> ByteString
toVkeyJSON' = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (VerificationKey a -> ByteString)
-> VerificationKey a
-> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey
forall keyrole.
Key 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 keyrole.
Key keyrole =>
AsType keyrole -> IO (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 keyrole.
Key keyrole =>
AsType keyrole -> IO (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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey KesKey -> VerificationKey KesKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey [SigningKey KesKey]
kesKeys) [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys
    createOpCert :: (VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey) -> (OperationalCertificate, OperationalCertificateIssueCounter)
    createOpCert :: (VerificationKey KesKey, SigningKey GenesisDelegateExtendedKey)
-> (OperationalCertificate, OperationalCertificateIssueCounter)
createOpCert (VerificationKey KesKey
kesKey, SigningKey GenesisDelegateExtendedKey
delegateKey) = (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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. OperationalCertIssueError -> String
forall a b. (Show a, ConvertText String b) => a -> b
show) (OperationalCertificate, OperationalCertificateIssueCounter)
-> (OperationalCertificate, OperationalCertificateIssueCounter)
forall (cat :: * -> * -> *) a. Category cat => cat a a
identity 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
convert (VerificationKey GenesisDelegateExtendedKey
 -> VerificationKey StakePoolKey)
-> (SigningKey GenesisDelegateExtendedKey
    -> VerificationKey GenesisDelegateExtendedKey)
-> SigningKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey (SigningKey GenesisDelegateExtendedKey
 -> VerificationKey StakePoolKey)
-> SigningKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
forall a b. (a -> b) -> a -> b
$ SigningKey GenesisDelegateExtendedKey
delegateKey)
        convert :: VerificationKey GenesisDelegateExtendedKey
                -> VerificationKey StakePoolKey
        convert :: VerificationKey GenesisDelegateExtendedKey
-> VerificationKey StakePoolKey
convert = (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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey VrfKey -> VerificationKey VrfKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey [SigningKey VrfKey]
vrfKeys
    combinedMap :: [ ( VerificationKey GenesisKey
                     , VerificationKey GenesisDelegateKey
                     , VerificationKey VrfKey
                     )
                   ]
    combinedMap :: [(VerificationKey GenesisKey, VerificationKey GenesisDelegateKey,
  VerificationKey VrfKey)]
combinedMap = [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)
forall k a. Ord k => [(k, a)] -> Map k a
Map.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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 (m :: * -> *) a. Monad m => a -> m a
return (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegateMap, [SigningKey VrfKey]
vrfKeys, [SigningKey KesKey]
kesKeys, [(OperationalCertificate, OperationalCertificateIssueCounter)]
opCerts)

--
-- Create Genesis Cardano command implementation
--

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

    genesisKeys :: [SigningKey]
genesisKeys = GeneratedSecrets -> [SigningKey]
gsDlgIssuersSecrets GeneratedSecrets
byronSecrets
    byronGenesisKeys :: [SigningKey ByronKey]
byronGenesisKeys = (SigningKey -> SigningKey ByronKey)
-> [SigningKey] -> [SigningKey ByronKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey -> SigningKey ByronKey
ByronSigningKey [SigningKey]
genesisKeys
    shelleyGenesisKeys :: [SigningKey GenesisExtendedKey]
shelleyGenesisKeys = (SigningKey -> SigningKey GenesisExtendedKey)
-> [SigningKey] -> [SigningKey GenesisExtendedKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey -> SigningKey GenesisExtendedKey
convertGenesisKey [SigningKey]
genesisKeys
    shelleyGenesisvkeys :: [VerificationKey GenesisKey]
    shelleyGenesisvkeys :: [VerificationKey GenesisKey]
shelleyGenesisvkeys = (SigningKey GenesisExtendedKey -> VerificationKey GenesisKey)
-> [SigningKey GenesisExtendedKey] -> [VerificationKey GenesisKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey GenesisExtendedKey -> VerificationKey GenesisExtendedKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey) [SigningKey GenesisExtendedKey]
shelleyGenesisKeys

    delegateKeys :: [SigningKey]
delegateKeys = GeneratedSecrets -> [SigningKey]
gsRichSecrets GeneratedSecrets
byronSecrets
    byronDelegateKeys :: [SigningKey ByronKey]
byronDelegateKeys = (SigningKey -> SigningKey ByronKey)
-> [SigningKey] -> [SigningKey ByronKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey -> SigningKey ByronKey
ByronSigningKey [SigningKey]
delegateKeys
    shelleyDelegateKeys :: [SigningKey GenesisDelegateExtendedKey]
    shelleyDelegateKeys :: [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys = (SigningKey -> SigningKey GenesisDelegateExtendedKey)
-> [SigningKey] -> [SigningKey GenesisDelegateExtendedKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey -> SigningKey GenesisDelegateExtendedKey
convertDelegate [SigningKey]
delegateKeys
    shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey]
    shelleyDelegatevkeys :: [VerificationKey GenesisDelegateKey]
shelleyDelegatevkeys = (SigningKey GenesisDelegateExtendedKey
 -> VerificationKey GenesisDelegateKey)
-> [SigningKey GenesisDelegateExtendedKey]
-> [VerificationKey GenesisDelegateKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SigningKey GenesisDelegateExtendedKey
-> VerificationKey GenesisDelegateExtendedKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey) [SigningKey GenesisDelegateExtendedKey]
shelleyDelegateKeys

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

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

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

    String -> ByteString -> IO ()
LBS.writeFile (String
rootdir String -> ShowS
</> String
"byron-genesis.json") (GenesisData -> ByteString
forall a. ToJSON Identity a => a -> ByteString
canonicalEncodePretty GenesisData
byronGenesis)
  String
-> ShelleyGenesis StandardShelley
-> ExceptT ShelleyGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT ShelleyGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"shelley-genesis.json") ShelleyGenesis StandardShelley
shelleyGenesis
  String -> AlonzoGenesis -> ExceptT ShelleyGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT ShelleyGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"alonzo-genesis.json") AlonzoGenesis
alonzoGenesis

  IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    case Maybe String
mNodeCfg of
      Maybe String
Nothing -> () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just String
nodeCfg -> do
        Value
nodeConfig <- String -> IO Value
forall (m :: * -> *) a. (MonadIO m, FromJSON a) => String -> m a
Yaml.decodeFileThrow String
nodeCfg
        let
          hashShelleyGenesis :: ToJSON genesis => genesis -> Text
          hashShelleyGenesis :: genesis -> Text
hashShelleyGenesis genesis
genesis = Hash Blake2b_256 ByteString -> Text
forall h a. Hash h a -> Text
Crypto.hashToTextAsHex Hash Blake2b_256 ByteString
gh
            where
              content :: ByteString
              content :: ByteString
content = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ genesis -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty genesis
genesis
              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
          hashByronGenesis :: Genesis.GenesisData -> Text
          hashByronGenesis :: GenesisData -> Text
hashByronGenesis GenesisData
genesis = Hash Blake2b_256 ByteString -> Text
forall h a. Hash h a -> Text
Crypto.hashToTextAsHex Hash Blake2b_256 ByteString
genesisHash
            where
              genesisHash :: Crypto.Hash Crypto.Blake2b_256 ByteString
              genesisHash :: Hash Blake2b_256 ByteString
genesisHash = (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 -> Hash Blake2b_256 ByteString)
-> (GenesisData -> ByteString)
-> GenesisData
-> Hash Blake2b_256 ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> ByteString
LBS.toStrict
                  (ByteString -> ByteString)
-> (GenesisData -> ByteString) -> GenesisData -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. JSValue -> ByteString
renderCanonicalJSON
                  (JSValue -> ByteString)
-> (GenesisData -> JSValue) -> GenesisData -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String -> JSValue)
-> (JSValue -> JSValue) -> Either String JSValue -> JSValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> String -> JSValue
forall a. HasCallStack => String -> a
error String
"error parsing json that was just encoded!?") JSValue -> JSValue
forall (cat :: * -> * -> *) a. Category cat => cat a a
identity
                  (Either String JSValue -> JSValue)
-> (GenesisData -> Either String JSValue) -> GenesisData -> JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ByteString -> Either String JSValue
parseCanonicalJSON
                  (ByteString -> Either String JSValue)
-> (GenesisData -> ByteString)
-> GenesisData
-> Either String JSValue
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GenesisData -> ByteString
forall a. ToJSON Identity a => a -> ByteString
canonicalEncodePretty (GenesisData -> Hash Blake2b_256 ByteString)
-> GenesisData -> Hash Blake2b_256 ByteString
forall a b. (a -> b) -> a -> b
$ GenesisData
genesis
          -- TODO, NodeConfig needs a ToJSON instance
          updateConfig :: Yaml.Value -> Yaml.Value
          updateConfig :: Value -> Value
updateConfig (Object Object
obj) = Object -> Value
Object
              (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.insert Key
"ByronGenesisHash" (Value -> Object -> Object)
-> (GenesisData -> Value) -> GenesisData -> Object -> Object
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Value
String (Text -> Value) -> (GenesisData -> Text) -> GenesisData -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. GenesisData -> Text
hashByronGenesis) GenesisData
byronGenesis
              (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.insert Key
"ShelleyGenesisHash" (Value -> Object -> Object)
-> (ShelleyGenesis StandardShelley -> Value)
-> ShelleyGenesis StandardShelley
-> Object
-> Object
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Value
String (Text -> Value)
-> (ShelleyGenesis StandardShelley -> Text)
-> ShelleyGenesis StandardShelley
-> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ShelleyGenesis StandardShelley -> Text
forall genesis. ToJSON genesis => genesis -> Text
hashShelleyGenesis) ShelleyGenesis StandardShelley
shelleyGenesis
              (Object -> Object) -> Object -> Object
forall a b. (a -> b) -> a -> b
$ (Key -> Value -> Object -> Object
forall v. Key -> v -> KeyMap v -> KeyMap v
Aeson.insert Key
"AlonzoGenesisHash"  (Value -> Object -> Object)
-> (AlonzoGenesis -> Value) -> AlonzoGenesis -> Object -> Object
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Value
String (Text -> Value)
-> (AlonzoGenesis -> Text) -> AlonzoGenesis -> Value
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AlonzoGenesis -> Text
forall genesis. ToJSON genesis => genesis -> Text
hashShelleyGenesis) AlonzoGenesis
alonzoGenesis
              Object
obj
          updateConfig Value
x = Value
x
          newConfig :: Yaml.Value
          newConfig :: Value
newConfig = Value -> Value
updateConfig Value
nodeConfig
        String -> Value -> IO ()
forall a. ToJSON a => String -> a -> IO ()
encodeFile (String
rootdir String -> ShowS
</> String
"node-config.json") Value
newConfig

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

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

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

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

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

    findDelegateCert :: Genesis.GenesisData -> SigningKey ByronKey -> ExceptT ByronGenesisError IO Dlg.Certificate
    findDelegateCert :: GenesisData
-> SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert GenesisData
byronGenesis bSkey :: SigningKey ByronKey
bSkey@(ByronSigningKey sk) = do
      case (Certificate -> Bool) -> [Certificate] -> Maybe Certificate
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByronGenesisError
NoGenesisDelegationForKey
                   (Text -> ByronGenesisError)
-> (VerificationKey ByronKey -> Text)
-> VerificationKey ByronKey
-> ByronGenesisError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey ByronKey
bSkey
        Just Certificate
x  -> Certificate -> ExceptT ByronGenesisError IO Certificate
forall (f :: * -> *) a. Applicative f => a -> f a
pure Certificate
x

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

runGenesisCreateStaked
  :: GenesisDir
  -> Word           -- ^ num genesis & delegate keys to make
  -> Word           -- ^ num utxo keys to make
  -> Word           -- ^ num pools to make
  -> Word           -- ^ num delegators to make
  -> Maybe SystemStart
  -> Maybe Lovelace -- ^ supply going to non-delegators
  -> Lovelace       -- ^ supply going to delegators
  -> NetworkId
  -> Word           -- ^ bulk credential files to write
  -> Word           -- ^ pool credentials per bulk file
  -> Word           -- ^ num stuffed UTxO entries
  -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreateStaked :: GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Lovelace
-> Lovelace
-> NetworkId
-> Word
-> Word
-> Word
-> ExceptT ShelleyGenesisCmdError IO ()
runGenesisCreateStaked (GenesisDir String
rootdir)
                 Word
genNumGenesisKeys Word
genNumUTxOKeys Word
genNumPools Word
genNumStDelegs
                 Maybe SystemStart
mStart Maybe Lovelace
mNonDlgAmount Lovelace
stDlgAmount NetworkId
network
                 Word
bulkPoolCredFiles Word
bulkPoolsPerFile Word
numStuffedUtxo = do
  IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError 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 StandardShelley
template <- String
-> (ShelleyGenesis StandardShelley
    -> ShelleyGenesis StandardShelley)
-> ExceptT
     ShelleyGenesisCmdError IO (ShelleyGenesis StandardShelley)
readShelleyGenesisWithDefault (String
rootdir String -> ShowS
</> String
"genesis.spec.json") ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustTemplate
  AlonzoGenesis
alonzoGenesis <- String -> ExceptT ShelleyGenesisCmdError IO AlonzoGenesis
readAlonzoGenesis (String
rootdir String -> ShowS
</> String
"genesis.alonzo.spec.json")

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

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

  [PoolParams StandardCrypto]
pools <- [Word]
-> (Word
    -> ExceptT ShelleyGenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT ShelleyGenesisCmdError IO [PoolParams StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ Word
1 .. Word
genNumPools ] ((Word
  -> ExceptT ShelleyGenesisCmdError IO (PoolParams StandardCrypto))
 -> ExceptT ShelleyGenesisCmdError IO [PoolParams StandardCrypto])
-> (Word
    -> ExceptT ShelleyGenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT ShelleyGenesisCmdError IO [PoolParams StandardCrypto]
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
    String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createPoolCredentials String
pooldir Word
index
    NetworkId
-> String
-> Word
-> ExceptT ShelleyGenesisCmdError IO (PoolParams StandardCrypto)
buildPool NetworkId
network String
pooldir Word
index

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

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

  [Delegation]
delegations :: [Delegation] <-
    -- Distribute M delegates across N pools:
    [(PoolParams StandardCrypto, Word)]
-> ((PoolParams StandardCrypto, Word)
    -> ExceptT ShelleyGenesisCmdError IO Delegation)
-> ExceptT ShelleyGenesisCmdError IO [Delegation]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [ (PoolParams StandardCrypto
pool, Word
delegIx)
         | (PoolParams StandardCrypto
pool, Word
poolIx) <- [PoolParams StandardCrypto]
-> [Word] -> [(PoolParams StandardCrypto, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PoolParams StandardCrypto]
pools [Word
1 ..]
         , Word
delegIxLocal <- [ Word
1 .. Word
delegsPerPool ] [Word] -> [Word] -> [Word]
forall a. [a] -> [a] -> [a]
++
                           -- Add all remaining delegates to the last pool:
                           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
genNumPools
                           then [ Word
delegsPerPool Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1 .. Word
delegsPerPool Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
delegsRemaining ]
                           else []
         , let delegIx :: Word
delegIx = Word
delegIxLocal Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
delegsPerPool Word -> Word -> Word
forall a. Num a => a -> a -> a
* (Word
poolIx Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)] (((PoolParams StandardCrypto, Word)
  -> ExceptT ShelleyGenesisCmdError IO Delegation)
 -> ExceptT ShelleyGenesisCmdError IO [Delegation])
-> ((PoolParams StandardCrypto, Word)
    -> ExceptT ShelleyGenesisCmdError IO Delegation)
-> ExceptT ShelleyGenesisCmdError IO [Delegation]
forall a b. (a -> b) -> a -> b
$
      (PoolParams StandardCrypto
 -> Word -> ExceptT ShelleyGenesisCmdError IO Delegation)
-> (PoolParams StandardCrypto, Word)
-> ExceptT ShelleyGenesisCmdError IO Delegation
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (NetworkId
-> String
-> PoolParams StandardCrypto
-> Word
-> ExceptT ShelleyGenesisCmdError IO Delegation
computeDelegation NetworkId
network String
stdeldir)

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

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

  let poolMap :: Map (Ledger.KeyHash Ledger.Staking StandardCrypto) (Ledger.PoolParams StandardCrypto)
      poolMap :: Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolMap = [(KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)]
 -> Map
      (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto))
-> [(KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
forall a b. (a -> b) -> a -> b
$ Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry (Delegation
 -> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto))
-> [Delegation]
-> [(KeyHash 'Staking StandardCrypto, 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 StandardShelley
shelleyGenesis =
        SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Lovelace
-> [AddressInEra ShelleyEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Lovelace
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardShelley
-> ShelleyGenesis StandardShelley
updateTemplate
          -- Shelley genesis parameters
          SystemStart
start Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs Maybe Lovelace
mNonDlgAmount [AddressInEra ShelleyEra]
nonDelegAddrs Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolMap
          Lovelace
stDlgAmount [AddressInEra ShelleyEra]
delegAddrs [AddressInEra ShelleyEra]
stuffedUtxoAddrs ShelleyGenesis StandardShelley
template

  String
-> ShelleyGenesis StandardShelley
-> ExceptT ShelleyGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT ShelleyGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.json")        ShelleyGenesis StandardShelley
shelleyGenesis
  String -> AlonzoGenesis -> ExceptT ShelleyGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT ShelleyGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.alonzo.json") AlonzoGenesis
alonzoGenesis
  --TODO: rationalise the naming convention on these genesis json files.

  IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (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
genNumGenesisKeys, Text
" genesis keys, "
    , Word -> Text
forall a. Show a => a -> Text
textShow Word
genNumUTxOKeys, Text
" non-delegating UTxO keys, "
    , Word -> Text
forall a. Show a => a -> Text
textShow Word
genNumPools, Text
" stake pools, "
    , Word -> Text
forall a. Show a => a -> Text
textShow Word
genNumStDelegs, Text
" delegating UTxO keys, "
    , Int -> Text
forall a. Show a => a -> Text
textShow ([Delegation] -> Int
forall a. HasLength a => a -> Int
length [Delegation]
delegations), Text
" delegation relationships, "
    , Int -> Text
forall a. Show a => a -> Text
textShow (Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Int
forall k a. Map k a -> Int
Map.size Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolMap), Text
" delegation map entries, "
    , Int -> Text
forall a. Show a => a -> Text
textShow ([AddressInEra ShelleyEra] -> Int
forall a. HasLength a => a -> Int
length [AddressInEra ShelleyEra]
delegAddrs), Text
" delegating addresses"
    ] [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
bulkPoolCredFiles, Text
" bulk pool credential files, "
      , Word -> Text
forall a. Show a => a -> Text
textShow Word
bulkPoolsPerFile, 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. HasLength a => 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. HasLength a => a -> Int
length ([Word] -> Int) -> [[Word]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Word]]
bulkSlices
      ]
    | Word
bulkPoolCredFiles Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
bulkPoolsPerFile Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0 ]

  where
    (,) Word
delegsPerPool Word
delegsRemaining = Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
divMod Word
genNumStDelegs Word
genNumPools
    adjustTemplate :: ShelleyGenesis StandardShelley -> ShelleyGenesis StandardShelley
adjustTemplate ShelleyGenesis StandardShelley
t = ShelleyGenesis StandardShelley
t { sgNetworkMagic :: Word32
sgNetworkMagic = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
network) }
    mkDelegationMapEntry :: Delegation -> (Ledger.KeyHash Ledger.Staking StandardCrypto, Ledger.PoolParams StandardCrypto)
    mkDelegationMapEntry :: Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry Delegation
d = (Delegation -> KeyHash 'Staking StandardCrypto
dDelegStaking Delegation
d, Delegation -> PoolParams StandardCrypto
dPoolParams Delegation
d)

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

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

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

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

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

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

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

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


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

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

createDelegatorCredentials :: FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createDelegatorCredentials :: String -> Word -> ExceptT ShelleyGenesisCmdError IO ()
createDelegatorCredentials String
dir Word
index = do
  IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  (ShelleyAddressCmdError -> ShelleyGenesisCmdError)
-> ExceptT ShelleyAddressCmdError IO ()
-> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyAddressCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdAddressCmdError (ExceptT ShelleyAddressCmdError IO ()
 -> ExceptT ShelleyGenesisCmdError IO ())
-> ExceptT ShelleyAddressCmdError IO ()
-> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
    AddressKeyType
-> VerificationKeyFile
-> SigningKeyFile
-> ExceptT ShelleyAddressCmdError IO ()
runAddressKeyGen
        AddressKeyType
AddressKeyShelley
        VerificationKeyFile
addrVK
        (String -> SigningKeyFile
SigningKeyFile (String -> SigningKeyFile) -> String -> SigningKeyFile
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"payment" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".skey")
  (ShelleyStakeAddressCmdError -> ShelleyGenesisCmdError)
-> ExceptT ShelleyStakeAddressCmdError IO ()
-> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyStakeAddressCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdStakeAddressCmdError (ExceptT ShelleyStakeAddressCmdError IO ()
 -> ExceptT ShelleyGenesisCmdError IO ())
-> ExceptT ShelleyStakeAddressCmdError IO ()
-> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile
-> SigningKeyFile -> ExceptT ShelleyStakeAddressCmdError IO ()
runStakeAddressKeyGen
        (String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile) -> String -> VerificationKeyFile
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"staking" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey")
        (String -> SigningKeyFile
SigningKeyFile (String -> SigningKeyFile) -> String -> SigningKeyFile
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"staking" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".skey")
 where
   strIndex :: String
strIndex = Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
index
   addrVK :: VerificationKeyFile
addrVK = String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile) -> String -> VerificationKeyFile
forall a b. (a -> b) -> a -> b
$ String
dir String -> ShowS
</> String
"payment" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"

data Delegation
  = Delegation
    { Delegation -> AddressInEra ShelleyEra
dInitialUtxoAddr  :: AddressInEra ShelleyEra
    , Delegation -> KeyHash 'Staking StandardCrypto
dDelegStaking     :: Ledger.KeyHash Ledger.Staking StandardCrypto
    , Delegation -> PoolParams StandardCrypto
dPoolParams       :: Ledger.PoolParams StandardCrypto
    }

buildPool :: NetworkId -> FilePath -> Word -> ExceptT ShelleyGenesisCmdError IO (Ledger.PoolParams StandardCrypto)
buildPool :: NetworkId
-> String
-> Word
-> ExceptT ShelleyGenesisCmdError IO (PoolParams StandardCrypto)
buildPool NetworkId
nw String
dir Word
index = do
    StakePoolVerificationKey poolColdVK <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (ShelleyPoolCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdPoolCmdError
                                                         (ShelleyPoolCmdError -> ShelleyGenesisCmdError)
-> (FileError TextEnvelopeError -> ShelleyPoolCmdError)
-> FileError TextEnvelopeError
-> ShelleyGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FileError TextEnvelopeError -> ShelleyPoolCmdError
ShelleyPoolCmdReadFileError)
      (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
 -> ExceptT
      ShelleyGenesisCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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
      ShelleyGenesisCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakePoolKey)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakePoolKey -> AsType (VerificationKey StakePoolKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolKey
AsStakePoolKey) String
poolColdVKF
    VrfVerificationKey poolVrfVK <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (ShelleyNodeCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdNodeCmdError
                                                  (ShelleyNodeCmdError -> ShelleyGenesisCmdError)
-> (FileError TextEnvelopeError -> ShelleyNodeCmdError)
-> FileError TextEnvelopeError
-> ShelleyGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FileError TextEnvelopeError -> ShelleyNodeCmdError
ShelleyNodeCmdReadFileError)
      (ExceptT (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
 -> ExceptT ShelleyGenesisCmdError IO (VerificationKey VrfKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey VrfKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey VrfKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyGenesisCmdError IO (VerificationKey VrfKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey VrfKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType VrfKey -> AsType (VerificationKey VrfKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey) String
poolVrfVKF
    VerificationKey StakeKey
rewardsSVK <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError
      (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
 -> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakeKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakeKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyGenesisCmdError IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakeKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakeKey -> AsType (VerificationKey StakeKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakeKey
AsStakeKey) String
poolRewardVKF
    PoolParams StandardCrypto
-> ExceptT ShelleyGenesisCmdError IO (PoolParams StandardCrypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PoolParams :: forall crypto.
KeyHash 'StakePool crypto
-> Hash crypto (VerKeyVRF crypto)
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt crypto
-> Set (KeyHash 'Staking crypto)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams crypto
Ledger.PoolParams
      { _poolId :: KeyHash 'StakePool StandardCrypto
Ledger._poolId     = VKey 'StakePool StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
Ledger.hashKey VKey 'StakePool StandardCrypto
poolColdVK
      , _poolVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
Ledger._poolVrf    = VerKeyVRF PraosVRF -> Hash Blake2b_256 (VerKeyVRF PraosVRF)
forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
Ledger.hashVerKeyVRF VerKeyVRF StandardCrypto
VerKeyVRF PraosVRF
poolVrfVK
      , _poolPledge :: Coin
Ledger._poolPledge = Integer -> Coin
Ledger.Coin Integer
0
      , _poolCost :: Coin
Ledger._poolCost   = Integer -> Coin
Ledger.Coin Integer
0
      , _poolMargin :: UnitInterval
Ledger._poolMargin = UnitInterval
forall a. Bounded a => a
minBound
      , _poolRAcnt :: RewardAcnt StandardCrypto
Ledger._poolRAcnt  =
          StakeAddress -> RewardAcnt StandardCrypto
toShelleyStakeAddr (StakeAddress -> RewardAcnt StandardCrypto)
-> StakeAddress -> RewardAcnt 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)
      , _poolOwners :: Set (KeyHash 'Staking StandardCrypto)
Ledger._poolOwners = Set (KeyHash 'Staking StandardCrypto)
forall a. Monoid a => a
mempty
      , _poolRelays :: StrictSeq StakePoolRelay
Ledger._poolRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
Seq.empty
      , _poolMD :: StrictMaybe PoolMetadata
Ledger._poolMD     = StrictMaybe PoolMetadata
forall a. StrictMaybe a
Ledger.SNothing
      }
 where
   strIndex :: String
strIndex = Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
index
   poolColdVKF :: String
poolColdVKF = String
dir String -> ShowS
</> String
"cold" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"
   poolVrfVKF :: String
poolVrfVKF = String
dir String -> ShowS
</> String
"vrf" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"
   poolRewardVKF :: String
poolRewardVKF = String
dir String -> ShowS
</> String
"staking-reward" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"

writeBulkPoolCredentials :: FilePath -> Word -> [Word] -> ExceptT ShelleyGenesisCmdError IO ()
writeBulkPoolCredentials :: String -> Word -> [Word] -> ExceptT ShelleyGenesisCmdError IO ()
writeBulkPoolCredentials String
dir Word
bulkIx [Word]
poolIxs = do
  [(TextEnvelope, TextEnvelope, TextEnvelope)]
creds <- (Word
 -> ExceptT
      ShelleyGenesisCmdError
      IO
      (TextEnvelope, TextEnvelope, TextEnvelope))
-> [Word]
-> ExceptT
     ShelleyGenesisCmdError
     IO
     [(TextEnvelope, TextEnvelope, TextEnvelope)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Word
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (TextEnvelope, TextEnvelope, TextEnvelope)
readPoolCreds [Word]
poolIxs
  (IOException -> ShelleyGenesisCmdError)
-> IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdFileError (FileError () -> ShelleyGenesisCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
bulkFile) (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError 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 -> ShowS
</> String
"bulk" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
bulkIx String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".creds"

   readPoolCreds :: Word -> ExceptT ShelleyGenesisCmdError IO
                                   (TextEnvelope, TextEnvelope, TextEnvelope)
   readPoolCreds :: Word
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (TextEnvelope, TextEnvelope, TextEnvelope)
readPoolCreds Word
ix = do
     (,,) (TextEnvelope
 -> TextEnvelope
 -> TextEnvelope
 -> (TextEnvelope, TextEnvelope, TextEnvelope))
-> ExceptT ShelleyGenesisCmdError IO TextEnvelope
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (TextEnvelope
      -> TextEnvelope -> (TextEnvelope, TextEnvelope, TextEnvelope))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
readEnvelope String
poolCert
          ExceptT
  ShelleyGenesisCmdError
  IO
  (TextEnvelope
   -> TextEnvelope -> (TextEnvelope, TextEnvelope, TextEnvelope))
-> ExceptT ShelleyGenesisCmdError IO TextEnvelope
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (TextEnvelope -> (TextEnvelope, TextEnvelope, TextEnvelope))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
readEnvelope String
poolVrfSKF
          ExceptT
  ShelleyGenesisCmdError
  IO
  (TextEnvelope -> (TextEnvelope, TextEnvelope, TextEnvelope))
-> ExceptT ShelleyGenesisCmdError IO TextEnvelope
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (TextEnvelope, TextEnvelope, TextEnvelope)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
readEnvelope String
poolKesSKF
    where
      strIndex :: String
strIndex = Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
ix
      poolCert :: String
poolCert = String
dir String -> ShowS
</> String
"opcert" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".cert"
      poolVrfSKF :: String
poolVrfSKF = String
dir String -> ShowS
</> String
"vrf" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".skey"
      poolKesSKF :: String
poolKesSKF = String
dir String -> ShowS
</> String
"kes" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".skey"
   readEnvelope :: FilePath -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
   readEnvelope :: String -> ExceptT ShelleyGenesisCmdError IO TextEnvelope
readEnvelope String
fp = do
     ByteString
content <- (IOException -> ShelleyGenesisCmdError)
-> IO ByteString -> ExceptT ShelleyGenesisCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdFileError (FileError () -> ShelleyGenesisCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fp) (IO ByteString -> ExceptT ShelleyGenesisCmdError IO ByteString)
-> IO ByteString -> ExceptT ShelleyGenesisCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$
                  String -> IO ByteString
BS.readFile String
fp
     (String -> ShelleyGenesisCmdError)
-> ExceptT String IO TextEnvelope
-> ExceptT ShelleyGenesisCmdError IO TextEnvelope
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> ShelleyGenesisCmdError
ShelleyGenesisCmdAesonDecodeError String
fp (Text -> ShelleyGenesisCmdError)
-> (String -> Text) -> String -> ShelleyGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack) (ExceptT String IO TextEnvelope
 -> ExceptT ShelleyGenesisCmdError IO TextEnvelope)
-> (Either String TextEnvelope -> ExceptT String IO TextEnvelope)
-> Either String TextEnvelope
-> ExceptT ShelleyGenesisCmdError IO TextEnvelope
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyGenesisCmdError IO TextEnvelope)
-> Either String TextEnvelope
-> ExceptT ShelleyGenesisCmdError 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

computeDelegation :: NetworkId -> FilePath -> Ledger.PoolParams StandardCrypto -> Word -> ExceptT ShelleyGenesisCmdError IO Delegation
computeDelegation :: NetworkId
-> String
-> PoolParams StandardCrypto
-> Word
-> ExceptT ShelleyGenesisCmdError IO Delegation
computeDelegation NetworkId
nw String
delegDir PoolParams StandardCrypto
pool Word
delegIx = do
    SomeAddressVerificationKey
paySVK <- (VerificationKeyTextOrFileError -> ShelleyGenesisCmdError)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
-> ExceptT ShelleyGenesisCmdError IO SomeAddressVerificationKey
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (ShelleyAddressCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdAddressCmdError
                           (ShelleyAddressCmdError -> ShelleyGenesisCmdError)
-> (VerificationKeyTextOrFileError -> ShelleyAddressCmdError)
-> VerificationKeyTextOrFileError
-> ShelleyGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VerificationKeyTextOrFileError -> ShelleyAddressCmdError
ShelleyAddressCmdVerificationKeyTextOrFileError) (ExceptT
   VerificationKeyTextOrFileError IO SomeAddressVerificationKey
 -> ExceptT ShelleyGenesisCmdError IO SomeAddressVerificationKey)
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
-> ExceptT ShelleyGenesisCmdError IO SomeAddressVerificationKey
forall a b. (a -> b) -> a -> b
$
                 VerificationKeyTextOrFile
-> ExceptT
     VerificationKeyTextOrFileError IO SomeAddressVerificationKey
readAddressVerificationKeyTextOrFile
                   (VerificationKeyFile -> VerificationKeyTextOrFile
VktofVerificationKeyFile VerificationKeyFile
payVKF)
    Address ShelleyAddr
initialUtxoAddr <- case SomeAddressVerificationKey
paySVK of
      APaymentVerificationKey VerificationKey PaymentKey
payVK ->
        (ShelleyAddressCmdError -> ShelleyGenesisCmdError)
-> ExceptT ShelleyAddressCmdError IO (Address ShelleyAddr)
-> ExceptT ShelleyGenesisCmdError IO (Address ShelleyAddr)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ShelleyAddressCmdError -> ShelleyGenesisCmdError
ShelleyGenesisCmdAddressCmdError
        (ExceptT ShelleyAddressCmdError IO (Address ShelleyAddr)
 -> ExceptT ShelleyGenesisCmdError IO (Address ShelleyAddr))
-> ExceptT ShelleyAddressCmdError IO (Address ShelleyAddr)
-> ExceptT ShelleyGenesisCmdError IO (Address ShelleyAddr)
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey
-> Maybe StakeVerifier
-> NetworkId
-> ExceptT ShelleyAddressCmdError IO (Address ShelleyAddr)
buildShelleyAddress VerificationKey PaymentKey
payVK (StakeVerifier -> Maybe StakeVerifier
forall a. a -> Maybe a
Just (StakeVerifier -> Maybe StakeVerifier)
-> (String -> StakeVerifier) -> String -> Maybe StakeVerifier
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VerificationKeyOrFile StakeKey -> StakeVerifier
StakeVerifierKey (VerificationKeyOrFile StakeKey -> StakeVerifier)
-> (String -> VerificationKeyOrFile StakeKey)
-> String
-> StakeVerifier
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VerificationKeyFile -> VerificationKeyOrFile StakeKey
forall keyrole.
VerificationKeyFile -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (VerificationKeyFile -> VerificationKeyOrFile StakeKey)
-> (String -> VerificationKeyFile)
-> String
-> VerificationKeyOrFile StakeKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> VerificationKeyFile
VerificationKeyFile (String -> Maybe StakeVerifier) -> String -> Maybe StakeVerifier
forall a b. (a -> b) -> a -> b
$ String
stakeVKF) NetworkId
nw
      SomeAddressVerificationKey
_ -> ShelleyGenesisCmdError
-> ExceptT ShelleyGenesisCmdError IO (Address ShelleyAddr)
forall (m :: * -> *) e a. Monad m => e -> ExceptT e m a
left (ShelleyGenesisCmdError
 -> ExceptT ShelleyGenesisCmdError IO (Address ShelleyAddr))
-> ShelleyGenesisCmdError
-> ExceptT ShelleyGenesisCmdError IO (Address ShelleyAddr)
forall a b. (a -> b) -> a -> b
$ VerificationKeyFile
-> Text -> SomeAddressVerificationKey -> ShelleyGenesisCmdError
ShelleyGenesisCmdUnexpectedAddressVerificationKey VerificationKeyFile
payVKF Text
"APaymentVerificationKey" SomeAddressVerificationKey
paySVK

    StakeVerificationKey stakeVK <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError
      (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
 -> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakeKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakeKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 ShelleyGenesisCmdError IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT ShelleyGenesisCmdError IO (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakeKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakeKey -> AsType (VerificationKey StakeKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakeKey
AsStakeKey) String
stakeVKF

    Delegation -> ExceptT ShelleyGenesisCmdError IO Delegation
forall (f :: * -> *) a. Applicative f => a -> f a
pure Delegation :: AddressInEra ShelleyEra
-> KeyHash 'Staking StandardCrypto
-> PoolParams StandardCrypto
-> Delegation
Delegation
      { dInitialUtxoAddr :: AddressInEra ShelleyEra
dInitialUtxoAddr = Address ShelleyAddr -> AddressInEra ShelleyEra
forall era.
IsShelleyBasedEra era =>
Address ShelleyAddr -> AddressInEra era
shelleyAddressInEra Address ShelleyAddr
initialUtxoAddr
      , dDelegStaking :: KeyHash 'Staking StandardCrypto
dDelegStaking = VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
Ledger.hashKey VKey 'Staking StandardCrypto
stakeVK
      , dPoolParams :: PoolParams StandardCrypto
dPoolParams = PoolParams StandardCrypto
pool
      }
 where
   strIndexDeleg :: String
strIndexDeleg = Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
delegIx
   payVKF :: VerificationKeyFile
payVKF = String -> VerificationKeyFile
VerificationKeyFile (String -> VerificationKeyFile) -> String -> VerificationKeyFile
forall a b. (a -> b) -> a -> b
$ String
delegDir String -> ShowS
</> String
"payment" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndexDeleg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"
   stakeVKF :: String
stakeVKF = String
delegDir String -> ShowS
</> String
"staking" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndexDeleg String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"

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

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

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

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

updateTemplate
    :: SystemStart
    -- Genesis delegation (not stake-based):
    -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
    -- Non-delegated initial UTxO spec:
    -> Maybe Lovelace
    -> [AddressInEra ShelleyEra]
    -- Genesis staking: pools/delegation map & delegated initial UTxO spec:
    -> Map (Ledger.KeyHash 'Ledger.Staking StandardCrypto) (Ledger.PoolParams StandardCrypto)
    -> Lovelace
    -> [AddressInEra ShelleyEra]
    -> [AddressInEra ShelleyEra]
    -> ShelleyGenesis StandardShelley
    -> ShelleyGenesis StandardShelley
updateTemplate :: SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Lovelace
-> [AddressInEra ShelleyEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Lovelace
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardShelley
-> ShelleyGenesis StandardShelley
updateTemplate (SystemStart UTCTime
start)
               Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap Maybe Lovelace
mAmountNonDeleg [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
               Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs (Lovelace Integer
amountDeleg) [AddressInEra ShelleyEra]
utxoAddrsDeleg [AddressInEra ShelleyEra]
stuffedUtxoAddrs
               ShelleyGenesis StandardShelley
template = do

    let pparamsFromTemplate :: PParams StandardShelley
pparamsFromTemplate = ShelleyGenesis StandardShelley -> PParams StandardShelley
forall era. ShelleyGenesis era -> PParams era
sgProtocolParams ShelleyGenesis StandardShelley
template
        shelleyGenesis :: ShelleyGenesis StandardShelley
shelleyGenesis = ShelleyGenesis StandardShelley
template
          { sgSystemStart :: UTCTime
sgSystemStart = UTCTime
start
          , sgMaxLovelaceSupply :: Word64
sgMaxLovelaceSupply = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Integer
nonDelegCoin Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
delegCoin
          , sgGenDelegs :: Map
  (KeyHash 'Genesis (Crypto StandardShelley))
  (GenDelegPair (Crypto StandardShelley))
sgGenDelegs = Map
  (KeyHash 'Genesis (Crypto StandardShelley))
  (GenDelegPair (Crypto StandardShelley))
Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys
          , sgInitialFunds :: ListMap (Addr (Crypto StandardShelley)) Coin
sgInitialFunds = [(Addr StandardCrypto, Coin)] -> ListMap (Addr StandardCrypto) Coin
forall k v. [(k, v)] -> ListMap k v
ListMap
                              [ (AddressInEra ShelleyEra -> Addr StandardCrypto
forall era. AddressInEra era -> Addr StandardCrypto
toShelleyAddr AddressInEra ShelleyEra
addr, Lovelace -> Coin
toShelleyLovelace Lovelace
v)
                              | (AddressInEra ShelleyEra
addr, Lovelace
v) <-
                                Integer
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Lovelace)]
distribute (Integer
nonDelegCoin Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
subtractForTreasury) [AddressInEra ShelleyEra]
utxoAddrsNonDeleg [(AddressInEra ShelleyEra, Lovelace)]
-> [(AddressInEra ShelleyEra, Lovelace)]
-> [(AddressInEra ShelleyEra, Lovelace)]
forall a. [a] -> [a] -> [a]
++
                                Integer
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Lovelace)]
distribute (Integer
delegCoin Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
subtractForTreasury)    [AddressInEra ShelleyEra]
utxoAddrsDeleg [(AddressInEra ShelleyEra, Lovelace)]
-> [(AddressInEra ShelleyEra, Lovelace)]
-> [(AddressInEra ShelleyEra, Lovelace)]
forall a. [a] -> [a] -> [a]
++
                                [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
mkStuffedUtxo [AddressInEra ShelleyEra]
stuffedUtxoAddrs ]
          , sgStaking :: ShelleyGenesisStaking (Crypto StandardShelley)
sgStaking =
            ShelleyGenesisStaking :: forall crypto.
ListMap (KeyHash 'StakePool crypto) (PoolParams crypto)
-> ListMap (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
-> ShelleyGenesisStaking crypto
ShelleyGenesisStaking
              { sgsPools :: ListMap
  (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
sgsPools = [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> ListMap
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
forall k v. [(k, v)] -> ListMap k v
ListMap
                            [ (PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Ledger._poolId PoolParams StandardCrypto
poolParams, PoolParams StandardCrypto
poolParams)
                            | PoolParams StandardCrypto
poolParams <- Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> [PoolParams StandardCrypto]
forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs ]
              , sgsStake :: ListMap
  (KeyHash 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
sgsStake = Map
  (KeyHash 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
-> ListMap
     (KeyHash 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto)
forall k v. Map k v -> ListMap k v
ListMap.fromMap (Map
   (KeyHash 'Staking StandardCrypto)
   (KeyHash 'StakePool StandardCrypto)
 -> ListMap
      (KeyHash 'Staking StandardCrypto)
      (KeyHash 'StakePool StandardCrypto))
-> Map
     (KeyHash 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto)
-> ListMap
     (KeyHash 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto)
forall a b. (a -> b) -> a -> b
$ PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Ledger._poolId (PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto)
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Map
     (KeyHash 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs
              }
          , sgProtocolParams :: PParams StandardShelley
sgProtocolParams = PParams StandardShelley
pparamsFromTemplate
          }
    ShelleyGenesis StandardShelley
shelleyGenesis
  where
    maximumLovelaceSupply :: Word64
    maximumLovelaceSupply :: Word64
maximumLovelaceSupply = ShelleyGenesis StandardShelley -> Word64
forall era. ShelleyGenesis era -> Word64
sgMaxLovelaceSupply ShelleyGenesis StandardShelley
template
    -- If the initial funds are equal to the maximum funds, rewards cannot be created.
    subtractForTreasury :: Integer
    subtractForTreasury :: Integer
subtractForTreasury = Integer
nonDelegCoin 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 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe Word64
maximumLovelaceSupply (Lovelace -> Word64
forall a. Integral a => Lovelace -> a
unLovelace (Lovelace -> Word64) -> Maybe Lovelace -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Lovelace
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, Lovelace)]
distribute Integer
funds [AddressInEra ShelleyEra]
addrs =
      ([(AddressInEra ShelleyEra, Lovelace)], Integer)
-> [(AddressInEra ShelleyEra, Lovelace)]
forall a b. (a, b) -> a
fst (([(AddressInEra ShelleyEra, Lovelace)], Integer)
 -> [(AddressInEra ShelleyEra, Lovelace)])
-> ([(AddressInEra ShelleyEra, Lovelace)], Integer)
-> [(AddressInEra ShelleyEra, Lovelace)]
forall a b. (a -> b) -> a -> b
$ (([(AddressInEra ShelleyEra, Lovelace)], Integer)
 -> AddressInEra ShelleyEra
 -> ([(AddressInEra ShelleyEra, Lovelace)], Integer))
-> ([(AddressInEra ShelleyEra, Lovelace)], Integer)
-> [AddressInEra ShelleyEra]
-> ([(AddressInEra ShelleyEra, Lovelace)], Integer)
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ([(AddressInEra ShelleyEra, Lovelace)], Integer)
-> AddressInEra ShelleyEra
-> ([(AddressInEra ShelleyEra, Lovelace)], Integer)
folder ([], 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. HasLength a => 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, Lovelace)], Integer)
-> AddressInEra ShelleyEra
-> ([(AddressInEra ShelleyEra, Lovelace)], Integer)
folder ([(AddressInEra ShelleyEra, Lovelace)]
acc, Integer
rest) AddressInEra ShelleyEra
addr
         | Integer
rest Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
splitThreshold =
             ((AddressInEra ShelleyEra
addr, Integer -> Lovelace
Lovelace Integer
coinPerAddr) (AddressInEra ShelleyEra, Lovelace)
-> [(AddressInEra ShelleyEra, Lovelace)]
-> [(AddressInEra ShelleyEra, Lovelace)]
forall a. a -> [a] -> [a]
: [(AddressInEra ShelleyEra, Lovelace)]
acc, Integer
rest Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
coinPerAddr)
         | Bool
otherwise = ((AddressInEra ShelleyEra
addr, Integer -> Lovelace
Lovelace Integer
rest) (AddressInEra ShelleyEra, Lovelace)
-> [(AddressInEra ShelleyEra, Lovelace)]
-> [(AddressInEra ShelleyEra, Lovelace)]
forall a. a -> [a] -> [a]
: [(AddressInEra ShelleyEra, Lovelace)]
acc, Integer
0)

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

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

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

writeFileGenesis
  :: ToJSON genesis
  => FilePath
  -> genesis
  -> ExceptT ShelleyGenesisCmdError IO ()
writeFileGenesis :: String -> genesis -> ExceptT ShelleyGenesisCmdError IO ()
writeFileGenesis String
fpath genesis
genesis =
  (IOException -> ShelleyGenesisCmdError)
-> IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError (FileError () -> ShelleyGenesisCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO () -> ExceptT ShelleyGenesisCmdError IO ())
-> IO () -> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
    String -> ByteString -> IO ()
LBS.writeFile String
fpath (genesis -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty genesis
genesis)

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

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

    let combinedMap :: Map Int (VerificationKey GenesisKey,
                                (VerificationKey GenesisDelegateKey,
                                 VerificationKey VrfKey))
        combinedMap :: Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap =
          (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 ShelleyGenesisCmdError IO ()
-> ExceptT ShelleyGenesisCmdError 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 ShelleyGenesisCmdError IO ()
 -> ExceptT ShelleyGenesisCmdError IO ())
-> ExceptT ShelleyGenesisCmdError IO ()
-> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      ShelleyGenesisCmdError -> ExceptT ShelleyGenesisCmdError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (ShelleyGenesisCmdError -> ExceptT ShelleyGenesisCmdError IO ())
-> ShelleyGenesisCmdError -> ExceptT ShelleyGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int] -> ShelleyGenesisCmdError
ShelleyGenesisCmdMismatchedGenesisKeyFiles
                     (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 =
          [(Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))]
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Hash GenesisKey
gh, (Hash GenesisDelegateKey
dh, Hash VrfKey
vh))
                       | (VerificationKey GenesisKey
g,(VerificationKey GenesisDelegateKey
d,VerificationKey VrfKey
v)) <- 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
     ShelleyGenesisCmdError
     IO
     (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegsMap


readGenesisKeys :: FilePath -> ExceptT ShelleyGenesisCmdError IO
                                       (Map Int (VerificationKey GenesisKey))
readGenesisKeys :: String
-> ExceptT
     ShelleyGenesisCmdError IO (Map Int (VerificationKey GenesisKey))
readGenesisKeys String
gendir = do
  [String]
files <- IO [String] -> ExceptT ShelleyGenesisCmdError IO [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
gendir)
  [(String, Int)]
fileIxs <- [String] -> ExceptT ShelleyGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [ String
gendir String -> ShowS
</> String
file
                                    | String
file <- [String]
files
                                    , ShowS
takeExtension String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey" ]
  (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisKey))
-> ExceptT
     ShelleyGenesisCmdError 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 -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError)
   IO
   (Map Int (VerificationKey GenesisKey))
 -> ExceptT
      ShelleyGenesisCmdError IO (Map Int (VerificationKey GenesisKey)))
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisKey))
-> ExceptT
     ShelleyGenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall a b. (a -> b) -> a -> b
$
    [(Int, VerificationKey GenesisKey)]
-> Map Int (VerificationKey GenesisKey)
forall k a. Ord k => [(k, a)] -> Map k a
Map.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)
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
<$> String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
readKey String
file
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs ]
  where
    readKey :: String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
readKey = 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))
-> (String
    -> IO
         (Either
            (FileError TextEnvelopeError) (VerificationKey GenesisKey)))
-> String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (VerificationKey GenesisKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey GenesisKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> 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 ShelleyGenesisCmdError IO
                            (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys :: String
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys String
deldir = do
  [String]
files <- IO [String] -> ExceptT ShelleyGenesisCmdError IO [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
deldir)
  [(String, Int)]
fileIxs <- [String] -> ExceptT ShelleyGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [ String
deldir String -> ShowS
</> String
file
                                    | String
file <- [String]
files
                                    , ShowS
takeExtensions String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey" ]
  (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
-> ExceptT
     ShelleyGenesisCmdError
     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 -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError)
   IO
   (Map Int (VerificationKey GenesisDelegateKey))
 -> ExceptT
      ShelleyGenesisCmdError
      IO
      (Map Int (VerificationKey GenesisDelegateKey)))
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
-> ExceptT
     ShelleyGenesisCmdError
     IO
     (Map Int (VerificationKey GenesisDelegateKey))
forall a b. (a -> b) -> a -> b
$
    [(Int, VerificationKey GenesisDelegateKey)]
-> Map Int (VerificationKey GenesisDelegateKey)
forall k a. Ord k => [(k, a)] -> Map k a
Map.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)
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
<$> String
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
readKey String
file
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs ]
  where
    readKey :: String
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
readKey = 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))
-> (String
    -> IO
         (Either
            (FileError TextEnvelopeError)
            (VerificationKey GenesisDelegateKey)))
-> String
-> ExceptT
     (FileError TextEnvelopeError)
     IO
     (VerificationKey GenesisDelegateKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (VerificationKey GenesisDelegateKey)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisDelegateKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> 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 ShelleyGenesisCmdError IO
                                           (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys :: String
-> ExceptT
     ShelleyGenesisCmdError IO (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys String
deldir = do
  [String]
files <- IO [String] -> ExceptT ShelleyGenesisCmdError IO [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
deldir)
  [(String, Int)]
fileIxs <- [String] -> ExceptT ShelleyGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [ String
deldir String -> ShowS
</> String
file
                                    | String
file <- [String]
files
                                    , ShowS
takeExtensions String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vrf.vkey" ]
  (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (Map Int (VerificationKey VrfKey))
-> ExceptT
     ShelleyGenesisCmdError 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 -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO (Map Int (VerificationKey VrfKey))
 -> ExceptT
      ShelleyGenesisCmdError IO (Map Int (VerificationKey VrfKey)))
-> ExceptT
     (FileError TextEnvelopeError) IO (Map Int (VerificationKey VrfKey))
-> ExceptT
     ShelleyGenesisCmdError IO (Map Int (VerificationKey VrfKey))
forall a b. (a -> b) -> a -> b
$
    [(Int, VerificationKey VrfKey)] -> Map Int (VerificationKey VrfKey)
forall k a. Ord k => [(k, a)] -> Map k a
Map.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)
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
<$> String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
readKey String
file
        | (String
file, Int
ix) <- [(String, Int)]
fileIxs ]
  where
    readKey :: String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
readKey = 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))
-> (String
    -> IO
         (Either (FileError TextEnvelopeError) (VerificationKey VrfKey)))
-> String
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. AsType (VerificationKey VrfKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> 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) -> ShowS
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 ShelleyGenesisCmdError IO [(FilePath, Int)]
extractFileNameIndexes :: [String] -> ExceptT ShelleyGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [String]
files = do
    case [ String
file | (String
file, Maybe Int
Nothing) <- [(String, Maybe Int)]
filesIxs ] of
      []     -> () -> ExceptT ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [String]
files' -> ShelleyGenesisCmdError -> ExceptT ShelleyGenesisCmdError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([String] -> ShelleyGenesisCmdError
ShelleyGenesisCmdFilesNoIndex [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. HasLength a => 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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((String, Int) -> (String, Int) -> Bool)
-> [(String, Int)] -> [[(String, Int)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
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 k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((String, Int) -> (String, Int) -> Ordering)
-> [(String, Int)] -> [(String, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
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 ShelleyGenesisCmdError IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ([(String, Int)]
g:[[(String, Int)]]
_) -> ShelleyGenesisCmdError -> ExceptT ShelleyGenesisCmdError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([String] -> ShelleyGenesisCmdError
ShelleyGenesisCmdFilesDupIndex (((String, Int) -> String) -> [(String, Int)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (String, Int) -> String
forall a b. (a, b) -> a
fst [(String, Int)]
g))

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

readInitialFundAddresses :: FilePath -> NetworkId
                         -> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses :: String
-> NetworkId
-> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses String
utxodir NetworkId
nw = do
    [String]
files <- IO [String] -> ExceptT ShelleyGenesisCmdError IO [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
utxodir)
    [VerificationKey GenesisUTxOKey]
vkeys <- (FileError TextEnvelopeError -> ShelleyGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT
     ShelleyGenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> ShelleyGenesisCmdError
ShelleyGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
 -> ExceptT
      ShelleyGenesisCmdError IO [VerificationKey GenesisUTxOKey])
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT
     ShelleyGenesisCmdError 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)
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)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
                                          (String
utxodir String -> ShowS
</> String
file)
                 | String
file <- [String]
files
                 , ShowS
takeExtension String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey" ]
    [AddressInEra ShelleyEra]
-> ExceptT ShelleyGenesisCmdError IO [AddressInEra ShelleyEra]
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 = NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra ShelleyEra
forall era.
IsShelleyBasedEra era =>
NetworkId
-> PaymentCredential -> StakeAddressReference -> AddressInEra era
makeShelleyAddressInEra NetworkId
nw (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
                                                StakeAddressReference
NoStakeAddress
           ]


-- | Hash a genesis file
runGenesisHashFile :: GenesisFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisHashFile :: GenesisFile -> ExceptT ShelleyGenesisCmdError IO ()
runGenesisHashFile (GenesisFile String
fpath) = do
   ByteString
content <- (IOException -> ShelleyGenesisCmdError)
-> IO ByteString -> ExceptT ShelleyGenesisCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> ShelleyGenesisCmdError
ShelleyGenesisCmdGenesisFileError (FileError () -> ShelleyGenesisCmdError)
-> (IOException -> FileError ())
-> IOException
-> ShelleyGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath