{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeApplications #-}
module Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData
( runGenesisKeyGenUTxOCmd
, runGenesisKeyGenGenesisCmd
, runGenesisKeyGenDelegateCmd
, runGenesisCreateTestNetDataCmd
, runGenesisKeyGenDelegateVRF
, writeFileGenesis
, WriteFileGenesis (..)
)
where
import Cardano.Api hiding (ConwayEra)
import Cardano.Api.Consensus (ShelleyGenesisStaking (..))
import Cardano.Api.Ledger (StrictMaybe (SNothing))
import qualified Cardano.Api.Ledger as L
import Cardano.Api.Shelley (Hash (..), KESPeriod (KESPeriod),
OperationalCertificateIssueCounter (OperationalCertificateIssueCounter),
ShelleyGenesis (ShelleyGenesis, sgGenDelegs, sgInitialFunds, sgMaxLovelaceSupply, sgNetworkMagic, sgProtocolParams, sgStaking, sgSystemStart),
StakeCredential (StakeCredentialByKey), VerificationKey (VrfVerificationKey),
VrfKey, alonzoGenesisDefaults, conwayGenesisDefaults, shelleyGenesisDefaults,
toShelleyAddr, toShelleyNetwork, toShelleyStakeAddr)
import Cardano.CLI.Byron.Genesis (NewDirectory (NewDirectory))
import qualified Cardano.CLI.Byron.Genesis as Byron
import qualified Cardano.CLI.Commands.Node as Cmd
import Cardano.CLI.EraBased.Commands.Genesis as Cmd
import qualified Cardano.CLI.EraBased.Commands.Governance.Committee as CC
import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as DRep
import Cardano.CLI.EraBased.Run.Genesis.Byron as Byron
import Cardano.CLI.EraBased.Run.Genesis.Common
import qualified Cardano.CLI.EraBased.Run.Governance.Committee as CC
import qualified Cardano.CLI.EraBased.Run.Governance.DRep as DRep
import Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd)
import qualified Cardano.CLI.IO.Lazy as Lazy
import Cardano.CLI.Run.Address (generateAndWriteKeyFiles)
import qualified Cardano.CLI.Run.Key as Key
import Cardano.CLI.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd,
runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd)
import Cardano.CLI.Types.Common
import Cardano.CLI.Types.Errors.GenesisCmdError
import Cardano.CLI.Types.Errors.NodeCmdError
import Cardano.CLI.Types.Errors.StakePoolCmdError
import Cardano.CLI.Types.Key
import qualified Cardano.Crypto.Hash as Crypto
import Cardano.Prelude (canonicalEncodePretty)
import Control.DeepSeq (NFData, deepseq)
import Control.Monad (forM, forM_, unless, void, when)
import qualified Data.Aeson.Encode.Pretty as Aeson
import Data.Bifunctor (Bifunctor (..))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy.Char8 as LBS
import Data.Function ((&))
import Data.Functor.Identity (Identity)
import Data.ListMap (ListMap (..))
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe (fromMaybe)
import qualified Data.Sequence.Strict as Seq
import qualified Data.Set as Set
import Data.String (fromString)
import qualified Data.Text as Text
import Data.Tuple (swap)
import Data.Word (Word64)
import GHC.Exts (IsList (..))
import GHC.Generics (Generic)
import GHC.Num (Natural)
import Lens.Micro ((^.))
import System.Directory
import System.FilePath ((</>))
import qualified System.Random as Random
import System.Random (StdGen)
import qualified Text.JSON.Canonical (ToJSON)
import Text.JSON.Canonical (parseCanonicalJSON, renderCanonicalJSON)
import Text.Printf (printf)
runGenesisKeyGenGenesisCmd
:: GenesisKeyGenGenesisCmdArgs
-> ExceptT GenesisCmdError IO ()
runGenesisKeyGenGenesisCmd :: GenesisKeyGenGenesisCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenGenesisCmd
Cmd.GenesisKeyGenGenesisCmdArgs
{ VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenGenesisCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
, SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenGenesisCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
} = do
SigningKey GenesisKey
skey <- AsType GenesisKey
-> ExceptT GenesisCmdError IO (SigningKey GenesisKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisKey
AsGenesisKey
let vkey :: VerificationKey GenesisKey
vkey = SigningKey GenesisKey -> VerificationKey GenesisKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisKey
skey
(FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdGenesisFileError (ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GenesisCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ SigningKeyFile 'Out -> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> SigningKey GenesisKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisKey
skey
VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$ Maybe TextEnvelopeDescr -> VerificationKey GenesisKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.genesisVkeyDesc) VerificationKey GenesisKey
vkey
where
skeyDesc :: TextEnvelopeDescr
skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis Signing Key"
runGenesisKeyGenDelegateCmd
:: GenesisKeyGenDelegateCmdArgs
-> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateCmd :: GenesisKeyGenDelegateCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateCmd
Cmd.GenesisKeyGenDelegateCmdArgs
{ VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenDelegateCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
, SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenDelegateCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
, OpCertCounterFile 'Out
opCertCounterPath :: OpCertCounterFile 'Out
opCertCounterPath :: GenesisKeyGenDelegateCmdArgs -> OpCertCounterFile 'Out
Cmd.opCertCounterPath
} = do
SigningKey GenesisDelegateKey
skey <- AsType GenesisDelegateKey
-> ExceptT GenesisCmdError IO (SigningKey GenesisDelegateKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisDelegateKey
AsGenesisDelegateKey
let vkey :: VerificationKey GenesisDelegateKey
vkey = SigningKey GenesisDelegateKey -> VerificationKey GenesisDelegateKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisDelegateKey
skey
(FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdGenesisFileError (ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GenesisCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
SigningKeyFile 'Out -> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$
Maybe TextEnvelopeDescr
-> SigningKey GenesisDelegateKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisDelegateKey
skey
IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$
Maybe TextEnvelopeDescr
-> VerificationKey GenesisDelegateKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
Key.genesisVkeyDelegateDesc) VerificationKey GenesisDelegateKey
vkey
OpCertCounterFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile OpCertCounterFile 'Out
opCertCounterPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
Maybe TextEnvelopeDescr
-> OperationalCertificateIssueCounter -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
certCtrDesc) (OperationalCertificateIssueCounter -> ByteString)
-> OperationalCertificateIssueCounter -> ByteString
forall a b. (a -> b) -> a -> b
$
Word64
-> VerificationKey StakePoolKey
-> OperationalCertificateIssueCounter
OperationalCertificateIssueCounter
Word64
initialCounter
(VerificationKey GenesisDelegateKey -> VerificationKey StakePoolKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisDelegateKey
vkey)
where
skeyDesc, certCtrDesc :: TextEnvelopeDescr
skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis delegate operator key"
certCtrDesc :: TextEnvelopeDescr
certCtrDesc =
TextEnvelopeDescr
"Next certificate issue number: "
TextEnvelopeDescr -> TextEnvelopeDescr -> TextEnvelopeDescr
forall a. Semigroup a => a -> a -> a
<> FilePath -> TextEnvelopeDescr
forall a. IsString a => FilePath -> a
fromString (Word64 -> FilePath
forall a. Show a => a -> FilePath
show Word64
initialCounter)
initialCounter :: Word64
initialCounter :: Word64
initialCounter = Word64
0
runGenesisKeyGenDelegateVRF
:: VerificationKeyFile Out
-> SigningKeyFile Out
-> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateVRF :: VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateVRF VerificationKeyFile 'Out
vkeyPath SigningKeyFile 'Out
skeyPath = do
SigningKey VrfKey
skey <- AsType VrfKey -> ExceptT GenesisCmdError IO (SigningKey VrfKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType VrfKey
AsVrfKey
let vkey :: VerificationKey VrfKey
vkey = SigningKey VrfKey -> VerificationKey VrfKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey VrfKey
skey
(FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdGenesisFileError (ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GenesisCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
SigningKeyFile 'Out -> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
skeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$
Maybe TextEnvelopeDescr -> SigningKey VrfKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey VrfKey
skey
VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
vkeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
Maybe TextEnvelopeDescr -> VerificationKey VrfKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey VrfKey
vkey
where
skeyDesc, vkeyDesc :: TextEnvelopeDescr
skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"VRF Signing Key"
vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"VRF Verification Key"
runGenesisKeyGenUTxOCmd
:: GenesisKeyGenUTxOCmdArgs
-> ExceptT GenesisCmdError IO ()
runGenesisKeyGenUTxOCmd :: GenesisKeyGenUTxOCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenUTxOCmd
Cmd.GenesisKeyGenUTxOCmdArgs
{ VerificationKeyFile 'Out
verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath :: GenesisKeyGenUTxOCmdArgs -> VerificationKeyFile 'Out
Cmd.verificationKeyPath
, SigningKeyFile 'Out
signingKeyPath :: SigningKeyFile 'Out
signingKeyPath :: GenesisKeyGenUTxOCmdArgs -> SigningKeyFile 'Out
Cmd.signingKeyPath
} = do
SigningKey GenesisUTxOKey
skey <- AsType GenesisUTxOKey
-> ExceptT GenesisCmdError IO (SigningKey GenesisUTxOKey)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole) =>
AsType keyrole -> m (SigningKey keyrole)
generateSigningKey AsType GenesisUTxOKey
AsGenesisUTxOKey
let vkey :: VerificationKey GenesisUTxOKey
vkey = SigningKey GenesisUTxOKey -> VerificationKey GenesisUTxOKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisUTxOKey
skey
(FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdGenesisFileError (ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GenesisCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
IO (Either (FileError Any) ()) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO (Either (FileError Any) ()) -> IO ())
-> IO (Either (FileError Any) ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
SigningKeyFile 'Out -> ByteString -> IO (Either (FileError Any) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile SigningKeyFile 'Out
signingKeyPath (ByteString -> IO (Either (FileError Any) ()))
-> ByteString -> IO (Either (FileError Any) ())
forall a b. (a -> b) -> a -> b
$
Maybe TextEnvelopeDescr -> SigningKey GenesisUTxOKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisUTxOKey
skey
VerificationKeyFile 'Out
-> ByteString -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> ByteString -> m (Either (FileError e) ())
writeLazyByteStringFile VerificationKeyFile 'Out
verificationKeyPath (ByteString -> IO (Either (FileError ()) ()))
-> ByteString -> IO (Either (FileError ()) ())
forall a b. (a -> b) -> a -> b
$
Maybe TextEnvelopeDescr
-> VerificationKey GenesisUTxOKey -> ByteString
forall a.
HasTextEnvelope a =>
Maybe TextEnvelopeDescr -> a -> ByteString
textEnvelopeToJSON (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey GenesisUTxOKey
vkey
where
skeyDesc, vkeyDesc :: TextEnvelopeDescr
skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Genesis Initial UTxO Signing Key"
vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Genesis Initial UTxO Verification Key"
writeFileGenesis
:: FilePath
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Crypto.Hash Crypto.Blake2b_256 ByteString)
writeFileGenesis :: FilePath
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis FilePath
fpath WriteFileGenesis
genesis = do
(IOException -> GenesisCmdError)
-> IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> GenesisCmdError
GenesisCmdGenesisFileError (FileError () -> GenesisCmdError)
-> (IOException -> FileError ()) -> IOException -> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IOException -> FileError ()
forall e. FilePath -> IOException -> FileError e
FileIOError FilePath
fpath) (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> ByteString -> IO ()
BS.writeFile FilePath
fpath ByteString
content
Hash Blake2b_256 ByteString
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a. a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Hash Blake2b_256 ByteString
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> Hash Blake2b_256 ByteString
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id ByteString
content
where
content :: ByteString
content = case WriteFileGenesis
genesis of
WritePretty genesis
a -> ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ genesis -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encodePretty genesis
a
WriteCanonical genesis
a ->
ByteString -> ByteString
LBS.toStrict
(ByteString -> ByteString)
-> (genesis -> ByteString) -> genesis -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. JSValue -> ByteString
renderCanonicalJSON
(JSValue -> ByteString)
-> (genesis -> JSValue) -> genesis -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> JSValue)
-> (JSValue -> JSValue) -> Either FilePath JSValue -> JSValue
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> JSValue
forall a. HasCallStack => FilePath -> a
error (FilePath -> JSValue)
-> (FilePath -> FilePath) -> FilePath -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
"error parsing json that was just encoded!? " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) JSValue -> JSValue
forall a. a -> a
id
(Either FilePath JSValue -> JSValue)
-> (genesis -> Either FilePath JSValue) -> genesis -> JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath JSValue
parseCanonicalJSON
(ByteString -> Either FilePath JSValue)
-> (genesis -> ByteString) -> genesis -> Either FilePath JSValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. genesis -> ByteString
forall a. ToJSON Identity a => a -> ByteString
canonicalEncodePretty
(genesis -> ByteString) -> genesis -> ByteString
forall a b. (a -> b) -> a -> b
$ genesis
a
data WriteFileGenesis where
WriteCanonical :: Text.JSON.Canonical.ToJSON Identity genesis => genesis -> WriteFileGenesis
WritePretty :: ToJSON genesis => genesis -> WriteFileGenesis
runGenesisCreateTestNetDataCmd
:: GenesisCreateTestNetDataCmdArgs
-> ExceptT GenesisCmdError IO ()
runGenesisCreateTestNetDataCmd :: GenesisCreateTestNetDataCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisCreateTestNetDataCmd
Cmd.GenesisCreateTestNetDataCmdArgs
{ Era era
eon :: Era era
eon :: ()
eon
, Maybe NetworkId
networkId :: Maybe NetworkId
networkId :: GenesisCreateTestNetDataCmdArgs -> Maybe NetworkId
networkId
, Maybe FilePath
specShelley :: Maybe FilePath
specShelley :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
specShelley
, Maybe FilePath
specAlonzo :: Maybe FilePath
specAlonzo :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
specAlonzo
, Maybe FilePath
specConway :: Maybe FilePath
specConway :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
specConway
, Word
numGenesisKeys :: Word
numGenesisKeys :: GenesisCreateTestNetDataCmdArgs -> Word
numGenesisKeys
, Word
numPools :: Word
numPools :: GenesisCreateTestNetDataCmdArgs -> Word
numPools
, stakeDelegators :: GenesisCreateTestNetDataCmdArgs -> StakeDelegators
stakeDelegators =
StakeDelegators
{ CredentialGenerationMode
stakeDelegatorsGenerationMode :: CredentialGenerationMode
stakeDelegatorsGenerationMode :: StakeDelegators -> CredentialGenerationMode
stakeDelegatorsGenerationMode
, Word
numOfStakeDelegators :: Word
numOfStakeDelegators :: StakeDelegators -> Word
numOfStakeDelegators
}
, Word
numCommitteeKeys :: Word
numCommitteeKeys :: GenesisCreateTestNetDataCmdArgs -> Word
numCommitteeKeys
, numDRepKeys :: GenesisCreateTestNetDataCmdArgs -> DRepCredentials
numDRepKeys =
DRepCredentials
{ CredentialGenerationMode
dRepCredentialGenerationMode :: CredentialGenerationMode
dRepCredentialGenerationMode :: DRepCredentials -> CredentialGenerationMode
dRepCredentialGenerationMode
, Word
numOfDRepCredentials :: Word
numOfDRepCredentials :: DRepCredentials -> Word
numOfDRepCredentials
}
, Word
numStuffedUtxo :: Word
numStuffedUtxo :: GenesisCreateTestNetDataCmdArgs -> Word
numStuffedUtxo
, Word
numUtxoKeys :: Word
numUtxoKeys :: GenesisCreateTestNetDataCmdArgs -> Word
numUtxoKeys
, Maybe Coin
totalSupply :: Maybe Coin
totalSupply :: GenesisCreateTestNetDataCmdArgs -> Maybe Coin
totalSupply
, Maybe Coin
delegatedSupply :: Maybe Coin
delegatedSupply :: GenesisCreateTestNetDataCmdArgs -> Maybe Coin
delegatedSupply
, Maybe FilePath
relays :: Maybe FilePath
relays :: GenesisCreateTestNetDataCmdArgs -> Maybe FilePath
relays
, Maybe SystemStart
systemStart :: Maybe SystemStart
systemStart :: GenesisCreateTestNetDataCmdArgs -> Maybe SystemStart
systemStart
, FilePath
outputDir :: FilePath
outputDir :: GenesisCreateTestNetDataCmdArgs -> FilePath
outputDir
} = do
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
False FilePath
outputDir
let era :: CardanoEra era
era = Era era -> CardanoEra era
forall era. Era era -> CardanoEra era
forall a (f :: a -> *) (g :: a -> *) (era :: a).
Convert f g =>
f era -> g era
convert Era era
eon
ShelleyGenesis StandardCrypto
shelleyGenesisInit <-
ShelleyGenesis StandardCrypto
-> Maybe (ShelleyGenesis StandardCrypto)
-> ShelleyGenesis StandardCrypto
forall a. a -> Maybe a -> a
fromMaybe ShelleyGenesis StandardCrypto
shelleyGenesisDefaults (Maybe (ShelleyGenesis StandardCrypto)
-> ShelleyGenesis StandardCrypto)
-> ExceptT
GenesisCmdError IO (Maybe (ShelleyGenesis StandardCrypto))
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto))
-> Maybe FilePath
-> ExceptT
GenesisCmdError IO (Maybe (ShelleyGenesis StandardCrypto))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse FilePath
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
FilePath -> t m (ShelleyGenesis StandardCrypto)
decodeShelleyGenesisFile Maybe FilePath
specShelley
AlonzoGenesis
alonzoGenesis <-
AlonzoGenesis -> Maybe AlonzoGenesis -> AlonzoGenesis
forall a. a -> Maybe a -> a
fromMaybe (CardanoEra era -> AlonzoGenesis
forall era. CardanoEra era -> AlonzoGenesis
alonzoGenesisDefaults CardanoEra era
era) (Maybe AlonzoGenesis -> AlonzoGenesis)
-> ExceptT GenesisCmdError IO (Maybe AlonzoGenesis)
-> ExceptT GenesisCmdError IO AlonzoGenesis
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> ExceptT GenesisCmdError IO AlonzoGenesis)
-> Maybe FilePath
-> ExceptT GenesisCmdError IO (Maybe AlonzoGenesis)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Maybe (CardanoEra era)
-> FilePath -> ExceptT GenesisCmdError IO AlonzoGenesis
forall (t :: (* -> *) -> * -> *) (m :: * -> *) era.
MonadIOTransError GenesisCmdError t m =>
Maybe (CardanoEra era) -> FilePath -> t m AlonzoGenesis
decodeAlonzoGenesisFile (CardanoEra era -> Maybe (CardanoEra era)
forall a. a -> Maybe a
Just CardanoEra era
era)) Maybe FilePath
specAlonzo
ConwayGenesis StandardCrypto
conwayGenesis <- ConwayGenesis StandardCrypto
-> Maybe (ConwayGenesis StandardCrypto)
-> ConwayGenesis StandardCrypto
forall a. a -> Maybe a -> a
fromMaybe ConwayGenesis StandardCrypto
conwayGenesisDefaults (Maybe (ConwayGenesis StandardCrypto)
-> ConwayGenesis StandardCrypto)
-> ExceptT
GenesisCmdError IO (Maybe (ConwayGenesis StandardCrypto))
-> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath
-> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto))
-> Maybe FilePath
-> ExceptT
GenesisCmdError IO (Maybe (ConwayGenesis StandardCrypto))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse FilePath
-> ExceptT GenesisCmdError IO (ConwayGenesis StandardCrypto)
forall (t :: (* -> *) -> * -> *) (m :: * -> *).
MonadIOTransError GenesisCmdError t m =>
FilePath -> t m (ConwayGenesis StandardCrypto)
decodeConwayGenesisFile Maybe FilePath
specConway
let actualNetworkId :: NetworkId
actualNetworkId =
case Maybe NetworkId
networkId of
Just NetworkId
networkFromFlag -> NetworkId
networkFromFlag
Maybe NetworkId
Nothing -> NetworkMagic -> NetworkId
fromNetworkMagic (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Word32 -> NetworkMagic
forall a b. (a -> b) -> a -> b
$ ShelleyGenesis StandardCrypto -> Word32
forall c. ShelleyGenesis c -> Word32
sgNetworkMagic ShelleyGenesis StandardCrypto
shelleyGenesisInit)
actualNetworkWord32 :: Word32
actualNetworkWord32 = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
actualNetworkId)
shelleyGenesis :: ShelleyGenesis StandardCrypto
shelleyGenesis = ShelleyGenesis StandardCrypto
shelleyGenesisInit{sgNetworkMagic = actualNetworkWord32}
genesisVKeysPaths :: Map Int FilePath
genesisVKeysPaths = Word -> FilePath -> FilePath -> FilePath -> Map Int FilePath
mkPaths Word
numGenesisKeys FilePath
genesisDir FilePath
"genesis" FilePath
"key.vkey"
delegateKeys :: Map Int FilePath
delegateKeys = Word -> FilePath -> FilePath -> FilePath -> Map Int FilePath
mkPaths Word
numGenesisKeys FilePath
delegateDir FilePath
"delegate" FilePath
"key.vkey"
delegateVrfKeys :: Map Int FilePath
delegateVrfKeys = Word -> FilePath -> FilePath -> FilePath -> Map Int FilePath
mkPaths Word
numGenesisKeys FilePath
delegateDir FilePath
"delegate" FilePath
"vrf.vkey"
stakeDelegatorsDirs :: [FilePath]
stakeDelegatorsDirs = [FilePath
stakeDelegatorsDir FilePath -> FilePath -> FilePath
</> FilePath
"delegator" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
i | Word
i <- [Word
1 .. Word
numOfStakeDelegators]]
[Word]
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word
1 .. Word
numGenesisKeys] ((Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ())
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
FilePath -> ExceptT GenesisCmdError IO ()
createGenesisKeys (FilePath
genesisDir FilePath -> FilePath -> FilePath
</> (FilePath
"genesis" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))
KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createDelegateKeys KeyOutputFormat
desiredKeyOutputFormat (FilePath
delegateDir FilePath -> FilePath -> FilePath
</> (FilePath
"delegate" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))
Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numGenesisKeys) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
genesisDir Text
genesisREADME
FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
delegateDir Text
delegatesREADME
let utxoKeyFileNames :: [FilePath]
utxoKeyFileNames =
[ FilePath
utxoKeysDir FilePath -> FilePath -> FilePath
</> (FilePath
"utxo" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index) FilePath -> FilePath -> FilePath
</> FilePath
"utxo.vkey"
| Word
index <- [Word
1 .. Word
numUtxoKeys]
]
[Word]
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word
1 .. Word
numUtxoKeys] ((Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ())
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \Word
index ->
FilePath -> ExceptT GenesisCmdError IO ()
createUtxoKeys (FilePath
utxoKeysDir FilePath -> FilePath -> FilePath
</> (FilePath
"utxo" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index))
Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numUtxoKeys) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
utxoKeysDir Text
utxoKeysREADME
Maybe (Map Word [StakePoolRelay])
mSPOsRelays <- Maybe FilePath
-> (FilePath
-> ExceptT GenesisCmdError IO (Map Word [StakePoolRelay]))
-> ExceptT GenesisCmdError IO (Maybe (Map Word [StakePoolRelay]))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM Maybe FilePath
relays FilePath -> ExceptT GenesisCmdError IO (Map Word [StakePoolRelay])
forall (m :: * -> *).
MonadIO m =>
FilePath -> ExceptT GenesisCmdError m (Map Word [StakePoolRelay])
readRelays
case (Maybe FilePath
relays, Maybe (Map Word [StakePoolRelay])
mSPOsRelays) of
(Just FilePath
fp, Just Map Word [StakePoolRelay]
stakePoolRelays)
| Map Word [StakePoolRelay] -> Int
forall k a. Map k a -> Int
Map.size Map Word [StakePoolRelay]
stakePoolRelays Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
numPools ->
GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a. GenesisCmdError -> ExceptT GenesisCmdError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisCmdError -> ExceptT GenesisCmdError IO ())
-> GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Int -> Int -> GenesisCmdError
GenesisCmdTooManyRelaysError FilePath
fp (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
numPools) (Map Word [StakePoolRelay] -> Int
forall k a. Map k a -> Int
Map.size Map Word [StakePoolRelay]
stakePoolRelays)
(Maybe FilePath, Maybe (Map Word [StakePoolRelay]))
_ -> () -> ExceptT GenesisCmdError IO ()
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
[PoolParams StandardCrypto]
poolParams <- [Word]
-> (Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT GenesisCmdError IO [PoolParams StandardCrypto]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Word
1 .. Word
numPools] ((Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT GenesisCmdError IO [PoolParams StandardCrypto])
-> (Word -> ExceptT GenesisCmdError IO (PoolParams StandardCrypto))
-> ExceptT GenesisCmdError IO [PoolParams StandardCrypto]
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
let poolDir :: FilePath
poolDir = Word -> FilePath
mkPoolDir Word
index
KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createPoolCredentials KeyOutputFormat
desiredKeyOutputFormat FilePath
poolDir
NetworkId
-> FilePath
-> Word
-> Map Word [StakePoolRelay]
-> ExceptT GenesisCmdError IO (PoolParams StandardCrypto)
buildPoolParams NetworkId
actualNetworkId FilePath
poolDir (Word
index Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1) (Map Word [StakePoolRelay]
-> Maybe (Map Word [StakePoolRelay]) -> Map Word [StakePoolRelay]
forall a. a -> Maybe a -> a
fromMaybe Map Word [StakePoolRelay]
forall a. Monoid a => a
mempty Maybe (Map Word [StakePoolRelay])
mSPOsRelays)
Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numPools) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
poolsDir Text
poolsREADME
[VerificationKey CommitteeColdKey]
ccColdKeys <- [Word]
-> (Word
-> ExceptT GenesisCmdError IO (VerificationKey CommitteeColdKey))
-> ExceptT GenesisCmdError IO [VerificationKey CommitteeColdKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Word
1 .. Word
numCommitteeKeys] ((Word
-> ExceptT GenesisCmdError IO (VerificationKey CommitteeColdKey))
-> ExceptT GenesisCmdError IO [VerificationKey CommitteeColdKey])
-> (Word
-> ExceptT GenesisCmdError IO (VerificationKey CommitteeColdKey))
-> ExceptT GenesisCmdError IO [VerificationKey CommitteeColdKey]
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
let committeeDir :: FilePath
committeeDir = FilePath
committeesDir FilePath -> FilePath -> FilePath
</> FilePath
"cc" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index
vkeyHotFile :: VerificationKeyFile 'Out
vkeyHotFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
committeeDir FilePath -> FilePath -> FilePath
</> FilePath
"cc.hot.vkey"
skeyHotFile :: SigningKeyFile 'Out
skeyHotFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
committeeDir FilePath -> FilePath -> FilePath
</> FilePath
"cc.hot.skey"
vkeyColdFile :: VerificationKeyFile 'Out
vkeyColdFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
committeeDir FilePath -> FilePath -> FilePath
</> FilePath
"cc.cold.vkey"
skeyColdFile :: SigningKeyFile 'Out
skeyColdFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
committeeDir FilePath -> FilePath -> FilePath
</> FilePath
"cc.cold.skey"
hotArgs :: GovernanceCommitteeKeyGenHotCmdArgs ConwayEra
hotArgs = ConwayEraOnwards ConwayEra
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceCommitteeKeyGenHotCmdArgs ConwayEra
forall era.
ConwayEraOnwards era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceCommitteeKeyGenHotCmdArgs era
CC.GovernanceCommitteeKeyGenHotCmdArgs ConwayEraOnwards ConwayEra
ConwayEraOnwardsConway VerificationKeyFile 'Out
vkeyHotFile SigningKeyFile 'Out
skeyHotFile
coldArgs :: GovernanceCommitteeKeyGenColdCmdArgs ConwayEra
coldArgs = ConwayEraOnwards ConwayEra
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceCommitteeKeyGenColdCmdArgs ConwayEra
forall era.
ConwayEraOnwards era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceCommitteeKeyGenColdCmdArgs era
CC.GovernanceCommitteeKeyGenColdCmdArgs ConwayEraOnwards ConwayEra
ConwayEraOnwardsConway VerificationKeyFile 'Out
vkeyColdFile SigningKeyFile 'Out
skeyColdFile
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
committeeDir
ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
-> ExceptT GenesisCmdError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
-> ExceptT GenesisCmdError IO ())
-> ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
(GovernanceCommitteeError -> GenesisCmdError)
-> ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
withExceptT GovernanceCommitteeError -> GenesisCmdError
GenesisCmdGovernanceCommitteeError (ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey))
-> ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
forall a b. (a -> b) -> a -> b
$
GovernanceCommitteeKeyGenHotCmdArgs ConwayEra
-> ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
forall era.
GovernanceCommitteeKeyGenHotCmdArgs era
-> ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeHotKey, SigningKey CommitteeHotKey)
CC.runGovernanceCommitteeKeyGenHot GovernanceCommitteeKeyGenHotCmdArgs ConwayEra
hotArgs
(VerificationKey CommitteeColdKey
vColdKey, SigningKey CommitteeColdKey
_) <-
(GovernanceCommitteeError -> GenesisCmdError)
-> ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
withExceptT GovernanceCommitteeError -> GenesisCmdError
GenesisCmdGovernanceCommitteeError (ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey))
-> ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
forall a b. (a -> b) -> a -> b
$
GovernanceCommitteeKeyGenColdCmdArgs ConwayEra
-> ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
forall era.
GovernanceCommitteeKeyGenColdCmdArgs era
-> ExceptT
GovernanceCommitteeError
IO
(VerificationKey CommitteeColdKey, SigningKey CommitteeColdKey)
CC.runGovernanceCommitteeKeyGenCold GovernanceCommitteeKeyGenColdCmdArgs ConwayEra
coldArgs
VerificationKey CommitteeColdKey
-> ExceptT GenesisCmdError IO (VerificationKey CommitteeColdKey)
forall a. a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VerificationKey CommitteeColdKey
vColdKey
Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numCommitteeKeys) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
committeesDir Text
committeeREADME
StdGen
g <- ExceptT GenesisCmdError IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
Random.getStdGen
[VerificationKey DRepKey]
dRepKeys <- (FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
-> ExceptT GenesisCmdError IO [VerificationKey DRepKey]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdFileError (ExceptT (FileError ()) IO [VerificationKey DRepKey]
-> ExceptT GenesisCmdError IO [VerificationKey DRepKey])
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
-> ExceptT GenesisCmdError IO [VerificationKey DRepKey]
forall a b. (a -> b) -> a -> b
$
case CredentialGenerationMode
dRepCredentialGenerationMode of
CredentialGenerationMode
OnDisk -> [Word]
-> (Word -> ExceptT (FileError ()) IO (VerificationKey DRepKey))
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Word
1 .. Word
numOfDRepCredentials] ((Word -> ExceptT (FileError ()) IO (VerificationKey DRepKey))
-> ExceptT (FileError ()) IO [VerificationKey DRepKey])
-> (Word -> ExceptT (FileError ()) IO (VerificationKey DRepKey))
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
let drepDir :: FilePath
drepDir = FilePath
drepsDir FilePath -> FilePath -> FilePath
</> FilePath
"drep" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
index
vkeyFile :: VerificationKeyFile 'Out
vkeyFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
drepDir FilePath -> FilePath -> FilePath
</> FilePath
"drep.vkey"
skeyFile :: SigningKeyFile 'Out
skeyFile = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
drepDir FilePath -> FilePath -> FilePath
</> FilePath
"drep.skey"
cmd :: GovernanceDRepKeyGenCmdArgs ConwayEra
cmd = ConwayEraOnwards ConwayEra
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceDRepKeyGenCmdArgs ConwayEra
forall era.
ConwayEraOnwards era
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> GovernanceDRepKeyGenCmdArgs era
DRep.GovernanceDRepKeyGenCmdArgs ConwayEraOnwards ConwayEra
ConwayEraOnwardsConway VerificationKeyFile 'Out
vkeyFile SigningKeyFile 'Out
skeyFile
IO () -> ExceptT (FileError ()) IO ()
forall a. IO a -> ExceptT (FileError ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT (FileError ()) IO ())
-> IO () -> ExceptT (FileError ()) IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
drepDir
(VerificationKey DRepKey, SigningKey DRepKey)
-> VerificationKey DRepKey
forall a b. (a, b) -> a
fst ((VerificationKey DRepKey, SigningKey DRepKey)
-> VerificationKey DRepKey)
-> ExceptT
(FileError ()) IO (VerificationKey DRepKey, SigningKey DRepKey)
-> ExceptT (FileError ()) IO (VerificationKey DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GovernanceDRepKeyGenCmdArgs ConwayEra
-> ExceptT
(FileError ()) IO (VerificationKey DRepKey, SigningKey DRepKey)
forall era.
GovernanceDRepKeyGenCmdArgs era
-> ExceptT
(FileError ()) IO (VerificationKey DRepKey, SigningKey DRepKey)
DRep.runGovernanceDRepKeyGenCmd GovernanceDRepKeyGenCmdArgs ConwayEra
cmd
CredentialGenerationMode
Transient ->
IO [VerificationKey DRepKey]
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
forall a. IO a -> ExceptT (FileError ()) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [VerificationKey DRepKey]
-> ExceptT (FileError ()) IO [VerificationKey DRepKey])
-> IO [VerificationKey DRepKey]
-> ExceptT (FileError ()) IO [VerificationKey DRepKey]
forall a b. (a -> b) -> a -> b
$
(StdGen -> Word -> IO (StdGen, VerificationKey DRepKey))
-> StdGen -> [Word] -> IO [VerificationKey DRepKey]
forall acc b c. (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM
(\StdGen
g' Word
_ -> (VerificationKey DRepKey, StdGen)
-> (StdGen, VerificationKey DRepKey)
forall a b. (a, b) -> (b, a)
swap ((VerificationKey DRepKey, StdGen)
-> (StdGen, VerificationKey DRepKey))
-> ((SigningKey DRepKey, StdGen)
-> (VerificationKey DRepKey, StdGen))
-> (SigningKey DRepKey, StdGen)
-> (StdGen, VerificationKey DRepKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SigningKey DRepKey -> VerificationKey DRepKey)
-> (SigningKey DRepKey, StdGen)
-> (VerificationKey DRepKey, StdGen)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SigningKey DRepKey -> VerificationKey DRepKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey ((SigningKey DRepKey, StdGen) -> (StdGen, VerificationKey DRepKey))
-> IO (SigningKey DRepKey, StdGen)
-> IO (StdGen, VerificationKey DRepKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> AsType DRepKey -> IO (SigningKey DRepKey, StdGen)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole,
SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> m (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g' AsType DRepKey
AsDRepKey)
StdGen
g
[Word
1 .. Word
numOfDRepCredentials]
Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word
0 Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
< Word
numOfDRepCredentials Bool -> Bool -> Bool
&& CredentialGenerationMode
dRepCredentialGenerationMode CredentialGenerationMode -> CredentialGenerationMode -> Bool
forall a. Eq a => a -> a -> Bool
== CredentialGenerationMode
OnDisk) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
drepsDir Text
drepsREADME
StdGen
g2 <- ExceptT GenesisCmdError IO StdGen
forall (m :: * -> *). MonadIO m => m StdGen
Random.getStdGen
[(VerificationKey PaymentKey, VerificationKey StakeKey)]
delegatorKeys <- case CredentialGenerationMode
stakeDelegatorsGenerationMode of
CredentialGenerationMode
OnDisk -> [FilePath]
-> (FilePath
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, VerificationKey StakeKey))
-> ExceptT
GenesisCmdError
IO
[(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
stakeDelegatorsDirs ((FilePath
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, VerificationKey StakeKey))
-> ExceptT
GenesisCmdError
IO
[(VerificationKey PaymentKey, VerificationKey StakeKey)])
-> (FilePath
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, VerificationKey StakeKey))
-> ExceptT
GenesisCmdError
IO
[(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall a b. (a -> b) -> a -> b
$ \FilePath
delegator -> FilePath
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, VerificationKey StakeKey)
createStakeDelegatorCredentials FilePath
delegator
CredentialGenerationMode
Transient -> IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> ExceptT
GenesisCmdError
IO
[(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> ExceptT
GenesisCmdError
IO
[(VerificationKey PaymentKey, VerificationKey StakeKey)])
-> IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> ExceptT
GenesisCmdError
IO
[(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall a b. (a -> b) -> a -> b
$ (StdGen
-> Word
-> IO
(StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey)))
-> StdGen
-> [Word]
-> IO [(VerificationKey PaymentKey, VerificationKey StakeKey)]
forall acc b c. (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM (\StdGen
g' Word
_ -> StdGen
-> IO
(StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
computeInsecureStakeKeyAddr StdGen
g') StdGen
g2 [Word
1 .. Word
numOfStakeDelegators]
let (Word
delegsPerPool, Word
delegsRemaining) =
if Word
numPools Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
== Word
0
then (Word
0, Word
0)
else Word
numOfStakeDelegators Word -> Word -> (Word, Word)
forall a. Integral a => a -> a -> (a, a)
`divMod` Word
numPools
delegsForPool :: Word -> Word
delegsForPool Word
poolIx =
if Word
poolIx Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
<= Word
delegsRemaining
then Word
delegsPerPool Word -> Word -> Word
forall a. Num a => a -> a -> a
+ Word
1
else Word
delegsPerPool
distribution :: [PoolParams StandardCrypto]
distribution = [PoolParams StandardCrypto
pool | (PoolParams StandardCrypto
pool, Word
poolIx) <- [PoolParams StandardCrypto]
-> [Word] -> [(PoolParams StandardCrypto, Word)]
forall a b. [a] -> [b] -> [(a, b)]
zip [PoolParams StandardCrypto]
poolParams [Word
1 ..], Word
_ <- [Word
1 .. Word -> Word
delegsForPool Word
poolIx]]
let delegations :: [Delegation]
delegations = ((VerificationKey PaymentKey, VerificationKey StakeKey)
-> PoolParams StandardCrypto -> Delegation)
-> [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> [PoolParams StandardCrypto]
-> [Delegation]
forall c a b. NFData c => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithDeepSeq (NetworkId
-> (VerificationKey PaymentKey, VerificationKey StakeKey)
-> PoolParams StandardCrypto
-> Delegation
computeDelegation NetworkId
actualNetworkId) [(VerificationKey PaymentKey, VerificationKey StakeKey)]
delegatorKeys [PoolParams StandardCrypto]
distribution
Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs <- Map Int FilePath
-> Map Int FilePath
-> Map Int FilePath
-> ExceptT
GenesisCmdError
IO
(Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap Map Int FilePath
genesisVKeysPaths Map Int FilePath
delegateKeys Map Int FilePath
delegateVrfKeys
[AddressInEra ShelleyEra]
nonDelegAddrs <- [FilePath]
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses [FilePath]
utxoKeyFileNames NetworkId
actualNetworkId
SystemStart
start <- ExceptT GenesisCmdError IO SystemStart
-> (SystemStart -> ExceptT GenesisCmdError IO SystemStart)
-> Maybe SystemStart
-> ExceptT GenesisCmdError IO SystemStart
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart)
-> ExceptT GenesisCmdError IO UTCTime
-> ExceptT GenesisCmdError IO SystemStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT GenesisCmdError IO UTCTime
forall (m :: * -> *). MonadIO m => m UTCTime
getCurrentTimePlus30) SystemStart -> ExceptT GenesisCmdError IO SystemStart
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe SystemStart
systemStart
let network :: Network
network = NetworkId -> Network
toShelleyNetwork NetworkId
actualNetworkId
[AddressInEra ShelleyEra]
stuffedUtxoAddrs <-
IO [AddressInEra ShelleyEra]
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [AddressInEra ShelleyEra]
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra])
-> IO [AddressInEra ShelleyEra]
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
forall a b. (a -> b) -> a -> b
$ Int -> IO (AddressInEra ShelleyEra) -> IO [AddressInEra ShelleyEra]
forall (m :: * -> *) a. MonadUnliftIO m => Int -> m a -> m [a]
Lazy.replicateM (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
numStuffedUtxo) (IO (AddressInEra ShelleyEra) -> IO [AddressInEra ShelleyEra])
-> IO (AddressInEra ShelleyEra) -> IO [AddressInEra ShelleyEra]
forall a b. (a -> b) -> a -> b
$ Network -> IO (AddressInEra ShelleyEra)
genStuffedAddress Network
network
let conwayGenesis' :: ConwayGenesis StandardCrypto
conwayGenesis' =
[VerificationKey DRepKey]
-> [VerificationKey StakeKey]
-> ConwayGenesis StandardCrypto
-> ConwayGenesis StandardCrypto
addDRepsToConwayGenesis [VerificationKey DRepKey]
dRepKeys (((VerificationKey PaymentKey, VerificationKey StakeKey)
-> VerificationKey StakeKey)
-> [(VerificationKey PaymentKey, VerificationKey StakeKey)]
-> [VerificationKey StakeKey]
forall a b. (a -> b) -> [a] -> [b]
map (VerificationKey PaymentKey, VerificationKey StakeKey)
-> VerificationKey StakeKey
forall a b. (a, b) -> b
snd [(VerificationKey PaymentKey, VerificationKey StakeKey)]
delegatorKeys) ConwayGenesis StandardCrypto
conwayGenesis
ConwayGenesis StandardCrypto
-> (ConwayGenesis StandardCrypto -> ConwayGenesis StandardCrypto)
-> ConwayGenesis StandardCrypto
forall a b. a -> (a -> b) -> b
& [VerificationKey CommitteeColdKey]
-> ConwayGenesis StandardCrypto -> ConwayGenesis StandardCrypto
addCommitteeToConwayGenesis [VerificationKey CommitteeColdKey]
ccColdKeys
let stake :: [(KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)]
stake = (PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto)
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
-> (KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c. PoolParams c -> KeyHash 'StakePool c
L.ppId ((KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
-> (KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto))
-> (Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto))
-> Delegation
-> (KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry (Delegation
-> (KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto))
-> [Delegation]
-> [(KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
stakePools :: [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
stakePools = [(PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c. PoolParams c -> KeyHash 'StakePool c
L.ppId PoolParams StandardCrypto
poolParams', PoolParams StandardCrypto
poolParams') | PoolParams StandardCrypto
poolParams' <- (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
-> PoolParams StandardCrypto
forall a b. (a, b) -> b
snd ((KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
-> PoolParams StandardCrypto)
-> (Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto))
-> Delegation
-> PoolParams StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry (Delegation -> PoolParams StandardCrypto)
-> [Delegation] -> [PoolParams StandardCrypto]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations]
delegAddrs :: [AddressInEra ShelleyEra]
delegAddrs = Delegation -> AddressInEra ShelleyEra
dInitialUtxoAddr (Delegation -> AddressInEra ShelleyEra)
-> [Delegation] -> [AddressInEra ShelleyEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
!ShelleyGenesis StandardCrypto
shelleyGenesis' <-
SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto)
forall (m :: * -> *).
MonadError GenesisCmdError m =>
SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> m (ShelleyGenesis StandardCrypto)
updateOutputTemplate
SystemStart
start
Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs
Maybe Coin
totalSupply
[AddressInEra ShelleyEra]
nonDelegAddrs
[(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
stakePools
[(KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)]
stake
Maybe Coin
delegatedSupply
([Delegation] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Delegation]
delegations)
[AddressInEra ShelleyEra]
delegAddrs
[AddressInEra ShelleyEra]
stuffedUtxoAddrs
ShelleyGenesis StandardCrypto
shelleyGenesis
let byronGenesisFp :: FilePath
byronGenesisFp = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"byron.genesis.spec.json"
ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> ExceptT GenesisCmdError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis FilePath
byronGenesisFp (WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
forall a b. (a -> b) -> a -> b
$ Value -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty Value
Byron.defaultProtocolParamsJsonValue
let byronGenesisParameters :: GenesisParameters
byronGenesisParameters = Word
-> Word32
-> FilePath
-> ShelleyGenesis StandardCrypto
-> GenesisParameters
forall c.
Word -> Word32 -> FilePath -> ShelleyGenesis c -> GenesisParameters
Byron.mkGenesisParameters Word
numPools Word32
actualNetworkWord32 FilePath
byronGenesisFp ShelleyGenesis StandardCrypto
shelleyGenesis'
byronOutputDir :: FilePath
byronOutputDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"byron-gen-command"
(GenesisData
byronGenesis, GeneratedSecrets
byronSecrets) <-
(ByronGenesisError -> GenesisCmdError)
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
-> ExceptT GenesisCmdError IO (GenesisData, GeneratedSecrets)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronGenesisError -> GenesisCmdError
GenesisCmdByronError (ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
-> ExceptT GenesisCmdError IO (GenesisData, GeneratedSecrets))
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
-> ExceptT GenesisCmdError IO (GenesisData, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$ GenesisParameters
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
Byron.mkGenesis GenesisParameters
byronGenesisParameters
(ByronGenesisError -> GenesisCmdError)
-> ExceptT ByronGenesisError IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT ByronGenesisError -> GenesisCmdError
GenesisCmdByronError (ExceptT ByronGenesisError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT ByronGenesisError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
NewDirectory
-> GenesisData
-> GeneratedSecrets
-> ExceptT ByronGenesisError IO ()
Byron.dumpGenesis (FilePath -> NewDirectory
NewDirectory FilePath
byronOutputDir) GenesisData
byronGenesis GeneratedSecrets
byronSecrets
[Word]
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Word
1 .. Word
numPools] ((Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ())
-> (Word -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \Word
index -> do
let poolDir :: FilePath
poolDir = Word -> FilePath
mkPoolDir Word
index
inputIndex :: FilePath
inputIndex = FilePath -> Word -> FilePath
forall r. PrintfType r => FilePath -> r
printf FilePath
"%03d" (Word
index Word -> Word -> Word
forall a. Num a => a -> a -> a
- Word
1)
mkInputFile :: FilePath -> FilePath -> FilePath
mkInputFile FilePath
filePrefix FilePath
suffix = FilePath
byronOutputDir FilePath -> FilePath -> FilePath
</> FilePath
filePrefix FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
inputIndex FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
suffix
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
FilePath -> FilePath -> IO ()
renameFile (FilePath -> FilePath -> FilePath
mkInputFile FilePath
"delegate-keys." FilePath
".key") (FilePath
poolDir FilePath -> FilePath -> FilePath
</> FilePath
"byron-delegate.key")
FilePath -> FilePath -> IO ()
renameFile (FilePath -> FilePath -> FilePath
mkInputFile FilePath
"delegation-cert." FilePath
".json") (FilePath
poolDir FilePath -> FilePath -> FilePath
</> FilePath
"byron-delegation.cert")
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile (FilePath
byronOutputDir FilePath -> FilePath -> FilePath
</> FilePath
"genesis.json") (FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"byron-genesis.json")
[(FilePath, WriteFileGenesis)]
-> ((FilePath, WriteFileGenesis)
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_
[ (FilePath
"conway-genesis.json", ConwayGenesis StandardCrypto -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ConwayGenesis StandardCrypto
conwayGenesis')
, (FilePath
"shelley-genesis.json", ShelleyGenesis StandardCrypto -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty ShelleyGenesis StandardCrypto
shelleyGenesis')
, (FilePath
"alonzo-genesis.json", AlonzoGenesis -> WriteFileGenesis
forall genesis. ToJSON genesis => genesis -> WriteFileGenesis
WritePretty AlonzoGenesis
alonzoGenesis)
]
(((FilePath, WriteFileGenesis)
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO ())
-> ((FilePath, WriteFileGenesis)
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString))
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ \(FilePath
filename, WriteFileGenesis
genesis) -> FilePath
-> WriteFileGenesis
-> ExceptT GenesisCmdError IO (Hash Blake2b_256 ByteString)
writeFileGenesis (FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
filename) WriteFileGenesis
genesis
where
genesisDir :: FilePath
genesisDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"genesis-keys"
delegateDir :: FilePath
delegateDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"delegate-keys"
committeesDir :: FilePath
committeesDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"cc-keys"
drepsDir :: FilePath
drepsDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"drep-keys"
utxoKeysDir :: FilePath
utxoKeysDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"utxo-keys"
poolsDir :: FilePath
poolsDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"pools-keys"
stakeDelegatorsDir :: FilePath
stakeDelegatorsDir = FilePath
outputDir FilePath -> FilePath -> FilePath
</> FilePath
"stake-delegators"
mkPoolDir :: Word -> FilePath
mkPoolDir Word
idx = FilePath
poolsDir FilePath -> FilePath -> FilePath
</> (FilePath
"pool" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
idx)
mkDelegationMapEntry
:: Delegation -> (L.KeyHash L.Staking L.StandardCrypto, L.PoolParams L.StandardCrypto)
mkDelegationMapEntry :: Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry Delegation
d = (Delegation -> KeyHash 'Staking StandardCrypto
dDelegStaking Delegation
d, Delegation -> PoolParams StandardCrypto
dPoolParams Delegation
d)
addCommitteeToConwayGenesis
:: [VerificationKey CommitteeColdKey]
-> L.ConwayGenesis L.StandardCrypto
-> L.ConwayGenesis L.StandardCrypto
addCommitteeToConwayGenesis :: [VerificationKey CommitteeColdKey]
-> ConwayGenesis StandardCrypto -> ConwayGenesis StandardCrypto
addCommitteeToConwayGenesis [VerificationKey CommitteeColdKey]
ccColdKeys ConwayGenesis StandardCrypto
conwayGenesis =
ConwayGenesis StandardCrypto
conwayGenesis
{ L.cgCommittee =
L.Committee
{ L.committeeMembers =
Map.fromList $ map ((,EpochNo maxBound) . toCommitteeColdCredential) ccColdKeys
, L.committeeThreshold = zeroUnitInterval
}
}
where
zeroUnitInterval :: UnitInterval
zeroUnitInterval = forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundedRational @L.UnitInterval Rational
0
toCommitteeColdCredential
:: VerificationKey CommitteeColdKey -> L.Credential L.ColdCommitteeRole L.StandardCrypto
toCommitteeColdCredential :: VerificationKey CommitteeColdKey
-> Credential 'ColdCommitteeRole StandardCrypto
toCommitteeColdCredential VerificationKey CommitteeColdKey
vk = Hash CommitteeColdKey
-> Credential 'ColdCommitteeRole StandardCrypto
toCredential (VerificationKey CommitteeColdKey -> Hash CommitteeColdKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey CommitteeColdKey
vk)
where
toCredential :: Hash CommitteeColdKey -> L.Credential L.ColdCommitteeRole L.StandardCrypto
toCredential :: Hash CommitteeColdKey
-> Credential 'ColdCommitteeRole StandardCrypto
toCredential (CommitteeColdKeyHash KeyHash 'ColdCommitteeRole StandardCrypto
v) = KeyHash 'ColdCommitteeRole StandardCrypto
-> Credential 'ColdCommitteeRole StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj KeyHash 'ColdCommitteeRole StandardCrypto
v
addDRepsToConwayGenesis
:: [VerificationKey DRepKey]
-> [VerificationKey StakeKey]
-> L.ConwayGenesis L.StandardCrypto
-> L.ConwayGenesis L.StandardCrypto
addDRepsToConwayGenesis :: [VerificationKey DRepKey]
-> [VerificationKey StakeKey]
-> ConwayGenesis StandardCrypto
-> ConwayGenesis StandardCrypto
addDRepsToConwayGenesis [VerificationKey DRepKey]
dRepKeys [VerificationKey StakeKey]
stakingKeys ConwayGenesis StandardCrypto
conwayGenesis =
ConwayGenesis StandardCrypto
conwayGenesis
{ L.cgDelegs = delegs (zip stakingKeys (case dRepKeys of [] -> []; [VerificationKey DRepKey]
_ -> [VerificationKey DRepKey] -> [VerificationKey DRepKey]
forall a. HasCallStack => [a] -> [a]
cycle [VerificationKey DRepKey]
dRepKeys))
, L.cgInitialDReps = initialDReps (L.ucppDRepDeposit $ L.cgUpgradePParams conwayGenesis) dRepKeys
}
where
delegs
:: [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> ListMap (L.Credential L.Staking L.StandardCrypto) (L.Delegatee L.StandardCrypto)
delegs :: [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> ListMap
(Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
delegs =
[(Credential 'Staking StandardCrypto, Delegatee StandardCrypto)]
-> ListMap
(Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
[Item
(ListMap
(Credential 'Staking StandardCrypto) (Delegatee StandardCrypto))]
-> ListMap
(Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
([(Credential 'Staking StandardCrypto, Delegatee StandardCrypto)]
-> ListMap
(Credential 'Staking StandardCrypto) (Delegatee StandardCrypto))
-> ([(VerificationKey StakeKey, VerificationKey DRepKey)]
-> [(Credential 'Staking StandardCrypto,
Delegatee StandardCrypto)])
-> [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> ListMap
(Credential 'Staking StandardCrypto) (Delegatee StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((VerificationKey StakeKey, VerificationKey DRepKey)
-> (Credential 'Staking StandardCrypto, Delegatee StandardCrypto))
-> [(VerificationKey StakeKey, VerificationKey DRepKey)]
-> [(Credential 'Staking StandardCrypto, Delegatee StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map
( (VerificationKey StakeKey -> Credential 'Staking StandardCrypto)
-> (VerificationKey DRepKey -> Delegatee StandardCrypto)
-> (VerificationKey StakeKey, VerificationKey DRepKey)
-> (Credential 'Staking StandardCrypto, Delegatee StandardCrypto)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap
VerificationKey StakeKey -> Credential 'Staking StandardCrypto
verificationKeytoStakeCredential
(DRep StandardCrypto -> Delegatee StandardCrypto
forall c. DRep c -> Delegatee c
L.DelegVote (DRep StandardCrypto -> Delegatee StandardCrypto)
-> (VerificationKey DRepKey -> DRep StandardCrypto)
-> VerificationKey DRepKey
-> Delegatee StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Credential 'DRepRole StandardCrypto -> DRep StandardCrypto
forall c. Credential 'DRepRole c -> DRep c
L.DRepCredential (Credential 'DRepRole StandardCrypto -> DRep StandardCrypto)
-> (VerificationKey DRepKey -> Credential 'DRepRole StandardCrypto)
-> VerificationKey DRepKey
-> DRep StandardCrypto
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey DRepKey -> Credential 'DRepRole StandardCrypto
verificationKeyToDRepCredential)
)
initialDReps
:: Lovelace
-> [VerificationKey DRepKey]
-> ListMap (L.Credential L.DRepRole L.StandardCrypto) (L.DRepState L.StandardCrypto)
initialDReps :: Coin
-> [VerificationKey DRepKey]
-> ListMap
(Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
initialDReps Coin
minDeposit =
[(Credential 'DRepRole StandardCrypto, DRepState StandardCrypto)]
-> ListMap
(Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
[Item
(ListMap
(Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))]
-> ListMap
(Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
([(Credential 'DRepRole StandardCrypto, DRepState StandardCrypto)]
-> ListMap
(Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto))
-> ([VerificationKey DRepKey]
-> [(Credential 'DRepRole StandardCrypto,
DRepState StandardCrypto)])
-> [VerificationKey DRepKey]
-> ListMap
(Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationKey DRepKey
-> (Credential 'DRepRole StandardCrypto, DRepState StandardCrypto))
-> [VerificationKey DRepKey]
-> [(Credential 'DRepRole StandardCrypto,
DRepState StandardCrypto)]
forall a b. (a -> b) -> [a] -> [b]
map
( \VerificationKey DRepKey
c ->
( VerificationKey DRepKey -> Credential 'DRepRole StandardCrypto
verificationKeyToDRepCredential VerificationKey DRepKey
c
, L.DRepState
{ drepExpiry :: EpochNo
L.drepExpiry = Word64 -> EpochNo
EpochNo Word64
1_000
, drepAnchor :: StrictMaybe (Anchor StandardCrypto)
L.drepAnchor = StrictMaybe (Anchor StandardCrypto)
forall a. StrictMaybe a
SNothing
, drepDeposit :: Coin
L.drepDeposit = Coin -> Coin -> Coin
forall a. Ord a => a -> a -> a
max (Integer -> Coin
L.Coin Integer
1_000_000) Coin
minDeposit
, drepDelegs :: Set (Credential 'Staking StandardCrypto)
L.drepDelegs = Set (Credential 'Staking StandardCrypto)
forall a. Set a
Set.empty
}
)
)
verificationKeyToDRepCredential
:: VerificationKey DRepKey -> L.Credential L.DRepRole L.StandardCrypto
verificationKeyToDRepCredential :: VerificationKey DRepKey -> Credential 'DRepRole StandardCrypto
verificationKeyToDRepCredential VerificationKey DRepKey
vk = Hash DRepKey -> Credential 'DRepRole StandardCrypto
dRepKeyToCredential (VerificationKey DRepKey -> Hash DRepKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey DRepKey
vk)
where
dRepKeyToCredential :: Hash DRepKey -> L.Credential L.DRepRole L.StandardCrypto
dRepKeyToCredential :: Hash DRepKey -> Credential 'DRepRole StandardCrypto
dRepKeyToCredential (DRepKeyHash KeyHash 'DRepRole StandardCrypto
v) = KeyHash 'DRepRole StandardCrypto
-> Credential 'DRepRole StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj KeyHash 'DRepRole StandardCrypto
v
verificationKeytoStakeCredential
:: VerificationKey StakeKey -> L.Credential L.Staking L.StandardCrypto
verificationKeytoStakeCredential :: VerificationKey StakeKey -> Credential 'Staking StandardCrypto
verificationKeytoStakeCredential VerificationKey StakeKey
vk = Hash StakeKey -> Credential 'Staking StandardCrypto
stakeKeyToCredential (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
vk)
where
stakeKeyToCredential :: Hash StakeKey -> L.Credential L.Staking L.StandardCrypto
stakeKeyToCredential :: Hash StakeKey -> Credential 'Staking StandardCrypto
stakeKeyToCredential (StakeKeyHash KeyHash 'Staking StandardCrypto
v) = KeyHash 'Staking StandardCrypto
-> Credential 'Staking StandardCrypto
forall (kr :: KeyRole) c. KeyHash kr c -> Credential kr c
L.KeyHashObj KeyHash 'Staking StandardCrypto
v
zipWithDeepSeq :: NFData c => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithDeepSeq :: forall c a b. NFData c => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithDeepSeq a -> b -> c
_ [a]
_ [] = []
zipWithDeepSeq a -> b -> c
_ [] [b]
_ = []
zipWithDeepSeq a -> b -> c
f (a
h1 : [a]
t1) (b
h2 : [b]
t2) =
let h :: c
h = a -> b -> c
f a
h1 b
h2
in c
h c -> [c] -> [c]
forall a b. NFData a => a -> b -> b
`deepseq` (c
h c -> [c] -> [c]
forall a. a -> [a] -> [a]
: (a -> b -> c) -> [a] -> [b] -> [c]
forall c a b. NFData c => (a -> b -> c) -> [a] -> [b] -> [c]
zipWithDeepSeq a -> b -> c
f [a]
t1 [b]
t2)
mapAccumM :: (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM :: forall acc b c. (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM acc -> b -> IO (acc, c)
_ acc
_ [] = [c] -> IO [c]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
mapAccumM acc -> b -> IO (acc, c)
f acc
a (b
h : [b]
t) = do
(acc
a', c
h') <- acc -> b -> IO (acc, c)
f acc
a b
h
[c]
rest <- (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
forall acc b c. (acc -> b -> IO (acc, c)) -> acc -> [b] -> IO [c]
mapAccumM acc -> b -> IO (acc, c)
f acc
a' [b]
t
[c] -> IO [c]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([c] -> IO [c]) -> [c] -> IO [c]
forall a b. (a -> b) -> a -> b
$ c
h' c -> [c] -> [c]
forall a. a -> [a] -> [a]
: [c]
rest
desiredKeyOutputFormat :: KeyOutputFormat
desiredKeyOutputFormat :: KeyOutputFormat
desiredKeyOutputFormat = KeyOutputFormat
KeyOutputFormatTextEnvelope
writeREADME
:: ()
=> FilePath
-> Text.Text
-> ExceptT GenesisCmdError IO ()
writeREADME :: FilePath -> Text -> ExceptT GenesisCmdError IO ()
writeREADME FilePath
dir Text
content = do
(FileError () -> GenesisCmdError)
-> ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> GenesisCmdError
GenesisCmdFileError (ExceptT (FileError ()) IO () -> ExceptT GenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT GenesisCmdError IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ())
-> IO (Either (FileError ()) ()) -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ File Text 'Out -> Text -> IO (Either (FileError ()) ())
forall (m :: * -> *) content e.
MonadIO m =>
File content 'Out -> Text -> m (Either (FileError e) ())
writeTextFile File Text 'Out
file Text
content
where
File Text 'Out
file :: File Text.Text Out = FilePath -> File Text 'Out
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File Text 'Out) -> FilePath -> File Text 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"README.md"
genesisREADME :: Text.Text
genesisREADME :: Text
genesisREADME =
Text -> [Text] -> Text
Text.intercalate
Text
"\n"
[ Text
"Keys generated by the --genesis-keys flag. In Byron these keys were used to mint blocks and initiate hard forks."
, Text
"Starting with Shelley and decentralization, blocks started being produced by other keys than genesis keys."
, Text
"Still, these keys were required to trigger hard forks."
, Text
"With the introduction of Conway, these keys should become useless"
]
committeeREADME :: Text.Text
committeeREADME :: Text
committeeREADME =
Text -> [Text] -> Text
Text.intercalate
Text
"\n"
[ Text
"Keys generated by the --committee-keys flag. These keys are used to run the constitutional committee."
, Text
"A pair of both cold keys and hot keys are generated for each committee member."
]
delegatesREADME :: Text.Text
delegatesREADME :: Text
delegatesREADME =
Text -> [Text] -> Text
Text.intercalate
Text
"\n"
[ Text
"Keys generated by the --genesis-keys flag. These keys are used to mint blocks when not being completely decentralized"
, Text
"(e.g. when stake pools are not the sole block producers). These keys are intended to run nodes."
]
drepsREADME :: Text.Text
drepsREADME :: Text
drepsREADME =
Text -> [Text] -> Text
Text.intercalate
Text
"\n"
[ Text
"Keys generated by the --drep-keys flag. These keys are for Delegated Representatives (DReps) that make decisions"
, Text
"related to Cardano governance. Delegators that do not want to vote for each decision will pick DReps in line with"
, Text
"their views delegate their voting power to them. The DRep's in this generated testnet data will automatically get"
, Text
"registered and all the stake delegators (if any) will automatically delegate their vote to one of the DReps here."
]
utxoKeysREADME :: Text.Text
utxoKeysREADME :: Text
utxoKeysREADME =
Text -> [Text] -> Text
Text.intercalate
Text
"\n"
[Text
"Keys generated by the --utxo-keys flag. These keys receive a portion of the supply."]
poolsREADME :: Text.Text
poolsREADME :: Text
poolsREADME =
Text -> [Text] -> Text
Text.intercalate
Text
"\n"
[Text
"Keys generated by the --pools flag. These keys are intended to run nodes."]
mkPaths :: Word -> String -> String -> String -> Map Int FilePath
mkPaths :: Word -> FilePath -> FilePath -> FilePath -> Map Int FilePath
mkPaths Word
numKeys FilePath
dir FilePath
segment FilePath
filename =
[Item (Map Int FilePath)] -> Map Int FilePath
forall l. IsList l => [Item l] -> l
fromList
[ (Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word
idx, FilePath
dir FilePath -> FilePath -> FilePath
</> (FilePath
segment FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Word -> FilePath
forall a. Show a => a -> FilePath
show Word
idx) FilePath -> FilePath -> FilePath
</> FilePath
filename)
| Word
idx <- [Word
1 .. Word
numKeys]
]
createDelegateKeys :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createDelegateKeys :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createDelegateKeys KeyOutputFormat
fmt FilePath
dir = do
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
GenesisKeyGenDelegateCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateCmd
Cmd.GenesisKeyGenDelegateCmdArgs
{ verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"key.vkey"
, signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = File (SigningKey ()) 'InOut -> SigningKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (SigningKey ()) 'InOut
coldSK
, opCertCounterPath :: OpCertCounterFile 'Out
Cmd.opCertCounterPath = File OpCertCounter 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File OpCertCounter 'InOut
opCertCtr
}
VerificationKeyFile 'Out
-> SigningKeyFile 'Out -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenDelegateVRF
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.vkey")
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.skey")
(NodeCmdError -> GenesisCmdError)
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT NodeCmdError -> GenesisCmdError
GenesisCmdNodeCmdError (ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
KeyOutputFormat
fmt
(File (VerificationKey ()) 'InOut -> VerificationKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (VerificationKey ()) 'InOut
kesVK)
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"kes.skey")
NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> File OpCertCounter 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
(VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (VerificationKey ()) 'InOut
kesVK))
(File (SigningKey ()) 'InOut -> SigningKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (SigningKey ()) 'InOut
coldSK)
File OpCertCounter 'InOut
opCertCtr
(Word -> KESPeriod
KESPeriod Word
0)
(FilePath -> File () 'Out
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File () 'Out) -> FilePath -> File () 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"opcert.cert")
where
kesVK :: File (VerificationKey ()) 'InOut
kesVK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> File (VerificationKey ()) 'InOut)
-> FilePath -> File (VerificationKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"kes.vkey"
coldSK :: File (SigningKey ()) 'InOut
coldSK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> File (SigningKey ()) 'InOut)
-> FilePath -> File (SigningKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"key.skey"
opCertCtr :: File OpCertCounter 'InOut
opCertCtr = FilePath -> File OpCertCounter 'InOut
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File OpCertCounter 'InOut)
-> FilePath -> File OpCertCounter 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"opcert.counter"
createGenesisKeys :: FilePath -> ExceptT GenesisCmdError IO ()
createGenesisKeys :: FilePath -> ExceptT GenesisCmdError IO ()
createGenesisKeys FilePath
dir = do
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
GenesisKeyGenGenesisCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenGenesisCmd
GenesisKeyGenGenesisCmdArgs
{ verificationKeyPath :: VerificationKeyFile 'Out
verificationKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"key.vkey"
, signingKeyPath :: SigningKeyFile 'Out
signingKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"key.skey"
}
createStakeDelegatorCredentials
:: FilePath
-> ExceptT
GenesisCmdError
IO
( VerificationKey PaymentKey
, VerificationKey StakeKey
)
createStakeDelegatorCredentials :: FilePath
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, VerificationKey StakeKey)
createStakeDelegatorCredentials FilePath
dir = do
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
(VerificationKey PaymentKey
pvk, SigningKey PaymentKey
_psk) <-
(AddressCmdError -> GenesisCmdError)
-> ExceptT
AddressCmdError
IO
(VerificationKey PaymentKey, SigningKey PaymentKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, SigningKey PaymentKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT AddressCmdError -> GenesisCmdError
GenesisCmdAddressCmdError (ExceptT
AddressCmdError
IO
(VerificationKey PaymentKey, SigningKey PaymentKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, SigningKey PaymentKey))
-> ExceptT
AddressCmdError
IO
(VerificationKey PaymentKey, SigningKey PaymentKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, SigningKey PaymentKey)
forall a b. (a -> b) -> a -> b
$
KeyOutputFormat
-> AsType PaymentKey
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
AddressCmdError
IO
(VerificationKey PaymentKey, SigningKey PaymentKey)
forall keyrole.
(Key keyrole, HasTypeProxy keyrole,
SerialiseAsBech32 (SigningKey keyrole),
SerialiseAsBech32 (VerificationKey keyrole)) =>
KeyOutputFormat
-> AsType keyrole
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
AddressCmdError IO (VerificationKey keyrole, SigningKey keyrole)
generateAndWriteKeyFiles KeyOutputFormat
desiredKeyOutputFormat AsType PaymentKey
AsPaymentKey VerificationKeyFile 'Out
paymentVK SigningKeyFile 'Out
paymentSK
(VerificationKey StakeKey
svk, SigningKey StakeKey
_ssk) <-
(StakeAddressCmdError -> GenesisCmdError)
-> ExceptT
StakeAddressCmdError
IO
(VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT
GenesisCmdError IO (VerificationKey StakeKey, SigningKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeAddressCmdError -> GenesisCmdError
GenesisCmdStakeAddressCmdError (ExceptT
StakeAddressCmdError
IO
(VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT
GenesisCmdError IO (VerificationKey StakeKey, SigningKey StakeKey))
-> ExceptT
StakeAddressCmdError
IO
(VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT
GenesisCmdError IO (VerificationKey StakeKey, SigningKey StakeKey)
forall a b. (a -> b) -> a -> b
$
KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
StakeAddressCmdError
IO
(VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd KeyOutputFormat
desiredKeyOutputFormat VerificationKeyFile 'Out
stakingVK SigningKeyFile 'Out
stakingSK
(VerificationKey PaymentKey, VerificationKey StakeKey)
-> ExceptT
GenesisCmdError
IO
(VerificationKey PaymentKey, VerificationKey StakeKey)
forall a. a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (VerificationKey PaymentKey
pvk, VerificationKey StakeKey
svk)
where
paymentVK :: VerificationKeyFile 'Out
paymentVK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"payment.vkey"
paymentSK :: SigningKeyFile 'Out
paymentSK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"payment.skey"
stakingVK :: VerificationKeyFile 'Out
stakingVK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking.vkey"
stakingSK :: SigningKeyFile 'Out
stakingSK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking.skey"
createUtxoKeys :: FilePath -> ExceptT GenesisCmdError IO ()
createUtxoKeys :: FilePath -> ExceptT GenesisCmdError IO ()
createUtxoKeys FilePath
dir = do
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
GenesisKeyGenUTxOCmdArgs -> ExceptT GenesisCmdError IO ()
runGenesisKeyGenUTxOCmd
Cmd.GenesisKeyGenUTxOCmdArgs
{ verificationKeyPath :: VerificationKeyFile 'Out
Cmd.verificationKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"utxo.vkey"
, signingKeyPath :: SigningKeyFile 'Out
Cmd.signingKeyPath = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"utxo.skey"
}
createPoolCredentials :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createPoolCredentials :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO ()
createPoolCredentials KeyOutputFormat
fmt FilePath
dir = do
IO () -> ExceptT GenesisCmdError IO ()
forall a. IO a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT GenesisCmdError IO ())
-> IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
True FilePath
dir
(NodeCmdError -> GenesisCmdError)
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT NodeCmdError -> GenesisCmdError
GenesisCmdNodeCmdError (ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT NodeCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ do
NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenKesCmd (NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenKESCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenKESCmdArgs
Cmd.NodeKeyGenKESCmdArgs
KeyOutputFormat
fmt
(File (VerificationKey ()) 'InOut -> VerificationKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (VerificationKey ()) 'InOut
kesVK)
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"kes.skey")
NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenVrfCmd (NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenVRFCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> NodeKeyGenVRFCmdArgs
Cmd.NodeKeyGenVRFCmdArgs
KeyOutputFormat
fmt
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.vkey")
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.skey")
NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ()
runNodeKeyGenColdCmd (NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeKeyGenColdCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> OpCertCounterFile 'Out
-> NodeKeyGenColdCmdArgs
Cmd.NodeKeyGenColdCmdArgs
KeyOutputFormat
fmt
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cold.vkey")
(File (SigningKey ()) 'InOut -> SigningKeyFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File (SigningKey ()) 'InOut
coldSK)
(File OpCertCounter 'InOut -> OpCertCounterFile 'Out
forall content. File content 'InOut -> File content 'Out
onlyOut File OpCertCounter 'InOut
opCertCtr)
NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
runNodeIssueOpCertCmd (NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ())
-> NodeIssueOpCertCmdArgs -> ExceptT NodeCmdError IO ()
forall a b. (a -> b) -> a -> b
$
VerificationKeyOrFile KesKey
-> SigningKeyFile 'In
-> File OpCertCounter 'InOut
-> KESPeriod
-> File () 'Out
-> NodeIssueOpCertCmdArgs
Cmd.NodeIssueOpCertCmdArgs
(VerificationKeyFile 'In -> VerificationKeyOrFile KesKey
forall keyrole.
VerificationKeyFile 'In -> VerificationKeyOrFile keyrole
VerificationKeyFilePath (File (VerificationKey ()) 'InOut -> VerificationKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (VerificationKey ()) 'InOut
kesVK))
(File (SigningKey ()) 'InOut -> SigningKeyFile 'In
forall content. File content 'InOut -> File content 'In
onlyIn File (SigningKey ()) 'InOut
coldSK)
File OpCertCounter 'InOut
opCertCtr
(Word -> KESPeriod
KESPeriod Word
0)
(FilePath -> File () 'Out
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File () 'Out) -> FilePath -> File () 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"opcert.cert")
(StakeAddressCmdError -> GenesisCmdError)
-> ExceptT StakeAddressCmdError IO ()
-> ExceptT GenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT StakeAddressCmdError -> GenesisCmdError
GenesisCmdStakeAddressCmdError (ExceptT StakeAddressCmdError IO ()
-> ExceptT GenesisCmdError IO ())
-> ExceptT StakeAddressCmdError IO ()
-> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
ExceptT
StakeAddressCmdError
IO
(VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ExceptT
StakeAddressCmdError
IO
(VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ())
-> ExceptT
StakeAddressCmdError
IO
(VerificationKey StakeKey, SigningKey StakeKey)
-> ExceptT StakeAddressCmdError IO ()
forall a b. (a -> b) -> a -> b
$
KeyOutputFormat
-> VerificationKeyFile 'Out
-> SigningKeyFile 'Out
-> ExceptT
StakeAddressCmdError
IO
(VerificationKey StakeKey, SigningKey StakeKey)
runStakeAddressKeyGenCmd
KeyOutputFormat
fmt
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> VerificationKeyFile 'Out)
-> FilePath -> VerificationKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking-reward.vkey")
(forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> SigningKeyFile 'Out)
-> FilePath -> SigningKeyFile 'Out
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking-reward.skey")
where
kesVK :: File (VerificationKey ()) 'InOut
kesVK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(VerificationKey ()) (FilePath -> File (VerificationKey ()) 'InOut)
-> FilePath -> File (VerificationKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"kes.vkey"
coldSK :: File (SigningKey ()) 'InOut
coldSK = forall content (direction :: FileDirection).
FilePath -> File content direction
File @(SigningKey ()) (FilePath -> File (SigningKey ()) 'InOut)
-> FilePath -> File (SigningKey ()) 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cold.skey"
opCertCtr :: File OpCertCounter 'InOut
opCertCtr = FilePath -> File OpCertCounter 'InOut
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File OpCertCounter 'InOut)
-> FilePath -> File OpCertCounter 'InOut
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"opcert.counter"
data Delegation = Delegation
{ Delegation -> AddressInEra ShelleyEra
dInitialUtxoAddr :: !(AddressInEra ShelleyEra)
, Delegation -> KeyHash 'Staking StandardCrypto
dDelegStaking :: !(L.KeyHash L.Staking L.StandardCrypto)
, Delegation -> PoolParams StandardCrypto
dPoolParams :: !(L.PoolParams L.StandardCrypto)
}
deriving ((forall x. Delegation -> Rep Delegation x)
-> (forall x. Rep Delegation x -> Delegation) -> Generic Delegation
forall x. Rep Delegation x -> Delegation
forall x. Delegation -> Rep Delegation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Delegation -> Rep Delegation x
from :: forall x. Delegation -> Rep Delegation x
$cto :: forall x. Rep Delegation x -> Delegation
to :: forall x. Rep Delegation x -> Delegation
Generic, Delegation -> ()
(Delegation -> ()) -> NFData Delegation
forall a. (a -> ()) -> NFData a
$crnf :: Delegation -> ()
rnf :: Delegation -> ()
NFData)
buildPoolParams
:: NetworkId
-> FilePath
-> Word
-> Map Word [L.StakePoolRelay]
-> ExceptT GenesisCmdError IO (L.PoolParams L.StandardCrypto)
buildPoolParams :: NetworkId
-> FilePath
-> Word
-> Map Word [StakePoolRelay]
-> ExceptT GenesisCmdError IO (PoolParams StandardCrypto)
buildPoolParams NetworkId
nw FilePath
dir Word
index Map Word [StakePoolRelay]
specifiedRelays = do
StakePoolVerificationKey VKey 'StakePool StandardCrypto
poolColdVK <-
(FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
-> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (StakePoolCmdError -> GenesisCmdError
GenesisCmdStakePoolCmdError (StakePoolCmdError -> GenesisCmdError)
-> (FileError TextEnvelopeError -> StakePoolCmdError)
-> FileError TextEnvelopeError
-> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> StakePoolCmdError
StakePoolCmdReadFileError)
(ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
-> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey))
-> (IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakePoolKey))
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
(IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey))
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakePoolKey)
-> File Any 'In
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakePoolKey -> AsType (VerificationKey StakePoolKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolKey
AsStakePoolKey) File Any 'In
poolColdVKF
VrfVerificationKey VerKeyVRF StandardCrypto
poolVrfVK <-
(FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey VrfKey)
-> ExceptT GenesisCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (NodeCmdError -> GenesisCmdError
GenesisCmdNodeCmdError (NodeCmdError -> GenesisCmdError)
-> (FileError TextEnvelopeError -> NodeCmdError)
-> FileError TextEnvelopeError
-> GenesisCmdError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileError TextEnvelopeError -> NodeCmdError
NodeCmdReadFileError)
(ExceptT (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
-> ExceptT GenesisCmdError IO (VerificationKey VrfKey))
-> (IO
(Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey VrfKey))
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT GenesisCmdError IO (VerificationKey VrfKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey VrfKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
(IO (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT GenesisCmdError IO (VerificationKey VrfKey))
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT GenesisCmdError IO (VerificationKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey VrfKey)
-> File Any 'In
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType VrfKey -> AsType (VerificationKey VrfKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey) File Any 'In
poolVrfVKF
VerificationKey StakeKey
rewardsSVK <-
(FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakeKey)
-> ExceptT GenesisCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError
(ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakeKey)
-> ExceptT GenesisCmdError IO (VerificationKey StakeKey))
-> (IO
(Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakeKey))
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakeKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO
(Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey StakeKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
(IO
(Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakeKey))
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT GenesisCmdError IO (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakeKey)
-> File Any 'In
-> IO
(Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakeKey -> AsType (VerificationKey StakeKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakeKey
AsStakeKey) File Any 'In
poolRewardVKF
PoolParams StandardCrypto
-> ExceptT GenesisCmdError IO (PoolParams StandardCrypto)
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
L.PoolParams
{ ppId :: KeyHash 'StakePool StandardCrypto
L.ppId = VKey 'StakePool StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
L.hashKey VKey 'StakePool StandardCrypto
poolColdVK
, ppVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
L.ppVrf = VerKeyVRF PraosVRF -> Hash Blake2b_256 (VerKeyVRF PraosVRF)
forall h.
HashAlgorithm h =>
VerKeyVRF PraosVRF -> Hash h (VerKeyVRF PraosVRF)
forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
L.hashVerKeyVRF VerKeyVRF PraosVRF
VerKeyVRF StandardCrypto
poolVrfVK
, ppPledge :: Coin
L.ppPledge = Integer -> Coin
L.Coin Integer
0
, ppCost :: Coin
L.ppCost = Integer -> Coin
L.Coin Integer
0
, ppMargin :: UnitInterval
L.ppMargin = UnitInterval
forall a. Bounded a => a
minBound
, ppRewardAccount :: RewardAccount StandardCrypto
L.ppRewardAccount =
StakeAddress -> RewardAccount StandardCrypto
toShelleyStakeAddr (StakeAddress -> RewardAccount StandardCrypto)
-> StakeAddress -> RewardAccount StandardCrypto
forall a b. (a -> b) -> a -> b
$ NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
nw (StakeCredential -> StakeAddress)
-> StakeCredential -> StakeAddress
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
rewardsSVK)
, ppOwners :: Set (KeyHash 'Staking StandardCrypto)
L.ppOwners = Set (KeyHash 'Staking StandardCrypto)
forall a. Monoid a => a
mempty
, ppRelays :: StrictSeq StakePoolRelay
L.ppRelays = Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
specifiedRelays
, ppMetadata :: StrictMaybe PoolMetadata
L.ppMetadata = StrictMaybe PoolMetadata
forall a. StrictMaybe a
L.SNothing
}
where
lookupPoolRelay :: Map Word [L.StakePoolRelay] -> Seq.StrictSeq L.StakePoolRelay
lookupPoolRelay :: Map Word [StakePoolRelay] -> StrictSeq StakePoolRelay
lookupPoolRelay Map Word [StakePoolRelay]
m = [Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay
forall l. IsList l => [Item l] -> l
fromList ([Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay)
-> [Item (StrictSeq StakePoolRelay)] -> StrictSeq StakePoolRelay
forall a b. (a -> b) -> a -> b
$ [StakePoolRelay]
-> Word -> Map Word [StakePoolRelay] -> [StakePoolRelay]
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Word
index Map Word [StakePoolRelay]
m
poolColdVKF :: File Any 'In
poolColdVKF = FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File Any 'In) -> FilePath -> File Any 'In
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"cold.vkey"
poolVrfVKF :: File Any 'In
poolVrfVKF = FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File Any 'In) -> FilePath -> File Any 'In
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"vrf.vkey"
poolRewardVKF :: File Any 'In
poolRewardVKF = FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File (FilePath -> File Any 'In) -> FilePath -> File Any 'In
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath
"staking-reward.vkey"
computeInsecureStakeKeyAddr
:: StdGen
-> IO (StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
computeInsecureStakeKeyAddr :: StdGen
-> IO
(StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
computeInsecureStakeKeyAddr StdGen
g0 = do
(VerificationKey PaymentKey
paymentKeys, StdGen
g1) <- (SigningKey PaymentKey -> VerificationKey PaymentKey)
-> (SigningKey PaymentKey, StdGen)
-> (VerificationKey PaymentKey, StdGen)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey ((SigningKey PaymentKey, StdGen)
-> (VerificationKey PaymentKey, StdGen))
-> IO (SigningKey PaymentKey, StdGen)
-> IO (VerificationKey PaymentKey, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> AsType PaymentKey -> IO (SigningKey PaymentKey, StdGen)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole,
SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> m (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g0 AsType PaymentKey
AsPaymentKey
(VerificationKey StakeKey
stakeKeys, StdGen
g2) <- (SigningKey StakeKey -> VerificationKey StakeKey)
-> (SigningKey StakeKey, StdGen)
-> (VerificationKey StakeKey, StdGen)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first SigningKey StakeKey -> VerificationKey StakeKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey ((SigningKey StakeKey, StdGen)
-> (VerificationKey StakeKey, StdGen))
-> IO (SigningKey StakeKey, StdGen)
-> IO (VerificationKey StakeKey, StdGen)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> StdGen -> AsType StakeKey -> IO (SigningKey StakeKey, StdGen)
forall (m :: * -> *) keyrole.
(MonadIO m, Key keyrole,
SerialiseAsRawBytes (SigningKey keyrole)) =>
StdGen -> AsType keyrole -> m (SigningKey keyrole, StdGen)
generateInsecureSigningKey StdGen
g1 AsType StakeKey
AsStakeKey
(StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
-> IO
(StdGen, (VerificationKey PaymentKey, VerificationKey StakeKey))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (StdGen
g2, (VerificationKey PaymentKey
paymentKeys, VerificationKey StakeKey
stakeKeys))
computeDelegation
:: NetworkId
-> (VerificationKey PaymentKey, VerificationKey StakeKey)
-> L.PoolParams L.StandardCrypto
-> Delegation
computeDelegation :: NetworkId
-> (VerificationKey PaymentKey, VerificationKey StakeKey)
-> PoolParams StandardCrypto
-> Delegation
computeDelegation NetworkId
nw (VerificationKey PaymentKey
paymentVK, VerificationKey StakeKey
stakeVK) PoolParams StandardCrypto
dPoolParams = do
let paymentCredential :: PaymentCredential
paymentCredential = Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey PaymentKey
paymentVK)
let stakeAddressReference :: StakeAddressReference
stakeAddressReference = StakeCredential -> StakeAddressReference
StakeAddressByValue (StakeCredential -> StakeAddressReference)
-> (VerificationKey StakeKey -> StakeCredential)
-> VerificationKey StakeKey
-> StakeAddressReference
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash StakeKey -> StakeCredential
StakeCredentialByKey (Hash StakeKey -> StakeCredential)
-> (VerificationKey StakeKey -> Hash StakeKey)
-> VerificationKey StakeKey
-> StakeCredential
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey StakeKey -> StakeAddressReference)
-> VerificationKey StakeKey -> StakeAddressReference
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey
stakeVK
Delegation
{ dInitialUtxoAddr :: AddressInEra ShelleyEra
dInitialUtxoAddr =
ShelleyBasedEra ShelleyEra
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra ShelleyEra
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley NetworkId
nw PaymentCredential
paymentCredential StakeAddressReference
stakeAddressReference
, dDelegStaking :: KeyHash 'Staking StandardCrypto
dDelegStaking = VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
L.hashKey (VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto)
-> VKey 'Staking StandardCrypto -> KeyHash 'Staking StandardCrypto
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey -> VKey 'Staking StandardCrypto
unStakeVerificationKey VerificationKey StakeKey
stakeVK
, PoolParams StandardCrypto
dPoolParams :: PoolParams StandardCrypto
dPoolParams :: PoolParams StandardCrypto
dPoolParams
}
updateOutputTemplate
:: forall m
. MonadError GenesisCmdError m
=> SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Lovelace
-> [AddressInEra ShelleyEra]
-> [(L.KeyHash 'L.StakePool L.StandardCrypto, L.PoolParams L.StandardCrypto)]
-> [(L.KeyHash 'L.Staking L.StandardCrypto, L.KeyHash 'L.StakePool L.StandardCrypto)]
-> Maybe Lovelace
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis L.StandardCrypto
-> m (ShelleyGenesis L.StandardCrypto)
updateOutputTemplate :: forall (m :: * -> *).
MonadError GenesisCmdError m =>
SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Maybe Coin
-> [AddressInEra ShelleyEra]
-> [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> [(KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)]
-> Maybe Coin
-> Int
-> [AddressInEra ShelleyEra]
-> [AddressInEra ShelleyEra]
-> ShelleyGenesis StandardCrypto
-> m (ShelleyGenesis StandardCrypto)
updateOutputTemplate
(SystemStart UTCTime
sgSystemStart)
Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
Maybe Coin
mTotalSupply
[AddressInEra ShelleyEra]
utxoAddrsNonDeleg
[(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
pools
[(KeyHash 'Staking StandardCrypto,
KeyHash 'StakePool StandardCrypto)]
stake
Maybe Coin
mDelegatedSupply
Int
nUtxoAddrsDeleg
[AddressInEra ShelleyEra]
utxoAddrsDeleg
[AddressInEra ShelleyEra]
stuffedUtxoAddrs
template :: ShelleyGenesis StandardCrypto
template@ShelleyGenesis{PParams (ShelleyEra StandardCrypto)
sgProtocolParams :: forall c. ShelleyGenesis c -> PParams (ShelleyEra c)
sgProtocolParams :: PParams (ShelleyEra StandardCrypto)
sgProtocolParams} = do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
(Integer
delegCoinRaw Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
forall a. Integral a => a
totalSupply)
(GenesisCmdError -> m ()
forall a. GenesisCmdError -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisCmdError -> m ()) -> GenesisCmdError -> m ()
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> GenesisCmdError
GenesisCmdDelegatedSupplyExceedsTotalSupply Integer
delegCoinRaw Integer
forall a. Integral a => a
totalSupply)
ShelleyGenesis StandardCrypto -> m (ShelleyGenesis StandardCrypto)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
ShelleyGenesis StandardCrypto
template
{ sgSystemStart
, sgMaxLovelaceSupply = totalSupply
, sgGenDelegs = shelleyDelKeys
, sgInitialFunds =
fromList
[ (toShelleyAddr addr, v)
| (addr, v) <-
distribute nonDelegCoin nUtxoAddrsNonDeleg utxoAddrsNonDeleg
++ distribute delegCoin nUtxoAddrsDeleg utxoAddrsDeleg
++ mkStuffedUtxo stuffedUtxoAddrs
]
, sgStaking =
ShelleyGenesisStaking
{ sgsPools = ListMap pools
, sgsStake = ListMap stake
}
, sgProtocolParams
}
where
nonDelegCoin :: Natural
nonDelegCoin = Integer -> Natural
getCoinForDistribution Integer
nonDelegCoinRaw
delegCoin :: Natural
delegCoin = Integer -> Natural
getCoinForDistribution Integer
delegCoinRaw
getCoinForDistribution :: Integer -> Natural
getCoinForDistribution :: Integer -> Natural
getCoinForDistribution Integer
inputCoin =
Integer -> Natural
forall a. Num a => Integer -> a
fromInteger (Integer -> Natural) -> Integer -> Natural
forall a b. (a -> b) -> a -> b
$ Integer
inputCoin Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- (Integer
inputCoin Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`quot` Integer
10)
nUtxoAddrsNonDeleg :: Int
nUtxoAddrsNonDeleg = [AddressInEra ShelleyEra] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [AddressInEra ShelleyEra]
utxoAddrsNonDeleg
maximumLovelaceSupply :: Word64
maximumLovelaceSupply :: Word64
maximumLovelaceSupply = ShelleyGenesis StandardCrypto -> Word64
forall c. ShelleyGenesis c -> Word64
sgMaxLovelaceSupply ShelleyGenesis StandardCrypto
template
totalSupply :: Integral a => a
totalSupply :: forall a. Integral a => a
totalSupply = Word64 -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> a) -> Word64 -> a
forall a b. (a -> b) -> a -> b
$ Word64 -> (Coin -> Word64) -> Maybe Coin -> Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Word64
maximumLovelaceSupply Coin -> Word64
forall a. Integral a => Coin -> a
unLovelace Maybe Coin
mTotalSupply
delegCoinRaw, nonDelegCoinRaw :: Integer
delegCoinRaw :: Integer
delegCoinRaw = Integer -> (Coin -> Integer) -> Maybe Coin -> Integer
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Integer
forall a. Integral a => a
totalSupply Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
2) Coin -> Integer
forall a. Integral a => Coin -> a
unLovelace Maybe Coin
mDelegatedSupply
nonDelegCoinRaw :: Integer
nonDelegCoinRaw = Integer
forall a. Integral a => a
totalSupply Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
delegCoinRaw
distribute :: Natural -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
distribute :: Natural
-> Int
-> [AddressInEra ShelleyEra]
-> [(AddressInEra ShelleyEra, Coin)]
distribute Natural
funds Int
nAddrs [AddressInEra ShelleyEra]
addrs =
[AddressInEra ShelleyEra]
-> [Coin] -> [(AddressInEra ShelleyEra, Coin)]
forall a b. [a] -> [b] -> [(a, b)]
zip [AddressInEra ShelleyEra]
addrs ([Coin] -> [(AddressInEra ShelleyEra, Coin)])
-> [Coin] -> [(AddressInEra ShelleyEra, Coin)]
forall a b. (a -> b) -> a -> b
$ Integer -> Coin
L.Coin (Integer -> Coin) -> (Natural -> Integer) -> Natural -> Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Coin) -> [Natural] -> [Coin]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Natural
coinPerAddr Natural -> Natural -> Natural
forall a. Num a => a -> a -> a
+ Natural
remainder Natural -> [Natural] -> [Natural]
forall a. a -> [a] -> [a]
: Natural -> [Natural]
forall a. a -> [a]
repeat Natural
coinPerAddr)
where
coinPerAddr, remainder :: Natural
(Natural
coinPerAddr, Natural
remainder) = Natural
funds Natural -> Natural -> (Natural, Natural)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nAddrs
mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Coin)]
mkStuffedUtxo [AddressInEra ShelleyEra]
xs = (,Integer -> Coin
L.Coin Integer
minUtxoVal) (AddressInEra ShelleyEra -> (AddressInEra ShelleyEra, Coin))
-> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Coin)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddressInEra ShelleyEra]
xs
where
L.Coin Integer
minUtxoVal = PParams (ShelleyEra StandardCrypto)
sgProtocolParams PParams (ShelleyEra StandardCrypto)
-> Getting Coin (PParams (ShelleyEra StandardCrypto)) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams (ShelleyEra StandardCrypto)) Coin
forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
Lens' (PParams (ShelleyEra StandardCrypto)) Coin
L.ppMinUTxOValueL
shelleyDelKeys :: Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
shelleyDelKeys =
[Item
(Map
(KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto))]
-> Map
(KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
forall l. IsList l => [Item l] -> l
fromList
[ (KeyHash 'Genesis StandardCrypto
gh, KeyHash 'GenesisDelegate StandardCrypto
-> Hash StandardCrypto (VerKeyVRF StandardCrypto)
-> GenDelegPair StandardCrypto
forall c.
KeyHash 'GenesisDelegate c
-> Hash c (VerKeyVRF c) -> GenDelegPair c
L.GenDelegPair KeyHash 'GenesisDelegate StandardCrypto
gdh Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
| ( GenesisKeyHash KeyHash 'Genesis StandardCrypto
gh
, (GenesisDelegateKeyHash KeyHash 'GenesisDelegate StandardCrypto
gdh, VrfKeyHash Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
) <-
Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> [Item
(Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
forall l. IsList l => l -> [Item l]
toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
]
unLovelace :: Integral a => Lovelace -> a
unLovelace :: forall a. Integral a => Coin -> a
unLovelace (L.Coin Integer
coin) = Integer -> a
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
coin
readGenDelegsMap
:: Map Int FilePath
-> Map Int FilePath
-> Map Int FilePath
-> ExceptT
GenesisCmdError
IO
( Map
(Hash GenesisKey)
(Hash GenesisDelegateKey, Hash VrfKey)
)
readGenDelegsMap :: Map Int FilePath
-> Map Int FilePath
-> Map Int FilePath
-> ExceptT
GenesisCmdError
IO
(Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
readGenDelegsMap Map Int FilePath
genesisKeys Map Int FilePath
delegateKeys Map Int FilePath
delegateVrfKeys = do
Map Int (VerificationKey GenesisKey)
gkm <- AsType (VerificationKey GenesisKey)
-> Map Int FilePath
-> ExceptT
GenesisCmdError IO (Map Int (VerificationKey GenesisKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
AsType a -> Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys (AsType GenesisKey -> AsType (VerificationKey GenesisKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisKey
AsGenesisKey) Map Int FilePath
genesisKeys
Map Int (VerificationKey GenesisDelegateKey)
dkm <- AsType (VerificationKey GenesisDelegateKey)
-> Map Int FilePath
-> ExceptT
GenesisCmdError IO (Map Int (VerificationKey GenesisDelegateKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
AsType a -> Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys (AsType GenesisDelegateKey
-> AsType (VerificationKey GenesisDelegateKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisDelegateKey
AsGenesisDelegateKey) Map Int FilePath
delegateKeys
Map Int (VerificationKey VrfKey)
vkm <- AsType (VerificationKey VrfKey)
-> Map Int FilePath
-> ExceptT GenesisCmdError IO (Map Int (VerificationKey VrfKey))
forall a k.
(HasTextEnvelope a, Ord k) =>
AsType a -> Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys (AsType VrfKey -> AsType (VerificationKey VrfKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey) Map Int FilePath
delegateVrfKeys
let combinedMap
:: Map
Int
( VerificationKey GenesisKey
, ( VerificationKey GenesisDelegateKey
, VerificationKey VrfKey
)
)
combinedMap :: Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap =
(VerificationKey GenesisKey
-> (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
-> (VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey)))
-> Map Int (VerificationKey GenesisKey)
-> Map
Int (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
-> Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith
(,)
Map Int (VerificationKey GenesisKey)
gkm
((VerificationKey GenesisDelegateKey
-> VerificationKey VrfKey
-> (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisDelegateKey)
-> Map Int (VerificationKey VrfKey)
-> Map
Int (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) Map Int (VerificationKey GenesisDelegateKey)
dkm Map Int (VerificationKey VrfKey)
vkm)
let gkmExtra :: Map Int (VerificationKey GenesisKey)
gkmExtra = Map Int (VerificationKey GenesisKey)
gkm Map Int (VerificationKey GenesisKey)
-> Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
dkmExtra :: Map Int (VerificationKey GenesisDelegateKey)
dkmExtra = Map Int (VerificationKey GenesisDelegateKey)
dkm Map Int (VerificationKey GenesisDelegateKey)
-> Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisDelegateKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
vkmExtra :: Map Int (VerificationKey VrfKey)
vkmExtra = Map Int (VerificationKey VrfKey)
vkm Map Int (VerificationKey VrfKey)
-> Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey VrfKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
Bool
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map Int (VerificationKey GenesisKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey GenesisKey)
gkmExtra Bool -> Bool -> Bool
&& Map Int (VerificationKey GenesisDelegateKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey GenesisDelegateKey)
dkmExtra Bool -> Bool -> Bool
&& Map Int (VerificationKey VrfKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey VrfKey)
vkmExtra) (ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ())
-> ExceptT GenesisCmdError IO () -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a. GenesisCmdError -> ExceptT GenesisCmdError IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (GenesisCmdError -> ExceptT GenesisCmdError IO ())
-> GenesisCmdError -> ExceptT GenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
[Int] -> [Int] -> [Int] -> GenesisCmdError
GenesisCmdMismatchedGenesisKeyFiles
(Map Int (VerificationKey GenesisKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisKey)
gkm)
(Map Int (VerificationKey GenesisDelegateKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisDelegateKey)
dkm)
(Map Int (VerificationKey VrfKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey VrfKey)
vkm)
let delegsMap
:: Map
(Hash GenesisKey)
(Hash GenesisDelegateKey, Hash VrfKey)
delegsMap :: Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegsMap =
[Item
(Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))]
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
forall l. IsList l => [Item l] -> l
fromList
[ (Hash GenesisKey
gh, (Hash GenesisDelegateKey
dh, Hash VrfKey
vh))
| (VerificationKey GenesisKey
g, (VerificationKey GenesisDelegateKey
d, VerificationKey VrfKey
v)) <- Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> [(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))]
forall k a. Map k a -> [a]
Map.elems Map
Int
(VerificationKey GenesisKey,
(VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
, let gh :: Hash GenesisKey
gh = VerificationKey GenesisKey -> Hash GenesisKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisKey
g
dh :: Hash GenesisDelegateKey
dh = VerificationKey GenesisDelegateKey -> Hash GenesisDelegateKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey GenesisDelegateKey
d
vh :: Hash VrfKey
vh = VerificationKey VrfKey -> Hash VrfKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VrfKey
v
]
Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> ExceptT
GenesisCmdError
IO
(Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey))
forall a. a -> ExceptT GenesisCmdError IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
delegsMap
readKeys
:: ()
=> HasTextEnvelope a
=> Ord k
=> AsType a
-> Map k FilePath
-> ExceptT GenesisCmdError IO (Map k a)
readKeys :: forall a k.
(HasTextEnvelope a, Ord k) =>
AsType a -> Map k FilePath -> ExceptT GenesisCmdError IO (Map k a)
readKeys AsType a
asType Map k FilePath
genesisVKeys = do
(FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
-> ExceptT GenesisCmdError IO (Map k a)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT (FileError TextEnvelopeError) IO (Map k a)
-> ExceptT GenesisCmdError IO (Map k a))
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
-> ExceptT GenesisCmdError IO (Map k a)
forall a b. (a -> b) -> a -> b
$
[(k, a)] -> Map k a
[Item (Map k a)] -> Map k a
forall l. IsList l => [Item l] -> l
fromList
([(k, a)] -> Map k a)
-> ExceptT (FileError TextEnvelopeError) IO [(k, a)]
-> ExceptT (FileError TextEnvelopeError) IO (Map k a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ExceptT (FileError TextEnvelopeError) IO (k, a)]
-> ExceptT (FileError TextEnvelopeError) IO [(k, a)]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ (,) k
ix (a -> (k, a))
-> ExceptT (FileError TextEnvelopeError) IO a
-> ExceptT (FileError TextEnvelopeError) IO (k, a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> File Any 'In -> ExceptT (FileError TextEnvelopeError) IO a
readKey (FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
file)
| (k
ix, FilePath
file) <- Map k FilePath -> [Item (Map k FilePath)]
forall l. IsList l => l -> [Item l]
toList Map k FilePath
genesisVKeys
]
where
readKey :: File Any 'In -> ExceptT (FileError TextEnvelopeError) IO a
readKey = IO (Either (FileError TextEnvelopeError) a)
-> ExceptT (FileError TextEnvelopeError) IO a
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO (Either (FileError TextEnvelopeError) a)
-> ExceptT (FileError TextEnvelopeError) IO a)
-> (File Any 'In -> IO (Either (FileError TextEnvelopeError) a))
-> File Any 'In
-> ExceptT (FileError TextEnvelopeError) IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType a
-> File Any 'In -> IO (Either (FileError TextEnvelopeError) a)
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope AsType a
asType
readInitialFundAddresses
:: [FilePath]
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses :: [FilePath]
-> NetworkId
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
readInitialFundAddresses [FilePath]
utxoKeyFileNames NetworkId
nw = do
[VerificationKey GenesisUTxOKey]
vkeys <-
(FileError TextEnvelopeError -> GenesisCmdError)
-> ExceptT
(FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> GenesisCmdError
GenesisCmdTextEnvReadFileError (ExceptT
(FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey])
-> ExceptT
(FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT GenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall a b. (a -> b) -> a -> b
$
[ExceptT
(FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)]
-> ExceptT
(FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ IO
(Either
(FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
(Either
(FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey))
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
(FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
AsType (VerificationKey GenesisUTxOKey)
-> File Any 'In
-> IO
(Either
(FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a content.
HasTextEnvelope a =>
AsType a
-> File content 'In -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope
(AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
(FilePath -> File Any 'In
forall content (direction :: FileDirection).
FilePath -> File content direction
File FilePath
file)
| FilePath
file <- [FilePath]
utxoKeyFileNames
]
[AddressInEra ShelleyEra]
-> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra]
forall a. a -> ExceptT GenesisCmdError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
[ AddressInEra ShelleyEra
addr
| VerificationKey GenesisUTxOKey
vkey <- [VerificationKey GenesisUTxOKey]
vkeys
, let vkh :: Hash PaymentKey
vkh = VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (VerificationKey GenesisUTxOKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey VerificationKey GenesisUTxOKey
vkey)
addr :: AddressInEra ShelleyEra
addr =
ShelleyBasedEra ShelleyEra
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra ShelleyEra
forall era.
ShelleyBasedEra era
-> NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra era
makeShelleyAddressInEra
ShelleyBasedEra ShelleyEra
ShelleyBasedEraShelley
NetworkId
nw
(Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
StakeAddressReference
NoStakeAddress
]