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

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

import Cardano.Api
import Cardano.Api.Byron
  ( ByronKey
  , SigningKey (..)
  )
import Cardano.Api.Byron qualified as Byron hiding (SigningKey)
import Cardano.Api.Ledger qualified as L

import Cardano.CLI.Byron.Delegation
import Cardano.CLI.Byron.Genesis as Byron
import Cardano.CLI.Byron.Key qualified as Byron
import Cardano.CLI.Compatible.Exception
import Cardano.CLI.EraBased.Genesis.Command as Cmd
import Cardano.CLI.EraBased.Genesis.CreateTestnetData.Run (WriteFileGenesis (..))
import Cardano.CLI.EraBased.Genesis.CreateTestnetData.Run qualified as TN
import Cardano.CLI.EraBased.Genesis.Internal.Common
import Cardano.CLI.EraBased.StakeAddress.Run (runStakeAddressKeyGenCmd)
import Cardano.CLI.EraIndependent.Node.Command qualified as Cmd
import Cardano.CLI.EraIndependent.Node.Run
  ( runNodeIssueOpCertCmd
  , runNodeKeyGenColdCmd
  , runNodeKeyGenKesCmd
  , runNodeKeyGenVrfCmd
  )
import Cardano.CLI.IO.Lazy qualified as Lazy
import Cardano.CLI.Read
import Cardano.CLI.Type.Common
import Cardano.CLI.Type.Error.GenesisCmdError
import Cardano.CLI.Type.Error.NodeCmdError
import Cardano.CLI.Type.Error.StakePoolCmdError
import Cardano.CLI.Type.Key
import Cardano.Crypto qualified as CC
import Cardano.Crypto.Hash qualified as Crypto
import Cardano.Crypto.Signing qualified as Byron
import Cardano.Ledger.BaseTypes (unNonZero)
import Cardano.Protocol.Crypto qualified as C

import Control.DeepSeq (NFData, force)
import Control.Exception (evaluate)
import Control.Monad (forM, forM_, unless, when)
import Data.Aeson qualified as Aeson
import Data.Aeson.KeyMap qualified as Aeson
import Data.Bifunctor (Bifunctor (..))
import Data.ByteString (ByteString)
import Data.ByteString.Char8 qualified as BS
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.Char (isDigit)
import Data.Fixed (Fixed (MkFixed))
import Data.Function (on)
import Data.Functor (void)
import Data.List qualified as List
import Data.List.Split qualified as List
import Data.ListMap (ListMap (..))
import Data.ListMap qualified as ListMap
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (fromMaybe)
import Data.Sequence.Strict qualified as Seq
import Data.Text qualified as Text
import Data.Text.IO qualified as Text
import Data.Word (Word64)
import Data.Yaml qualified as Yaml
import GHC.Exts (IsList (..))
import GHC.Generics (Generic)
import Lens.Micro ((^.))
import System.Directory (createDirectoryIfMissing, listDirectory)
import System.FilePath (takeExtension, takeExtensions, (</>))
import System.IO qualified as IO
import System.IO.Error (isDoesNotExistError)
import System.Random (StdGen)
import System.Random qualified as Random
import Text.Read (readMaybe)
import Vary (Vary)

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

runGenesisKeyHashCmd :: VerificationKeyFile In -> CIO e ()
runGenesisKeyHashCmd :: forall e. VerificationKeyFile 'In -> CIO e ()
runGenesisKeyHashCmd VerificationKeyFile 'In
vkeyPath = do
  vkey <-
    IO
  (Either
     (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
-> RIO e (SomeGenesisKey VerificationKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either
      (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
 -> RIO e (SomeGenesisKey VerificationKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
-> RIO e (SomeGenesisKey VerificationKey)
forall a b. (a -> b) -> a -> b
$
      [FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)]
-> VerificationKeyFile 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (SomeGenesisKey VerificationKey))
forall b content.
[FromSomeType HasTextEnvelope b]
-> File content 'In -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
        [ AsType (VerificationKey GenesisKey)
-> (VerificationKey GenesisKey -> SomeGenesisKey VerificationKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
            (AsType GenesisKey -> AsType (VerificationKey GenesisKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey)
            VerificationKey GenesisKey -> SomeGenesisKey VerificationKey
forall (f :: * -> *). f GenesisKey -> SomeGenesisKey f
AGenesisKey
        , AsType (VerificationKey GenesisDelegateKey)
-> (VerificationKey GenesisDelegateKey
    -> SomeGenesisKey VerificationKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
            (AsType GenesisDelegateKey
-> AsType (VerificationKey GenesisDelegateKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
            VerificationKey GenesisDelegateKey
-> SomeGenesisKey VerificationKey
forall (f :: * -> *). f GenesisDelegateKey -> SomeGenesisKey f
AGenesisDelegateKey
        , AsType (VerificationKey GenesisUTxOKey)
-> (VerificationKey GenesisUTxOKey
    -> SomeGenesisKey VerificationKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey VerificationKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
            (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
            VerificationKey GenesisUTxOKey -> SomeGenesisKey VerificationKey
forall (f :: * -> *). f GenesisUTxOKey -> SomeGenesisKey f
AGenesisUTxOKey
        ]
        VerificationKeyFile 'In
vkeyPath
  liftIO $ BS.putStrLn (renderKeyHash vkey)
 where
  renderKeyHash :: SomeGenesisKey VerificationKey -> ByteString
  renderKeyHash :: SomeGenesisKey VerificationKey -> ByteString
renderKeyHash (AGenesisKey VerificationKey GenesisKey
vk) = VerificationKey GenesisKey -> ByteString
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash VerificationKey GenesisKey
vk
  renderKeyHash (AGenesisDelegateKey VerificationKey GenesisDelegateKey
vk) = VerificationKey GenesisDelegateKey -> ByteString
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash VerificationKey GenesisDelegateKey
vk
  renderKeyHash (AGenesisUTxOKey VerificationKey GenesisUTxOKey
vk) = VerificationKey GenesisUTxOKey -> ByteString
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> ByteString
renderVerificationKeyHash VerificationKey GenesisUTxOKey
vk

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

runGenesisVerKeyCmd
  :: GenesisVerKeyCmdArgs
  -> CIO e ()
runGenesisVerKeyCmd :: forall e. GenesisVerKeyCmdArgs -> CIO e ()
runGenesisVerKeyCmd
  Cmd.GenesisVerKeyCmdArgs
    { VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisVerKeyCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
    , SigningKeyFile 'In
signingKeyPath :: SigningKeyFile 'In
signingKeyPath :: GenesisVerKeyCmdArgs -> SigningKeyFile 'In
Cmd.signingKeyPath
    } = do
    skey <-
      IO
  (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
-> RIO e (SomeGenesisKey SigningKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
 -> RIO e (SomeGenesisKey SigningKey))
-> IO
     (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
-> RIO e (SomeGenesisKey SigningKey)
forall a b. (a -> b) -> a -> b
$
        [FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)]
-> SigningKeyFile 'In
-> IO
     (Either (FileError TextEnvelopeError) (SomeGenesisKey SigningKey))
forall b content.
[FromSomeType HasTextEnvelope b]
-> File content 'In -> IO (Either (FileError TextEnvelopeError) b)
readFileTextEnvelopeAnyOf
          [ AsType (SigningKey GenesisKey)
-> (SigningKey GenesisKey -> SomeGenesisKey SigningKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
              (AsType GenesisKey -> AsType (SigningKey GenesisKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisKey
AsGenesisKey)
              SigningKey GenesisKey -> SomeGenesisKey SigningKey
forall (f :: * -> *). f GenesisKey -> SomeGenesisKey f
AGenesisKey
          , AsType (SigningKey GenesisDelegateKey)
-> (SigningKey GenesisDelegateKey -> SomeGenesisKey SigningKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
              (AsType GenesisDelegateKey -> AsType (SigningKey GenesisDelegateKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey)
              SigningKey GenesisDelegateKey -> SomeGenesisKey SigningKey
forall (f :: * -> *). f GenesisDelegateKey -> SomeGenesisKey f
AGenesisDelegateKey
          , AsType (SigningKey GenesisUTxOKey)
-> (SigningKey GenesisUTxOKey -> SomeGenesisKey SigningKey)
-> FromSomeType HasTextEnvelope (SomeGenesisKey SigningKey)
forall (c :: * -> Constraint) a b.
c a =>
AsType a -> (a -> b) -> FromSomeType c b
FromSomeType
              (AsType GenesisUTxOKey -> AsType (SigningKey GenesisUTxOKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
              SigningKey GenesisUTxOKey -> SomeGenesisKey SigningKey
forall (f :: * -> *). f GenesisUTxOKey -> SomeGenesisKey f
AGenesisUTxOKey
          ]
          SigningKeyFile 'In
signingKeyPath

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

    fromEitherIOCli @(FileError ()) $
      case vkey of
        AGenesisKey VerificationKey GenesisKey
vk -> VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> VerificationKey GenesisKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing VerificationKey GenesisKey
vk
        AGenesisDelegateKey VerificationKey GenesisDelegateKey
vk -> VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr
-> VerificationKey GenesisDelegateKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing VerificationKey GenesisDelegateKey
vk
        AGenesisUTxOKey VerificationKey GenesisUTxOKey
vk -> VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr
-> VerificationKey GenesisUTxOKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON Maybe TextEnvelopeDescr
forall a. Maybe a
Nothing VerificationKey GenesisUTxOKey
vk

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

runGenesisTxInCmd
  :: GenesisTxInCmdArgs
  -> CIO e ()
runGenesisTxInCmd :: forall e. GenesisTxInCmdArgs -> CIO e ()
runGenesisTxInCmd
  Cmd.GenesisTxInCmdArgs
    { VerificationKeyFile 'In
verificationKeyPath :: VerificationKeyFile 'In
verificationKeyPath :: GenesisTxInCmdArgs -> VerificationKeyFile 'In
Cmd.verificationKeyPath
    , NetworkId
network :: NetworkId
network :: GenesisTxInCmdArgs -> NetworkId
Cmd.network
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: GenesisTxInCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    vkey <-
      IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> RIO e (VerificationKey GenesisUTxOKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
 -> RIO e (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> RIO e (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
        VerificationKeyFile 'In
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope VerificationKeyFile 'In
verificationKeyPath
    let txin = NetworkId -> Hash GenesisUTxOKey -> TxIn
genesisUTxOPseudoTxIn NetworkId
network (VerificationKey GenesisUTxOKey -> Hash GenesisUTxOKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisUTxOKey
vkey)

    writeOutput mOutFile (renderTxIn txin)

runGenesisAddrCmd
  :: GenesisAddrCmdArgs
  -> CIO e ()
runGenesisAddrCmd :: forall e. GenesisAddrCmdArgs -> CIO e ()
runGenesisAddrCmd
  Cmd.GenesisAddrCmdArgs
    { VerificationKeyFile 'In
verificationKeyPath :: VerificationKeyFile 'In
verificationKeyPath :: GenesisAddrCmdArgs -> VerificationKeyFile 'In
Cmd.verificationKeyPath
    , NetworkId
network :: NetworkId
network :: GenesisAddrCmdArgs -> NetworkId
Cmd.network
    , Maybe (File () 'Out)
mOutFile :: Maybe (File () 'Out)
mOutFile :: GenesisAddrCmdArgs -> Maybe (File () 'Out)
Cmd.mOutFile
    } = do
    vkey <-
      IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> RIO e (VerificationKey GenesisUTxOKey)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
IO (Either e a) -> m a
fromEitherIOCli (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
 -> RIO e (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> RIO e (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
        forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope @(VerificationKey GenesisUTxOKey) VerificationKeyFile 'In
verificationKeyPath
    let 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 =
          NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress
            NetworkId
network
            (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
            StakeAddressReference
NoStakeAddress

    writeOutput mOutFile (serialiseAddress addr)

--
-- Create Genesis command implementation
--

runGenesisCreateCmd
  :: GenesisCreateCmdArgs era
  -> CIO e ()
runGenesisCreateCmd :: forall era e. GenesisCreateCmdArgs era -> CIO e ()
runGenesisCreateCmd
  Cmd.GenesisCreateCmdArgs
    { Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: forall era.
GenesisCreateCmdArgs era
-> Vary '[FormatBech32, FormatTextEnvelope]
Cmd.keyOutputFormat
    , GenesisDir
genesisDir :: GenesisDir
genesisDir :: forall era. GenesisCreateCmdArgs era -> GenesisDir
Cmd.genesisDir
    , Word
numGenesisKeys :: Word
numGenesisKeys :: forall era. GenesisCreateCmdArgs era -> Word
Cmd.numGenesisKeys
    , Word
numUTxOKeys :: Word
numUTxOKeys :: forall era. GenesisCreateCmdArgs era -> Word
Cmd.numUTxOKeys
    , Maybe SystemStart
mSystemStart :: Maybe SystemStart
mSystemStart :: forall era. GenesisCreateCmdArgs era -> Maybe SystemStart
Cmd.mSystemStart
    , Maybe Coin
mSupply :: Maybe Coin
mSupply :: forall era. GenesisCreateCmdArgs era -> Maybe Coin
Cmd.mSupply
    , NetworkId
network :: NetworkId
network :: forall era. GenesisCreateCmdArgs era -> NetworkId
Cmd.network
    } = do
    let GenesisDir String
rootdir = GenesisDir
genesisDir
        gendir :: String
gendir = String
rootdir String -> String -> String
</> String
"genesis-keys"
        deldir :: String
deldir = String
rootdir String -> String -> String
</> String
"delegate-keys"
        utxodir :: String
utxodir = String
rootdir String -> String -> String
</> String
"utxo-keys"
    IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ do
      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

    template <-
      ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis)
-> ExceptT GenesisCmdError IO ShelleyGenesis
-> RIO e ShelleyGenesis
forall a b. (a -> b) -> a -> b
$ String
-> (ShelleyGenesis -> ShelleyGenesis)
-> ExceptT GenesisCmdError IO ShelleyGenesis
decodeShelleyGenesisWithDefault (String
rootdir String -> String -> String
</> String
"genesis.spec.json") ShelleyGenesis -> ShelleyGenesis
adjustTemplate
    alonzoGenesis <-
      fromExceptTCli . decodeAlonzoGenesisFile $ rootdir </> "genesis.alonzo.spec.json"
    conwayGenesis <- fromExceptTCli $ decodeConwayGenesisFile $ rootdir </> "genesis.conway.spec.json"

    forM_ [1 .. numGenesisKeys] $ \Word
index -> do
      String -> Word -> CIO e ()
forall e. String -> Word -> CIO e ()
createGenesisKeys String
gendir Word
index
      Vary '[FormatBech32, FormatTextEnvelope]
-> String -> Word -> CIO e ()
forall e.
Vary '[FormatBech32, FormatTextEnvelope]
-> String -> Word -> CIO e ()
createDelegateKeys Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat String
deldir Word
index

    forM_ [1 .. numUTxOKeys] $ \Word
index ->
      String -> Word -> CIO e ()
forall e. String -> Word -> CIO e ()
createUtxoKeys String
utxodir Word
index

    genDlgs <- fromExceptTCli $ readGenDelegsMap gendir deldir
    utxoAddrs <- fromExceptTCli $ readInitialFundAddresses utxodir network
    start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart

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

    forM_
      [ ("genesis.json", WritePretty shelleyGenesis)
      , ("genesis.alonzo.json", WritePretty alonzoGenesis)
      , ("genesis.conway.json", WritePretty conwayGenesis)
      ]
      $ \(String
filename, WriteFileGenesis
genesis) -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> RIO e (Hash Blake2b_256 ByteString)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
 -> RIO e (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> RIO e (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ String
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
TN.writeFileGenesis (String
rootdir String -> String -> String
</> String
filename) WriteFileGenesis
genesis
   where
    -- TODO: rationalise the naming convention on these genesis json files.

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

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

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

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

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

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

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

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

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

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

  return (delegateMap, vrfKeys, kesKeys, opCerts)

--
-- Create Genesis Cardano command implementation
--

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

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

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

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

    dlgCerts <-
      fromExceptTCli $ convertToShelleyError $ mapM (findDelegateCert byronGenesis) byronDelegateKeys
    let
      overrideShelleyGenesis ShelleyGenesis
t =
        ShelleyGenesis
t
          { sgNetworkMagic = unNetworkMagic (toNetworkMagic network)
          , sgNetworkId = toShelleyNetwork network
          , sgActiveSlotsCoeff = unsafeBoundedRational slotCoeff
          , sgSecurityParam = security
          , sgUpdateQuorum = fromIntegral $ ((numGenesisKeys `div` 3) * 2) + 1
          , sgEpochLength = EpochSize $ floor $ (fromIntegral (unNonZero security) * 10) / slotCoeff
          , sgMaxLovelaceSupply = 45_000_000_000_000_000
          , sgSystemStart = getSystemStart start
          , sgSlotLength = L.secondsToNominalDiffTimeMicro $ MkFixed (fromIntegral slotLength) * 1_000
          }
    shelleyGenesisTemplate' <-
      overrideShelleyGenesis <$> fromExceptTCli (decodeShelleyGenesisFile shelleyGenesisTemplate)
    alonzoGenesis <- fromExceptTCli $ decodeAlonzoGenesisFile alonzoGenesisTemplate
    conwayGenesis <- fromExceptTCli $ decodeConwayGenesisFile conwayGenesisTemplate
    (delegateMap, vrfKeys, kesKeys, opCerts) <-
      liftIO $ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys
    let
      shelleyGenesis :: ShelleyGenesis
      shelleyGenesis = SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> Map (KeyHash 'Staking) PoolParams
-> Coin
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis
-> ShelleyGenesis
updateTemplate SystemStart
start Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegateMap Maybe Coin
forall a. Maybe a
Nothing [] Map (KeyHash 'Staking) PoolParams
forall a. Monoid a => a
mempty Coin
0 [] [] ShelleyGenesis
shelleyGenesisTemplate'

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

    liftIO $ do
      createDirectoryIfMissing False rootdir
      createDirectoryIfMissing False gendir
      createDirectoryIfMissing False deldir
      createDirectoryIfMissing False utxodir

      writeSecrets gendir "byron" "key" serialiseToRawBytes byronGenesisKeys
      writeSecrets gendir "shelley" "skey" toSKeyJSON shelleyGenesisKeys
      writeSecrets gendir "shelley" "vkey" toVkeyJSON shelleyGenesisKeys

      writeSecrets deldir "byron" "key" serialiseToRawBytes byronDelegateKeys
      writeSecrets deldir "shelley" "skey" toSKeyJSON shelleyDelegateKeys
      writeSecrets deldir "shelley" "vkey" toVkeyJSON' shelleyDelegatevkeys
      writeSecrets deldir "shelley" "vrf.skey" toSKeyJSON vrfKeys
      writeSecrets deldir "shelley" "vrf.vkey" toVkeyJSON vrfKeys
      writeSecrets deldir "shelley" "kes.skey" toSKeyJSON kesKeys
      writeSecrets deldir "shelley" "kes.vkey" toVkeyJSON kesKeys

      writeSecrets utxodir "byron" "key" serialiseToRawBytes byronUtxoKeys
      writeSecrets utxodir "shelley" "skey" toSKeyJSON shelleyUtxoKeys
      writeSecrets utxodir "shelley" "vkey" toVkeyJSON shelleyUtxoKeys

      writeSecrets deldir "byron" "cert.json" serialiseDelegationCert dlgCerts

      writeSecrets deldir "shelley" "opcert.json" toOpCert opCerts
      writeSecrets deldir "shelley" "counter.json" toCounter opCerts

    byronGenesisHash <-
      fromExceptTCli $
        TN.writeFileGenesis (rootdir </> "byron-genesis.json") $
          WriteCanonical byronGenesis
    shelleyGenesisHash <-
      fromExceptTCli $
        TN.writeFileGenesis (rootdir </> "shelley-genesis.json") $
          WritePretty shelleyGenesis
    alonzoGenesisHash <-
      fromExceptTCli $ TN.writeFileGenesis (rootdir </> "alonzo-genesis.json") $ WritePretty alonzoGenesis
    conwayGenesisHash <-
      fromExceptTCli $ TN.writeFileGenesis (rootdir </> "conway-genesis.json") $ WritePretty conwayGenesis

    liftIO $ do
      case mNodeConfigTemplate of
        Maybe String
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just String
nodeCfg -> do
          let hashes :: Map Key (Hash Blake2b_256 ByteString)
hashes =
                [(Key, Hash Blake2b_256 ByteString)]
-> Map Key (Hash Blake2b_256 ByteString)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                  [ (Key
"ByronGenesisHash", Hash Blake2b_256 ByteString
byronGenesisHash)
                  , (Key
"ShelleyGenesisHash", Hash Blake2b_256 ByteString
shelleyGenesisHash)
                  , (Key
"AlonzoGenesisHash", Hash Blake2b_256 ByteString
alonzoGenesisHash)
                  , (Key
"ConwayGenesisHash", Hash Blake2b_256 ByteString
conwayGenesisHash)
                  ]
          String -> Map Key (Hash Blake2b_256 ByteString) -> String -> IO ()
forall (m :: * -> *) h a.
MonadIO m =>
String -> Map Key (Hash h a) -> String -> m ()
writeGenesisHashesToNodeConfigFile String
nodeCfg Map Key (Hash Blake2b_256 ByteString)
hashes (String
rootdir String -> String -> String
</> String
"node-config.json")
   where
    convertToShelleyError :: ExceptT ByronGenesisError IO a -> ExceptT GenesisCmdError IO a
convertToShelleyError = (ByronGenesisError -> GenesisCmdError)
-> ExceptT ByronGenesisError IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT ByronGenesisError -> GenesisCmdError
GenesisCmdByronError
    convertGenesisKey :: Byron.SigningKey -> SigningKey GenesisExtendedKey
    convertGenesisKey :: SigningKey -> SigningKey GenesisExtendedKey
convertGenesisKey (Byron.SigningKey XPrv
xsk) = XPrv -> SigningKey GenesisExtendedKey
GenesisExtendedSigningKey XPrv
xsk

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

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

    byronParams :: SystemStart -> GenesisParameters
byronParams SystemStart
start =
      UTCTime
-> String
-> BlockCount
-> ProtocolMagic
-> TestnetBalanceOptions
-> FakeAvvmOptions
-> LovelacePortion
-> Maybe Integer
-> GenesisParameters
Byron.GenesisParameters
        (SystemStart -> UTCTime
getSystemStart SystemStart
start)
        String
byronGenesisTemplate
        (Word64 -> BlockCount
Byron.BlockCount (Word64 -> BlockCount) -> Word64 -> BlockCount
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word64) -> Word64 -> Word64
forall a b. (a -> b) -> a -> b
$ NonZero Word64 -> Word64
forall a. NonZero a -> a
unNonZero NonZero Word64
security)
        ProtocolMagic
byronNetwork
        TestnetBalanceOptions
byronBalance
        FakeAvvmOptions
byronFakeAvvm
        LovelacePortion
byronAvvmFactor
        Maybe Integer
forall a. Maybe a
Nothing
    byronNetwork :: ProtocolMagic
byronNetwork =
      Annotated ProtocolMagicId ()
-> RequiresNetworkMagic -> ProtocolMagic
forall a.
Annotated ProtocolMagicId a
-> RequiresNetworkMagic -> AProtocolMagic a
CC.AProtocolMagic
        (ProtocolMagicId -> () -> Annotated ProtocolMagicId ()
forall b a. b -> a -> Annotated b a
L.Annotated (NetworkId -> ProtocolMagicId
toByronProtocolMagicId NetworkId
network) ())
        (NetworkId -> RequiresNetworkMagic
toByronRequiresNetworkMagic NetworkId
network)
    byronBalance :: TestnetBalanceOptions
byronBalance =
      Byron.TestnetBalanceOptions
        { tboRichmen :: Word
tboRichmen = Word
numGenesisKeys
        , tboPoors :: Word
tboPoors = Word
numUTxOKeys
        , tboTotalBalance :: Lovelace
tboTotalBalance = Lovelace -> Maybe Lovelace -> Lovelace
forall a. a -> Maybe a -> a
fromMaybe Lovelace
zeroLovelace (Maybe Lovelace -> Lovelace) -> Maybe Lovelace -> Lovelace
forall a b. (a -> b) -> a -> b
$ Coin -> Maybe Lovelace
toByronLovelace (Coin -> Maybe Coin -> Coin
forall a. a -> Maybe a -> a
fromMaybe Coin
0 Maybe Coin
mSupply)
        , tboRichmenShare :: Rational
tboRichmenShare = Rational
0
        }
    byronFakeAvvm :: FakeAvvmOptions
byronFakeAvvm =
      Byron.FakeAvvmOptions
        { faoCount :: Word
faoCount = Word
0
        , faoOneBalance :: Lovelace
faoOneBalance = Lovelace
zeroLovelace
        }
    byronAvvmFactor :: LovelacePortion
byronAvvmFactor = Rational -> LovelacePortion
Byron.rationalToLovelacePortion Rational
0.0
    zeroLovelace :: Lovelace
zeroLovelace = forall (n :: Natural).
(KnownNat n, n <= 45000000000000000) =>
Lovelace
Byron.mkKnownLovelace @0

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

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

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

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

runGenesisCreateStakedCmd
  :: GenesisCreateStakedCmdArgs era
  -> CIO e ()
runGenesisCreateStakedCmd :: forall era e. GenesisCreateStakedCmdArgs era -> CIO e ()
runGenesisCreateStakedCmd
  Cmd.GenesisCreateStakedCmdArgs
    { Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat :: forall era.
GenesisCreateStakedCmdArgs era
-> Vary '[FormatBech32, FormatTextEnvelope]
Cmd.keyOutputFormat
    , GenesisDir
genesisDir :: GenesisDir
genesisDir :: forall era. GenesisCreateStakedCmdArgs era -> GenesisDir
Cmd.genesisDir
    , Word
numGenesisKeys :: Word
numGenesisKeys :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numGenesisKeys
    , Word
numUTxOKeys :: Word
numUTxOKeys :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numUTxOKeys
    , Word
numPools :: Word
numPools :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numPools
    , Word
numStakeDelegators :: Word
numStakeDelegators :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numStakeDelegators
    , Maybe SystemStart
mSystemStart :: Maybe SystemStart
mSystemStart :: forall era. GenesisCreateStakedCmdArgs era -> Maybe SystemStart
Cmd.mSystemStart
    , Maybe Coin
mNonDelegatedSupply :: Maybe Coin
mNonDelegatedSupply :: forall era. GenesisCreateStakedCmdArgs era -> Maybe Coin
Cmd.mNonDelegatedSupply
    , Coin
delegatedSupply :: Coin
delegatedSupply :: forall era. GenesisCreateStakedCmdArgs era -> Coin
Cmd.delegatedSupply
    , network :: forall era. GenesisCreateStakedCmdArgs era -> NetworkId
Cmd.network = NetworkId
networkId
    , Word
numBulkPoolCredFiles :: Word
numBulkPoolCredFiles :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numBulkPoolCredFiles
    , Word
numBulkPoolsPerFile :: Word
numBulkPoolsPerFile :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numBulkPoolsPerFile
    , Word
numStuffedUtxo :: Word
numStuffedUtxo :: forall era. GenesisCreateStakedCmdArgs era -> Word
Cmd.numStuffedUtxo
    , Maybe String
mStakePoolRelaySpecFile :: Maybe String
mStakePoolRelaySpecFile :: forall era. GenesisCreateStakedCmdArgs era -> Maybe String
Cmd.mStakePoolRelaySpecFile
    } = do
    let GenesisDir String
rootdir = GenesisDir
genesisDir
        gendir :: String
gendir = String
rootdir String -> String -> String
</> String
"genesis-keys"
        deldir :: String
deldir = String
rootdir String -> String -> String
</> String
"delegate-keys"
        pooldir :: String
pooldir = String
rootdir String -> String -> String
</> String
"pools"
        stdeldir :: String
stdeldir = String
rootdir String -> String -> String
</> String
"stake-delegator-keys"
        utxodir :: String
utxodir = String
rootdir String -> String -> String
</> String
"utxo-keys"

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

    template <-
      ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO ShelleyGenesis -> RIO e ShelleyGenesis)
-> ExceptT GenesisCmdError IO ShelleyGenesis
-> RIO e ShelleyGenesis
forall a b. (a -> b) -> a -> b
$ String
-> (ShelleyGenesis -> ShelleyGenesis)
-> ExceptT GenesisCmdError IO ShelleyGenesis
decodeShelleyGenesisWithDefault (String
rootdir String -> String -> String
</> String
"genesis.spec.json") ShelleyGenesis -> ShelleyGenesis
adjustTemplate
    alonzoGenesis <-
      fromExceptTCli
        . decodeAlonzoGenesisFile
        $ rootdir </> "genesis.alonzo.spec.json"
    conwayGenesis <- fromExceptTCli $ decodeConwayGenesisFile $ rootdir </> "genesis.conway.spec.json"

    forM_ [1 .. numGenesisKeys] $ \Word
index -> do
      String -> Word -> CIO e ()
forall e. String -> Word -> CIO e ()
createGenesisKeys String
gendir Word
index
      Vary '[FormatBech32, FormatTextEnvelope]
-> String -> Word -> CIO e ()
forall e.
Vary '[FormatBech32, FormatTextEnvelope]
-> String -> Word -> CIO e ()
createDelegateKeys Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat String
deldir Word
index

    forM_ [1 .. numUTxOKeys] $ \Word
index ->
      String -> Word -> CIO e ()
forall e. String -> Word -> CIO e ()
createUtxoKeys String
utxodir Word
index

    mStakePoolRelays <- forM mStakePoolRelaySpecFile (fromExceptTCli . readRelays)

    poolParams <- forM [1 .. numPools] $ \Word
index -> do
      Vary '[FormatBech32, FormatTextEnvelope]
-> String -> Word -> CIO e ()
forall e.
Vary '[FormatBech32, FormatTextEnvelope]
-> String -> Word -> CIO e ()
createPoolCredentials Vary '[FormatBech32, FormatTextEnvelope]
keyOutputFormat String
pooldir Word
index
      ExceptT GenesisCmdError IO PoolParams -> RIO e PoolParams
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO PoolParams -> RIO e PoolParams)
-> ExceptT GenesisCmdError IO PoolParams -> RIO e PoolParams
forall a b. (a -> b) -> a -> b
$ NetworkId
-> String
-> Maybe Word
-> Map Word [StakePoolRelay]
-> ExceptT GenesisCmdError IO PoolParams
buildPoolParams NetworkId
networkId String
pooldir (Word -> Maybe Word
forall a. a -> Maybe a
Just Word
index) (Map Word [StakePoolRelay]
-> Maybe (Map Word [StakePoolRelay]) -> Map Word [StakePoolRelay]
forall a. a -> Maybe a -> a
fromMaybe Map Word [StakePoolRelay]
forall a. Monoid a => a
mempty Maybe (Map Word [StakePoolRelay])
mStakePoolRelays)

    when (numBulkPoolCredFiles * numBulkPoolsPerFile > numPools) $
      throwCliError $
        GenesisCmdTooFewPoolsForBulkCreds numPools numBulkPoolCredFiles numBulkPoolsPerFile
    -- We generate the bulk files for the last pool indices,
    -- so that all the non-bulk pools have stable indices at beginning:
    let bulkOffset = Word -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word -> Word) -> Word -> Word
forall a b. (a -> b) -> a -> b
$ Word
numPools Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
numBulkPoolCredFiles Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
numBulkPoolsPerFile
        bulkIndices :: [Word] = [1 + bulkOffset .. numPools]
        bulkSlices :: [[Word]] = List.chunksOf (fromIntegral numBulkPoolsPerFile) bulkIndices
    fromExceptTCli $
      forM_ (zip [1 .. numBulkPoolCredFiles] bulkSlices) $
        uncurry (writeBulkPoolCredentials pooldir)

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

    g <- Random.getStdGen

    -- Distribute M delegates across N pools:
    delegations <- liftIO $ Lazy.forStateM g distribution $ flip computeInsecureDelegation networkId

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

    genDlgs <- fromExceptTCli $ readGenDelegsMap gendir deldir
    nonDelegAddrs <- fromExceptTCli $ readInitialFundAddresses utxodir networkId
    start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart

    let network = NetworkId -> Network
toShelleyNetwork NetworkId
networkId
    stuffedUtxoAddrs <-
      liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ genStuffedAddress network

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

    forM_
      [ ("genesis.json", WritePretty shelleyGenesis)
      , ("genesis.alonzo.json", WritePretty alonzoGenesis)
      , ("genesis.conway.json", WritePretty conwayGenesis)
      ]
      $ \(String
filename, WriteFileGenesis
genesis) -> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> RIO e (Hash Blake2b_256 ByteString)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
 -> RIO e (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> RIO e (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ String
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
TN.writeFileGenesis (String
rootdir String -> String -> String
</> String
filename) WriteFileGenesis
genesis
    -- TODO: rationalise the naming convention on these genesis json files.

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

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

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

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

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

    shelleyDelKeys :: Map (KeyHash 'Genesis) GenDelegPair
shelleyDelKeys =
      [Item (Map (KeyHash 'Genesis) GenDelegPair)]
-> Map (KeyHash 'Genesis) GenDelegPair
forall l. IsList l => [Item l] -> l
fromList
        [ (KeyHash 'Genesis
gh, KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
L.GenDelegPair KeyHash 'GenesisDelegate
gdh (VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
forall a b. (a -> b) -> a -> b
$ Hash Blake2b_256 (VerKeyVRF PraosVRF) -> VRFVerKeyHash 'GenDelegVRF
forall v (r :: KeyRoleVRF).
Hash Blake2b_256 (VerKeyVRF v) -> VRFVerKeyHash r
L.toVRFVerKeyHash Hash Blake2b_256 (VerKeyVRF PraosVRF)
Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto))
h)
        | ( GenesisKeyHash KeyHash 'Genesis
gh
            , (GenesisDelegateKeyHash KeyHash 'GenesisDelegate
gdh, VrfKeyHash Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto))
h)
            ) <-
            Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> [Item
      (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
forall l. IsList l => l -> [Item l]
toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
        ]

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

createDelegateKeys
  :: Vary [FormatBech32, FormatTextEnvelope]
  -> FilePath
  -> Word
  -> CIO e ()
createDelegateKeys :: forall e.
Vary '[FormatBech32, FormatTextEnvelope]
-> String -> Word -> CIO e ()
createDelegateKeys Vary '[FormatBech32, FormatTextEnvelope]
fmt String
dir Word
index = do
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir
  GenesisKeyGenDelegateCmdArgs -> CIO e ()
forall e. GenesisKeyGenDelegateCmdArgs -> CIO e ()
TN.runGenesisKeyGenDelegateCmd
    Cmd.GenesisKeyGenDelegateCmdArgs
      { verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"
      , signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = File (SigningKey ()) 'InOut -> SigningKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (SigningKey ()) 'InOut
coldSK
      , opCertCounterPath :: OpCertCounterFile 'Out
Cmd.opCertCounterPath = File OpCertCounter 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File OpCertCounter 'InOut
opCertCtr
      }
  ExceptT GenesisCmdError IO () -> RIO e ()
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT GenesisCmdError IO () -> RIO e ())
-> ExceptT GenesisCmdError IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$
    VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> ExceptT GenesisCmdError IO ()
TN.runGenesisKeyGenDelegateVRF
      (forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vrf.vkey")
      (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vrf.skey")

  NodeKeyGenKESCmdArgs -> RIO e ()
NodeKeyGenKESCmdArgs -> CIO e ()
forall e. NodeKeyGenKESCmdArgs -> CIO e ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> CIO e ())
-> NodeKeyGenKESCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (VerificationKey ()) 'InOut
kesVK)
      (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".kes.skey")
  NodeIssueOpCertCmdArgs -> RIO e ()
NodeIssueOpCertCmdArgs -> CIO e ()
forall e. NodeIssueOpCertCmdArgs -> CIO e ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> CIO e ())
-> NodeIssueOpCertCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> File OpCertCounter 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
      (VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (VerificationKey ()) 'InOut
kesVK))
      (File (SigningKey ()) 'InOut -> SigningKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (SigningKey ()) 'InOut
coldSK)
      File OpCertCounter 'InOut
opCertCtr
      (Word -> KESPeriod
KESPeriod Word
0)
      (String -> File () 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File () 'Out) -> String -> File () 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"opcert" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".cert")
 where
  strIndex :: String
strIndex = Word -> String
forall a. Show a => a -> String
show Word
index
  kesVK :: File (VerificationKey ()) 'InOut
kesVK = forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> File (VerificationKey ()) 'InOut)
-> String -> File (VerificationKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".kes.vkey"
  coldSK :: File (SigningKey ()) 'InOut
coldSK = forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> File (SigningKey ()) 'InOut)
-> String -> File (SigningKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey"
  opCertCtr :: File OpCertCounter 'InOut
opCertCtr = String -> File OpCertCounter 'InOut
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File OpCertCounter 'InOut)
-> String -> File OpCertCounter 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"delegate" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".counter"

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

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

createPoolCredentials
  :: Vary [FormatBech32, FormatTextEnvelope]
  -> FilePath
  -> Word
  -> CIO e ()
createPoolCredentials :: forall e.
Vary '[FormatBech32, FormatTextEnvelope]
-> String -> Word -> CIO e ()
createPoolCredentials Vary '[FormatBech32, FormatTextEnvelope]
fmt String
dir Word
index = do
  IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Bool -> String -> IO ()
createDirectoryIfMissing Bool
False String
dir

  NodeKeyGenKESCmdArgs -> RIO e ()
NodeKeyGenKESCmdArgs -> CIO e ()
forall e. NodeKeyGenKESCmdArgs -> CIO e ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> CIO e ())
-> NodeKeyGenKESCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (VerificationKey ()) 'InOut
kesVK)
      (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"kes" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey")
  NodeKeyGenVRFCmdArgs -> RIO e ()
NodeKeyGenVRFCmdArgs -> CIO e ()
forall e. NodeKeyGenVRFCmdArgs -> CIO e ()
runNodeKeyGenVrfCmd (NodeKeyGenVRFCmdArgs -> CIO e ())
-> NodeKeyGenVRFCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenVRFCmdArgs
Cmd.NodeKeyGenVRFCmdArgs
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"vrf" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey")
      (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"vrf" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey")
  NodeKeyGenColdCmdArgs -> RIO e ()
NodeKeyGenColdCmdArgs -> CIO e ()
forall e. NodeKeyGenColdCmdArgs -> CIO e ()
runNodeKeyGenColdCmd (NodeKeyGenColdCmdArgs -> CIO e ())
-> NodeKeyGenColdCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> OpCertCounterFile 'Out
-> NodeKeyGenColdCmdArgs
Cmd.NodeKeyGenColdCmdArgs
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"cold" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey")
      (File (SigningKey ()) 'InOut -> SigningKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (SigningKey ()) 'InOut
coldSK)
      (File OpCertCounter 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File OpCertCounter 'InOut
opCertCtr)
  NodeIssueOpCertCmdArgs -> RIO e ()
NodeIssueOpCertCmdArgs -> CIO e ()
forall e. NodeIssueOpCertCmdArgs -> CIO e ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> CIO e ())
-> NodeIssueOpCertCmdArgs -> CIO e ()
forall a b. (a -> b) -> a -> b
$
    VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> File OpCertCounter 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
      (VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (VerificationKey ()) 'InOut
kesVK))
      (File (SigningKey ()) 'InOut -> SigningKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (SigningKey ()) 'InOut
coldSK)
      File OpCertCounter 'InOut
opCertCtr
      (Word -> KESPeriod
KESPeriod Word
0)
      (String -> File () 'Out
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File () 'Out) -> String -> File () 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"opcert" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".cert")
  RIO e (VerificationKey StakeKey, SigningKey StakeKey) -> RIO e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (RIO e (VerificationKey StakeKey, SigningKey StakeKey) -> RIO e ())
-> RIO e (VerificationKey StakeKey, SigningKey StakeKey)
-> RIO e ()
forall a b. (a -> b) -> a -> b
$
    Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> CIO e (VerificationKey StakeKey, SigningKey StakeKey)
forall e.
Vary '[FormatBech32, FormatTextEnvelope]
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> CIO e (VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd
      Vary '[FormatBech32, FormatTextEnvelope]
fmt
      (forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> VerificationKeyFile 'Out)
-> String -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"staking-reward" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey")
      (forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> SigningKeyFile 'Out) -> String -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"staking-reward" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey")
 where
  strIndex :: String
strIndex = Word -> String
forall a. Show a => a -> String
show Word
index
  kesVK :: File (VerificationKey ()) 'InOut
kesVK = forall content (direction :: FileDirection).
String -> File content direction
File @(VerificationKey ()) (String -> File (VerificationKey ()) 'InOut)
-> String -> File (VerificationKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"kes" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".vkey"
  coldSK :: File (SigningKey ()) 'InOut
coldSK = forall content (direction :: FileDirection).
String -> File content direction
File @(SigningKey ()) (String -> File (SigningKey ()) 'InOut)
-> String -> File (SigningKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"cold" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".skey"
  opCertCtr :: File OpCertCounter 'InOut
opCertCtr = String -> File OpCertCounter 'InOut
forall content (direction :: FileDirection).
String -> File content direction
File (String -> File OpCertCounter 'InOut)
-> String -> File OpCertCounter 'InOut
forall a b. (a -> b) -> a -> b
$ String
dir String -> String -> String
</> String
"opcert" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".counter"

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

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

  VrfVerificationKey poolVrfVK <-
    firstExceptT (GenesisCmdNodeCmdError . NodeCmdReadFileError)
      . newExceptT
      $ readFileTextEnvelope poolVrfVKF
  rewardsSVK <-
    firstExceptT GenesisCmdTextEnvReadFileError
      . newExceptT
      $ readFileTextEnvelope @(VerificationKey StakeKey) poolRewardVKF

  pure
    L.PoolParams
      { L.ppId = L.hashKey poolColdVK
      , L.ppVrf = C.hashVerKeyVRF @C.StandardCrypto poolVrfVK
      , L.ppPledge = L.Coin 0
      , L.ppCost = L.Coin 0
      , L.ppMargin = minBound
      , L.ppRewardAccount =
          toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK)
      , L.ppOwners = mempty
      , L.ppRelays = lookupPoolRelay specifiedRelays
      , L.ppMetadata = L.SNothing
      }
 where
  lookupPoolRelay
    :: Map Word [L.StakePoolRelay] -> Seq.StrictSeq L.StakePoolRelay
  lookupPoolRelay :: Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
m =
    case Maybe Word
index of
      Maybe Word
Nothing -> StrictSeq StakePoolRelay
forall a. Monoid a => a
mempty
      Just Word
index' -> StrictSeq StakePoolRelay
-> ([StakePoolRelay] -> StrictSeq StakePoolRelay)
-> Maybe [StakePoolRelay]
-> StrictSeq StakePoolRelay
forall b a. b -> (a -> b) -> Maybe a -> b
maybe StrictSeq StakePoolRelay
forall a. Monoid a => a
mempty [Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay
[StakePoolRelay] -> StrictSeq StakePoolRelay
forall l. IsList l => [Item l] -> l
fromList (Word -> Map Word [StakePoolRelay] -> Maybe [StakePoolRelay]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Word
index' Map Word [StakePoolRelay]
m)

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

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

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

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

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

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

  evaluate . force $ (g2, delegation)

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

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

updateTemplate
  :: SystemStart
  -- ^ System start time
  -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
  -- ^ Genesis delegation (not stake-based)
  -> Maybe Lovelace
  -- ^ Amount of lovelace not delegated
  -> [AddressInEra ShelleyEra]
  -- ^ UTxO addresses that are not delegating
  -> Map (L.KeyHash 'L.Staking) L.PoolParams
  -- ^ Genesis staking: pools/delegation map & delegated initial UTxO spec
  -> Lovelace
  -- ^ Number of UTxO Addresses for delegation
  -> [AddressInEra ShelleyEra]
  -- ^ UTxO Addresses for delegation
  -> [AddressInEra ShelleyEra]
  -- ^ Stuffed UTxO addresses
  -> ShelleyGenesis
  -- ^ Template from which to build a genesis
  -> ShelleyGenesis
  -- ^ Updated genesis
updateTemplate :: SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> Map (KeyHash 'Staking) PoolParams
-> Coin
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis
-> ShelleyGenesis
updateTemplate
  (SystemStart UTCTime
start)
  Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
  Maybe Coin
mAmountNonDeleg
  [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
  Map (KeyHash 'Staking) PoolParams
poolSpecs
  (L.Coin Integer
amountDeleg)
  [AddressInEra ShelleyEra]
utxoAddrsDeleg
  [AddressInEra ShelleyEra]
stuffedUtxoAddrs
  ShelleyGenesis
template = do
    let pparamsFromTemplate :: PParams ShelleyEra
pparamsFromTemplate = ShelleyGenesis -> PParams ShelleyEra
sgProtocolParams ShelleyGenesis
template
        shelleyGenesis :: ShelleyGenesis
shelleyGenesis =
          ShelleyGenesis
template
            { sgSystemStart = start
            , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin
            , sgGenDelegs = shelleyDelKeys
            , sgInitialFunds =
                fromList
                  [ (toShelleyAddr addr, v)
                  | (addr, v) <-
                      distribute (nonDelegCoin - subtractForTreasury) utxoAddrsNonDeleg
                        ++ distribute (delegCoin - subtractForTreasury) utxoAddrsDeleg
                        ++ mkStuffedUtxo stuffedUtxoAddrs
                  ]
            , sgStaking =
                ShelleyGenesisStaking
                  { sgsPools =
                      fromList
                        [ (L.ppId poolParams, poolParams)
                        | poolParams <- Map.elems poolSpecs
                        ]
                  , sgsStake = ListMap.fromMap $ L.ppId <$> poolSpecs
                  }
            , sgProtocolParams = pparamsFromTemplate
            }
    ShelleyGenesis
shelleyGenesis
   where
    maximumLovelaceSupply :: Word64
    maximumLovelaceSupply :: Word64
maximumLovelaceSupply = ShelleyGenesis -> Word64
sgMaxLovelaceSupply ShelleyGenesis
template
    -- If the initial funds are equal to the maximum funds, rewards cannot be created.
    subtractForTreasury :: Integer
    subtractForTreasury :: Integer
subtractForTreasury = Integer
nonDelegCoin Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
10
    nonDelegCoin, delegCoin :: Integer
    nonDelegCoin :: Integer
nonDelegCoin = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> (Coin -> Word64) -> Maybe Coin -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
maximumLovelaceSupply Coin -> Word64
forall a. Integral a => Coin -> a
unLovelace Maybe Coin
mAmountNonDeleg)
    delegCoin :: Integer
delegCoin = Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
amountDeleg

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

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

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

    shelleyDelKeys :: Map (KeyHash 'Genesis) GenDelegPair
shelleyDelKeys =
      [Item (Map (KeyHash 'Genesis) GenDelegPair)]
-> Map (KeyHash 'Genesis) GenDelegPair
forall l. IsList l => [Item l] -> l
fromList
        [ (KeyHash 'Genesis
gh, KeyHash 'GenesisDelegate
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
L.GenDelegPair KeyHash 'GenesisDelegate
gdh (VRFVerKeyHash 'GenDelegVRF -> GenDelegPair)
-> VRFVerKeyHash 'GenDelegVRF -> GenDelegPair
forall a b. (a -> b) -> a -> b
$ Hash Blake2b_256 (VerKeyVRF PraosVRF) -> VRFVerKeyHash 'GenDelegVRF
forall v (r :: KeyRoleVRF).
Hash Blake2b_256 (VerKeyVRF v) -> VRFVerKeyHash r
L.toVRFVerKeyHash Hash Blake2b_256 (VerKeyVRF PraosVRF)
Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto))
h)
        | ( GenesisKeyHash KeyHash 'Genesis
gh
            , (GenesisDelegateKeyHash KeyHash 'GenesisDelegate
gdh, VrfKeyHash Hash Blake2b_256 (VerKeyVRF (VRF StandardCrypto))
h)
            ) <-
            Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> [Item
      (Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
forall l. IsList l => l -> [Item l]
toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
        ]

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

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

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

  let 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)
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)
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)
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
  unless (Map.null gkmExtra && Map.null dkmExtra && Map.null vkmExtra) $
    throwError $
      GenesisCmdMismatchedGenesisKeyFiles
        (Map.keys gkm)
        (Map.keys dkm)
        (Map.keys vkm)

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

  pure delegsMap

readGenesisKeys
  :: FilePath
  -> ExceptT
       GenesisCmdError
       IO
       (Map Int (VerificationKey GenesisKey))
readGenesisKeys :: String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
readGenesisKeys = (String -> Bool)
-> String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall key.
HasTextEnvelope key =>
(String -> Bool)
-> String -> ExceptT GenesisCmdError IO (Map Int key)
readKeys ((String -> Bool)
 -> String
 -> ExceptT
      GenesisCmdError IO (Map Int (VerificationKey GenesisKey)))
-> (String -> Bool)
-> String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall a b. (a -> b) -> a -> b
$ (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey") (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtension

readDelegateKeys
  :: FilePath
  -> ExceptT
       GenesisCmdError
       IO
       (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys :: String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
readDelegateKeys = (String -> Bool)
-> String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
forall key.
HasTextEnvelope key =>
(String -> Bool)
-> String -> ExceptT GenesisCmdError IO (Map Int key)
readKeys ((String -> Bool)
 -> String
 -> ExceptT
      GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey)))
-> (String -> Bool)
-> String
-> ExceptT
     GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
forall a b. (a -> b) -> a -> b
$ (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey") (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtensions

readDelegateVrfKeys
  :: FilePath
  -> ExceptT
       GenesisCmdError
       IO
       (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys :: String
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
readDelegateVrfKeys = (String -> Bool)
-> String
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
forall key.
HasTextEnvelope key =>
(String -> Bool)
-> String -> ExceptT GenesisCmdError IO (Map Int key)
readKeys ((String -> Bool)
 -> String
 -> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey)))
-> (String -> Bool)
-> String
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
forall a b. (a -> b) -> a -> b
$ (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vrf.vkey") (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
takeExtensions

readKeys
  :: HasTextEnvelope key
  => (FilePath -> Bool)
  -- ^ File name filter
  -> FilePath
  -- ^ keys directory
  -> ExceptT
       GenesisCmdError
       IO
       (Map Int key)
  -- ^ Map of index to the key
readKeys :: forall key.
HasTextEnvelope key =>
(String -> Bool)
-> String -> ExceptT GenesisCmdError IO (Map Int key)
readKeys String -> Bool
filterFile String
gendir = do
  files <- IO [String] -> ExceptT GenesisCmdError IO [String]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
gendir)
  fileIxs <-
    extractFileNameIndexes
      [ gendir </> file
      | file <- files
      , filterFile file
      ]
  firstExceptT GenesisCmdTextEnvReadFileError $
    fromList
      <$> sequence
        [ (,) ix <$> readKey (File file)
        | (file, ix) <- fileIxs
        ]
 where
  readKey :: File content 'In -> ExceptT (FileError TextEnvelopeError) IO key
readKey = IO (Either (FileError TextEnvelopeError) key)
-> ExceptT (FileError TextEnvelopeError) IO key
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) key)
 -> ExceptT (FileError TextEnvelopeError) IO key)
-> (File content 'In
    -> IO (Either (FileError TextEnvelopeError) key))
-> File content 'In
-> ExceptT (FileError TextEnvelopeError) IO key
forall b c a. (b -> c) -> (a -> b) -> a -> c
. File content 'In -> IO (Either (FileError TextEnvelopeError) key)
forall a content.
HasTextEnvelope a =>
File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope

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

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

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

readInitialFundAddresses
  :: FilePath
  -> NetworkId
  -> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses :: String
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses String
utxodir NetworkId
nw = do
  files <- IO [String] -> ExceptT GenesisCmdError IO [String]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
utxodir)
  vkeys <-
    firstExceptT GenesisCmdTextEnvReadFileError $
      sequence
        [ newExceptT $
            readFileTextEnvelope
              @(VerificationKey GenesisUTxOKey)
              (File (utxodir </> file))
        | file <- files
        , takeExtension file == ".vkey"
        ]
  return
    [ addr
    | vkey <- vkeys
    , let 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 =
            ShelleyBasedEra ShelleyEra
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra ShelleyEra
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra
              ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
              NetworkId
nw
              (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
              StakeAddressReference
NoStakeAddress
    ]

-- | Hash a genesis file
runGenesisHashFileCmd :: GenesisFile -> CIO e ()
runGenesisHashFileCmd :: forall e. GenesisFile -> CIO e ()
runGenesisHashFileCmd (GenesisFile String
fpath) = do
  content <-
    String -> RIO e ByteString
forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
String -> m ByteString
readFileCli String
fpath
  let gh :: Crypto.Hash Crypto.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
  liftIO $ Text.putStrLn (Crypto.hashToTextAsHex gh)

writeOutput
  :: Maybe (File content Out)
  -> Text
  -> CIO e ()
writeOutput :: forall content e. Maybe (File content 'Out) -> Text -> CIO e ()
writeOutput Maybe (File content 'Out)
mOutput Text
t =
  case Maybe (File content 'Out)
mOutput of
    Just File content 'Out
fp -> IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ String -> Text -> IO ()
Text.writeFile (File content 'Out -> String
forall content (direction :: FileDirection).
File content direction -> String
unFile File content 'Out
fp) Text
t
    Maybe (File content 'Out)
Nothing -> IO () -> RIO e ()
forall a. IO a -> RIO e a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> RIO e ()) -> IO () -> RIO e ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStr Text
t