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

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

module Bcc.CLI.Sophie.Run.Genesis
  ( SophieGenesisCmdError(..)
  , readSophieGenesis
  , readAurumGenesis
  , renderSophieGenesisCmdError
  , runGenesisCmd
  ) where

import           Bcc.Prelude
import           Prelude (id)

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

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

import           Bcc.Binary (ToCBOR (..))

import           Bcc.Crypto.Hash (HashAlgorithm)
import qualified Bcc.Crypto.Hash as Hash
import qualified Bcc.Crypto.Random as Crypto
import           Crypto.Random as Crypto

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

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

import qualified Bcc.Crypto.Hash as Crypto

import           Bcc.Api
import           Bcc.Api.Sophie

import           Shardagnostic.Consensus.BlockchainTime (SystemStart (..))
import           Shardagnostic.Consensus.Sophie.Eras (StandardSophie)
import           Shardagnostic.Consensus.Sophie.Node (SophieGenesisStaking (..))

import qualified Bcc.Ledger.Aurum.Genesis as Aurum
import qualified Bcc.Ledger.Aurum.Language as Aurum
import qualified Bcc.Ledger.Aurum.Scripts as Aurum
import qualified Bcc.Ledger.BaseTypes as Ledger
import           Bcc.Ledger.Coin (Coin (..))
import qualified Bcc.Ledger.Keys as Ledger
import qualified Sophie.Spec.Ledger.API as Ledger
import qualified Sophie.Spec.Ledger.PParams as Sophie

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

import           Bcc.CLI.Helpers (textShow)
import           Bcc.CLI.Sophie.Commands
import           Bcc.CLI.Sophie.Key
import           Bcc.CLI.Sophie.Orphans ()
import           Bcc.CLI.Sophie.Parsers (renderTxIn)
import           Bcc.CLI.Sophie.Run.Address
import           Bcc.CLI.Sophie.Run.Node (SophieNodeCmdError (..), renderSophieNodeCmdError,
                   runNodeIssueOpCert, runNodeKeyGenCold, runNodeKeyGenKES, runNodeKeyGenVRF)
import           Bcc.CLI.Sophie.Run.Pool (SophiePoolCmdError (..), renderSophiePoolCmdError)
import           Bcc.CLI.Sophie.Run.StakeAddress (SophieStakeAddressCmdError (..),
                   renderSophieStakeAddressCmdError, runStakeAddressKeyGen)
import           Bcc.CLI.Types
import           Zerepoch.V1.Ledger.Api (defaultCostModelParams)

{- HLINT ignore "Reduce duplication" -}

data SophieGenesisCmdError
  = SophieGenesisCmdAesonDecodeError !FilePath !Text
  | SophieGenesisCmdGenesisFileError !(FileError ())
  | SophieGenesisCmdFileError !(FileError ())
  | SophieGenesisCmdMismatchedGenesisKeyFiles [Int] [Int] [Int]
  | SophieGenesisCmdMismatchedVestedKeyFiles [Int] [Int] [Int]
  | SophieGenesisCmdFilesNoIndex [FilePath]
  | SophieGenesisCmdFilesDupIndex [FilePath]
  | SophieGenesisCmdTextEnvReadFileError !(FileError TextEnvelopeError)
  | SophieGenesisCmdUnexpectedAddressVerificationKey !VerificationKeyFile !Text !SomeAddressVerificationKey
  | SophieGenesisCmdTooFewPoolsForBulkCreds !Word !Word !Word
  | SophieGenesisCmdAddressCmdError !SophieAddressCmdError
  | SophieGenesisCmdNodeCmdError !SophieNodeCmdError
  | SophieGenesisCmdPoolCmdError !SophiePoolCmdError
  | SophieGenesisCmdStakeAddressCmdError !SophieStakeAddressCmdError
  | SophieGenesisCmdCostModelsError !FilePath
  deriving Int -> SophieGenesisCmdError -> ShowS
[SophieGenesisCmdError] -> ShowS
SophieGenesisCmdError -> String
(Int -> SophieGenesisCmdError -> ShowS)
-> (SophieGenesisCmdError -> String)
-> ([SophieGenesisCmdError] -> ShowS)
-> Show SophieGenesisCmdError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SophieGenesisCmdError] -> ShowS
$cshowList :: [SophieGenesisCmdError] -> ShowS
show :: SophieGenesisCmdError -> String
$cshow :: SophieGenesisCmdError -> String
showsPrec :: Int -> SophieGenesisCmdError -> ShowS
$cshowsPrec :: Int -> SophieGenesisCmdError -> ShowS
Show

renderSophieGenesisCmdError :: SophieGenesisCmdError -> Text
renderSophieGenesisCmdError :: SophieGenesisCmdError -> Text
renderSophieGenesisCmdError SophieGenesisCmdError
err =
  case SophieGenesisCmdError
err of
    SophieGenesisCmdAesonDecodeError String
fp Text
decErr ->
      Text
"Error while decoding Sophie genesis at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
fp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
textShow Text
decErr
    SophieGenesisCmdGenesisFileError FileError ()
fe -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fe
    SophieGenesisCmdFileError FileError ()
fe -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FileError () -> String
forall e. Error e => e -> String
displayError FileError ()
fe
    SophieGenesisCmdMismatchedGenesisKeyFiles [Int]
gfiles [Int]
dfiles [Int]
vfiles ->
      Text
"Mismatch between the files found:\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Genesis key file indexes:      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
forall a. Show a => a -> Text
textShow [Int]
gfiles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Delegate key file indexes:     " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
forall a. Show a => a -> Text
textShow [Int]
dfiles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Delegate VRF key file indexes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
forall a. Show a => a -> Text
textShow [Int]
vfiles
    SophieGenesisCmdMismatchedVestedKeyFiles [Int]
afiles [Int]
adfiles [Int]
avfiles ->
      Text
"Mismatch between the files found:\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Vested key file indexes:      " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
forall a. Show a => a -> Text
textShow [Int]
afiles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"VestedDelegate key file indexes:     " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
forall a. Show a => a -> Text
textShow [Int]
adfiles Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"VestedDelegate VRF key file indexes: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Int] -> Text
forall a. Show a => a -> Text
textShow [Int]
avfiles
    SophieGenesisCmdFilesNoIndex [String]
files ->
      Text
"The genesis keys files are expected to have a numeric index but these do not:\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unlines ((String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map String -> Text
Text.pack [String]
files)
    SophieGenesisCmdFilesDupIndex [String]
files ->
      Text
"The genesis keys files are expected to have a unique numeric index but these do not:\n"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
Text.unlines ((String -> Text) -> [String] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map String -> Text
Text.pack [String]
files)
    SophieGenesisCmdTextEnvReadFileError FileError TextEnvelopeError
fileErr -> String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ FileError TextEnvelopeError -> String
forall e. Error e => e -> String
displayError FileError TextEnvelopeError
fileErr
    SophieGenesisCmdUnexpectedAddressVerificationKey (VerificationKeyFile String
file) Text
expect SomeAddressVerificationKey
got -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Unexpected address verification key type in file ", String -> Text
Text.pack String
file
      , Text
", expected: ", Text
expect, Text
", got: ", SomeAddressVerificationKey -> Text
forall a. Show a => a -> Text
textShow SomeAddressVerificationKey
got
      ]
    SophieGenesisCmdTooFewPoolsForBulkCreds Word
pools Word
files Word
perPool -> [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
"Number of pools requested for generation (", Word -> Text
forall a. Show a => a -> Text
textShow Word
pools
      , Text
") is insufficient to fill ", Word -> Text
forall a. Show a => a -> Text
textShow Word
files
      , Text
" bulk files, with ", Word -> Text
forall a. Show a => a -> Text
textShow Word
perPool, Text
" pools per file."
      ]
    SophieGenesisCmdAddressCmdError SophieAddressCmdError
e -> SophieAddressCmdError -> Text
renderSophieAddressCmdError SophieAddressCmdError
e
    SophieGenesisCmdNodeCmdError SophieNodeCmdError
e -> SophieNodeCmdError -> Text
renderSophieNodeCmdError SophieNodeCmdError
e
    SophieGenesisCmdPoolCmdError SophiePoolCmdError
e -> SophiePoolCmdError -> Text
renderSophiePoolCmdError SophiePoolCmdError
e
    SophieGenesisCmdStakeAddressCmdError SophieStakeAddressCmdError
e -> SophieStakeAddressCmdError -> Text
renderSophieStakeAddressCmdError SophieStakeAddressCmdError
e
    SophieGenesisCmdCostModelsError String
fp ->
      Text
"Cost model is invalid: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack String
fp

runGenesisCmd :: GenesisCmd -> ExceptT SophieGenesisCmdError IO ()
runGenesisCmd :: GenesisCmd -> ExceptT SophieGenesisCmdError IO ()
runGenesisCmd (GenesisKeyGenGenesis VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT SophieGenesisCmdError IO ()
runGenesisKeyGenGenesis VerificationKeyFile
vk SigningKeyFile
sk
runGenesisCmd (GenesisKeyGenDelegate VerificationKeyFile
vk SigningKeyFile
sk OpCertCounterFile
ctr) = VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT SophieGenesisCmdError IO ()
runGenesisKeyGenDelegate VerificationKeyFile
vk SigningKeyFile
sk OpCertCounterFile
ctr
runGenesisCmd (GenesisKeyGenVested VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT SophieGenesisCmdError IO ()
runGenesisKeyGenVested VerificationKeyFile
vk SigningKeyFile
sk
runGenesisCmd (GenesisKeyGenVestedDelegate VerificationKeyFile
vk SigningKeyFile
sk OpCertCounterFile
ctr) = VerificationKeyFile
-> SigningKeyFile
-> OpCertCounterFile
-> ExceptT SophieGenesisCmdError IO ()
runGenesisKeyGenVestedDelegate VerificationKeyFile
vk SigningKeyFile
sk OpCertCounterFile
ctr
runGenesisCmd (GenesisKeyGenUTxO VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT SophieGenesisCmdError IO ()
runGenesisKeyGenUTxO VerificationKeyFile
vk SigningKeyFile
sk
runGenesisCmd (GenesisCmdKeyHash VerificationKeyFile
vk) = VerificationKeyFile -> ExceptT SophieGenesisCmdError IO ()
runGenesisKeyHash VerificationKeyFile
vk
runGenesisCmd (GenesisVerKey VerificationKeyFile
vk SigningKeyFile
sk) = VerificationKeyFile
-> SigningKeyFile -> ExceptT SophieGenesisCmdError IO ()
runGenesisVerKey VerificationKeyFile
vk SigningKeyFile
sk
runGenesisCmd (GenesisTxIn VerificationKeyFile
vk NetworkId
nw Maybe OutputFile
mOutFile) = VerificationKeyFile
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieGenesisCmdError IO ()
runGenesisTxIn VerificationKeyFile
vk NetworkId
nw Maybe OutputFile
mOutFile
runGenesisCmd (GenesisAddr VerificationKeyFile
vk NetworkId
nw Maybe OutputFile
mOutFile) = VerificationKeyFile
-> NetworkId
-> Maybe OutputFile
-> ExceptT SophieGenesisCmdError IO ()
runGenesisAddr VerificationKeyFile
vk NetworkId
nw Maybe OutputFile
mOutFile
runGenesisCmd (GenesisCreate GenesisDir
gd Word
gn Word
vn Word
un Maybe SystemStart
ms Maybe Entropic
am NetworkId
nw) = GenesisDir
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Entropic
-> NetworkId
-> ExceptT SophieGenesisCmdError IO ()
runGenesisCreate GenesisDir
gd Word
gn Word
vn Word
un Maybe SystemStart
ms Maybe Entropic
am NetworkId
nw
runGenesisCmd (GenesisCreateStaked GenesisDir
gd Word
gn Word
gp Word
gl Word
vn Word
un Maybe SystemStart
ms Maybe Entropic
am Entropic
ds NetworkId
nw Word
bf Word
bp Word
su) = GenesisDir
-> Word
-> Word
-> Word
-> Word
-> Word
-> Maybe SystemStart
-> Maybe Entropic
-> Entropic
-> NetworkId
-> Word
-> Word
-> Word
-> ExceptT SophieGenesisCmdError IO ()
runGenesisCreateStaked GenesisDir
gd Word
gn Word
gp Word
gl Word
vn Word
un Maybe SystemStart
ms Maybe Entropic
am Entropic
ds NetworkId
nw Word
bf Word
bp Word
su
runGenesisCmd (GenesisHashFile GenesisFile
gf) = GenesisFile -> ExceptT SophieGenesisCmdError IO ()
runGenesisHashFile GenesisFile
gf

--
-- Genesis command implementations
--

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


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

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


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

runGenesisKeyGenVested :: VerificationKeyFile -> SigningKeyFile
                        -> ExceptT SophieGenesisCmdError IO ()
runGenesisKeyGenVested :: VerificationKeyFile
-> SigningKeyFile -> ExceptT SophieGenesisCmdError IO ()
runGenesisKeyGenVested (VerificationKeyFile String
vkeyPath)
                        (SigningKeyFile String
skeyPath) = do
    SigningKey GenesisVestedKey
skey <- IO (SigningKey GenesisVestedKey)
-> ExceptT SophieGenesisCmdError IO (SigningKey GenesisVestedKey)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (SigningKey GenesisVestedKey)
 -> ExceptT SophieGenesisCmdError IO (SigningKey GenesisVestedKey))
-> IO (SigningKey GenesisVestedKey)
-> ExceptT SophieGenesisCmdError IO (SigningKey GenesisVestedKey)
forall a b. (a -> b) -> a -> b
$ AsType GenesisVestedKey -> IO (SigningKey GenesisVestedKey)
forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
generateSigningKey AsType GenesisVestedKey
AsGenesisVestedKey
    let vkey :: VerificationKey GenesisVestedKey
vkey = SigningKey GenesisVestedKey -> VerificationKey GenesisVestedKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey GenesisVestedKey
skey
    (FileError () -> SophieGenesisCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT SophieGenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophieGenesisCmdError
SophieGenesisCmdGenesisFileError
      (ExceptT (FileError ()) IO ()
 -> ExceptT SophieGenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieGenesisCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError ()) ())
 -> ExceptT SophieGenesisCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> SigningKey GenesisVestedKey
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
skeyPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
skeyDesc) SigningKey GenesisVestedKey
skey
    (FileError () -> SophieGenesisCmdError)
-> ExceptT (FileError ()) IO ()
-> ExceptT SophieGenesisCmdError IO ()
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError () -> SophieGenesisCmdError
SophieGenesisCmdGenesisFileError
      (ExceptT (FileError ()) IO ()
 -> ExceptT SophieGenesisCmdError IO ())
-> (IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieGenesisCmdError IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError ()) ()) -> ExceptT (FileError ()) IO ()
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError ()) ())
 -> ExceptT SophieGenesisCmdError IO ())
-> IO (Either (FileError ()) ())
-> ExceptT SophieGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> Maybe TextEnvelopeDescr
-> VerificationKey GenesisVestedKey
-> IO (Either (FileError ()) ())
forall a.
HasTextEnvelope a =>
String
-> Maybe TextEnvelopeDescr -> a -> IO (Either (FileError ()) ())
writeFileTextEnvelope String
vkeyPath (TextEnvelopeDescr -> Maybe TextEnvelopeDescr
forall a. a -> Maybe a
Just TextEnvelopeDescr
vkeyDesc) VerificationKey GenesisVestedKey
vkey
  where
    skeyDesc, vkeyDesc :: TextEnvelopeDescr
    skeyDesc :: TextEnvelopeDescr
skeyDesc = TextEnvelopeDescr
"Vested Signing Key"
    vkeyDesc :: TextEnvelopeDescr
vkeyDesc = TextEnvelopeDescr
"Vested Verification Key"


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

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


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

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


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

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


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

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

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

data SomeGenesisKey f
     = AGenesisKey               (f GenesisKey)
     | AGenesisDelegateKey       (f GenesisDelegateKey)
     | AGenesisVestedKey         (f GenesisVestedKey)
     | AGenesisVestedDelegateKey (f GenesisVestedDelegateKey)
     | AGenesisUTxOKey           (f GenesisUTxOKey)


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


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

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


--
-- Create Genesis command implementation
--

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

  SophieGenesis StandardSophie
template <- String
-> (SophieGenesis StandardSophie -> SophieGenesis StandardSophie)
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
readSophieGenesis (String
rootdir String -> ShowS
</> String
"genesis.spec.json") SophieGenesis StandardSophie -> SophieGenesis StandardSophie
adjustTemplate

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

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

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

  let (SophieGenesis StandardSophie
sophieGenesis, AurumGenesis
aurumGenesis) =
        SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
-> Maybe Entropic
-> [AddressInEra SophieEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Entropic
-> [AddressInEra SophieEra]
-> [AddressInEra SophieEra]
-> SophieGenesis StandardSophie
-> Entropic
-> ExecutionUnitPrices
-> ExecutionUnits
-> ExecutionUnits
-> Natural
-> Natural
-> Natural
-> (SophieGenesis StandardSophie, AurumGenesis)
updateTemplate
          -- Sophie genesis parameters
          SystemStart
start Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
vestedDlgs Maybe Entropic
mAmount [AddressInEra SophieEra]
utxoAddrs Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
forall a. Monoid a => a
mempty (Integer -> Entropic
Entropic Integer
0) [] [] SophieGenesis StandardSophie
template
          -- Aurum genesis parameters
          -- TODO aurum: parameterize these, don't just use defaults
          Entropic
aurumGenesisDefaultEntropicPerUtxoWord
          ExecutionUnitPrices
aurumGenesisDefaultExecutionPrices
          ExecutionUnits
aurumGenesisDefaultMaxTxExecutionUnits
          ExecutionUnits
aurumGenesisDefaultMaxBlockExecutionUnits
          Natural
aurumGenesisDefaultMaxValueSize
          Natural
aurumGenesisDefaultCollateralPercent
          Natural
aurumGenesisDefaultMaxCollateralInputs

  String
-> SophieGenesis StandardSophie
-> ExceptT SophieGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT SophieGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.json")        SophieGenesis StandardSophie
sophieGenesis
  String -> AurumGenesis -> ExceptT SophieGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT SophieGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.aurum.json") AurumGenesis
aurumGenesis
  --TODO: rationalise the naming convention on these genesis json files.
  where
    adjustTemplate :: SophieGenesis StandardSophie -> SophieGenesis StandardSophie
adjustTemplate SophieGenesis StandardSophie
t = SophieGenesis StandardSophie
t { sgNetworkMagic :: Word32
sgNetworkMagic = NetworkMagic -> Word32
unNetworkMagic (NetworkId -> NetworkMagic
toNetworkMagic NetworkId
network) }
    gendir :: String
gendir  = String
rootdir String -> ShowS
</> String
"genesis-keys"
    deldir :: String
deldir  = String
rootdir String -> ShowS
</> String
"delegate-keys"
    vesteddir :: String
vesteddir  = String
rootdir String -> ShowS
</> String
"vested-keys"
    vesteddeldir :: String
vesteddeldir  = String
rootdir String -> ShowS
</> String
"vesteddelegate-keys"
    utxodir :: String
utxodir = String
rootdir String -> ShowS
</> String
"utxo-keys"

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

  SophieGenesis StandardSophie
template <- String
-> (SophieGenesis StandardSophie -> SophieGenesis StandardSophie)
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
readSophieGenesis (String
rootdir String -> ShowS
</> String
"genesis.spec.json") SophieGenesis StandardSophie -> SophieGenesis StandardSophie
adjustTemplate

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

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

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

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

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

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

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

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

  let poolMap :: Map (Ledger.KeyHash Ledger.Staking StandardCrypto) (Ledger.PoolParams StandardCrypto)
      poolMap :: Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolMap = [(KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)]
 -> Map
      (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto))
-> [(KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
forall a b. (a -> b) -> a -> b
$ Delegation
-> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)
mkDelegationMapEntry (Delegation
 -> (KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto))
-> [Delegation]
-> [(KeyHash 'Staking StandardCrypto, PoolParams StandardCrypto)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
      delegAddrs :: [AddressInEra SophieEra]
delegAddrs = Delegation -> AddressInEra SophieEra
dInitialUtxoAddr (Delegation -> AddressInEra SophieEra)
-> [Delegation] -> [AddressInEra SophieEra]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Delegation]
delegations
      (SophieGenesis StandardSophie
sophieGenesis, AurumGenesis
aurumGenesis) =
        SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
-> Maybe Entropic
-> [AddressInEra SophieEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Entropic
-> [AddressInEra SophieEra]
-> [AddressInEra SophieEra]
-> SophieGenesis StandardSophie
-> Entropic
-> ExecutionUnitPrices
-> ExecutionUnits
-> ExecutionUnits
-> Natural
-> Natural
-> Natural
-> (SophieGenesis StandardSophie, AurumGenesis)
updateTemplate
          -- Sophie genesis parameters
          SystemStart
start Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDlgs Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
vestedDlgs Maybe Entropic
mNonDlgAmount [AddressInEra SophieEra]
nonDelegAddrs Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolMap
          Entropic
stDlgAmount [AddressInEra SophieEra]
delegAddrs [AddressInEra SophieEra]
stuffedUtxoAddrs SophieGenesis StandardSophie
template
          -- Aurum genesis parameters
          -- TODO aurum: parameterize these, don't just use defaults
          Entropic
aurumGenesisDefaultEntropicPerUtxoWord
          ExecutionUnitPrices
aurumGenesisDefaultExecutionPrices
          ExecutionUnits
aurumGenesisDefaultMaxTxExecutionUnits
          ExecutionUnits
aurumGenesisDefaultMaxBlockExecutionUnits
          Natural
aurumGenesisDefaultMaxValueSize
          Natural
aurumGenesisDefaultCollateralPercent
          Natural
aurumGenesisDefaultMaxCollateralInputs

  String
-> SophieGenesis StandardSophie
-> ExceptT SophieGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT SophieGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.json")        SophieGenesis StandardSophie
sophieGenesis
  String -> AurumGenesis -> ExceptT SophieGenesisCmdError IO ()
forall genesis.
ToJSON genesis =>
String -> genesis -> ExceptT SophieGenesisCmdError IO ()
writeFileGenesis (String
rootdir String -> ShowS
</> String
"genesis.aurum.json") AurumGenesis
aurumGenesis
  --TODO: rationalise the naming convention on these genesis json files.

  IO () -> ExceptT SophieGenesisCmdError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT SophieGenesisCmdError IO ())
-> IO () -> ExceptT SophieGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ Text -> IO ()
Text.putStrLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$
    [ Text
"generated genesis with: "
    , Word -> Text
forall a. Show a => a -> Text
textShow Word
genNumGenesisKeys, Text
" genesis keys, "
    , Word -> Text
forall a. Show a => a -> Text
textShow Word
genNumVestedKeys, Text
" vested keys, "
    , Word -> Text
forall a. Show a => a -> Text
textShow Word
genNumUTxOKeys, Text
" non-delegating UTxO keys, "
    , Word -> Text
forall a. Show a => a -> Text
textShow Word
genNumPools, Text
" stake pools, "
    , Word -> Text
forall a. Show a => a -> Text
textShow Word
genNumStDelegs, Text
" delegating UTxO keys, "
    , Int -> Text
forall a. Show a => a -> Text
textShow ([Delegation] -> Int
forall a. HasLength a => a -> Int
length [Delegation]
delegations), Text
" delegation relationships, "
    , Int -> Text
forall a. Show a => a -> Text
textShow (Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Int
forall k a. Map k a -> Int
Map.size Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolMap), Text
" delegation map entries, "
    , Int -> Text
forall a. Show a => a -> Text
textShow ([AddressInEra SophieEra] -> Int
forall a. HasLength a => a -> Int
length [AddressInEra SophieEra]
delegAddrs), Text
" delegating addresses"
    ] [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++
    [ [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat
      [ Text
", "
      , Word -> Text
forall a. Show a => a -> Text
textShow Word
bulkPoolCredFiles, Text
" bulk pool credential files, "
      , Word -> Text
forall a. Show a => a -> Text
textShow Word
bulkPoolsPerFile, Text
" pools per bulk credential file, indices starting from "
      , Word -> Text
forall a. Show a => a -> Text
textShow Word
bulkOffset, Text
", "
      , Int -> Text
forall a. Show a => a -> Text
textShow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ [Word] -> Int
forall a. HasLength a => a -> Int
length [Word]
bulkIndices, Text
" total pools in bulk nodes, each bulk node having this many entries: "
      , [Int] -> Text
forall a. Show a => a -> Text
textShow ([Int] -> Text) -> [Int] -> Text
forall a b. (a -> b) -> a -> b
$ [Word] -> Int
forall a. HasLength a => a -> Int
length ([Word] -> Int) -> [[Word]] -> [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [[Word]]
bulkSlices
      ]
    | Word
bulkPoolCredFiles Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
bulkPoolsPerFile Word -> Word -> Bool
forall a. Ord a => a -> a -> Bool
> Word
0 ]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

buildPool :: NetworkId -> FilePath -> Word -> ExceptT SophieGenesisCmdError IO (Ledger.PoolParams StandardCrypto)
buildPool :: NetworkId
-> String
-> Word
-> ExceptT SophieGenesisCmdError IO (PoolParams StandardCrypto)
buildPool NetworkId
nw String
dir Word
index = do
    StakePoolVerificationKey poolColdVK <- (FileError TextEnvelopeError -> SophieGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (SophiePoolCmdError -> SophieGenesisCmdError
SophieGenesisCmdPoolCmdError
                                                         (SophiePoolCmdError -> SophieGenesisCmdError)
-> (FileError TextEnvelopeError -> SophiePoolCmdError)
-> FileError TextEnvelopeError
-> SophieGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FileError TextEnvelopeError -> SophiePoolCmdError
SophiePoolCmdReadFileError)
      (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
 -> ExceptT SophieGenesisCmdError IO (VerificationKey StakePoolKey))
-> (IO
      (Either
         (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakePoolKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakePoolKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
 -> ExceptT SophieGenesisCmdError IO (VerificationKey StakePoolKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakePoolKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakePoolKey)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey StakePoolKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakePoolKey -> AsType (VerificationKey StakePoolKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakePoolKey
AsStakePoolKey) String
poolColdVKF
    VrfVerificationKey poolVrfVK <- (FileError TextEnvelopeError -> SophieGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
-> ExceptT SophieGenesisCmdError IO (VerificationKey VrfKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (SophieNodeCmdError -> SophieGenesisCmdError
SophieGenesisCmdNodeCmdError
                                                  (SophieNodeCmdError -> SophieGenesisCmdError)
-> (FileError TextEnvelopeError -> SophieNodeCmdError)
-> FileError TextEnvelopeError
-> SophieGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FileError TextEnvelopeError -> SophieNodeCmdError
SophieNodeCmdReadFileError)
      (ExceptT (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
 -> ExceptT SophieGenesisCmdError IO (VerificationKey VrfKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey VrfKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT SophieGenesisCmdError IO (VerificationKey VrfKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey VrfKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
 -> ExceptT SophieGenesisCmdError IO (VerificationKey VrfKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
-> ExceptT SophieGenesisCmdError IO (VerificationKey VrfKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey VrfKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey VrfKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType VrfKey -> AsType (VerificationKey VrfKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType VrfKey
AsVrfKey) String
poolVrfVKF
    VerificationKey StakeKey
rewardsSVK <- (FileError TextEnvelopeError -> SophieGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> SophieGenesisCmdError
SophieGenesisCmdTextEnvReadFileError
      (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
 -> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
 -> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakeKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakeKey -> AsType (VerificationKey StakeKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakeKey
AsStakeKey) String
poolRewardVKF
    PoolParams StandardCrypto
-> ExceptT SophieGenesisCmdError IO (PoolParams StandardCrypto)
forall (f :: * -> *) a. Applicative f => a -> f a
pure PoolParams :: forall crypto.
KeyHash 'StakePool crypto
-> Hash crypto (VerKeyVRF crypto)
-> Coin
-> Coin
-> UnitInterval
-> RewardAcnt crypto
-> Set (KeyHash 'Staking crypto)
-> StrictSeq StakePoolRelay
-> StrictMaybe PoolMetadata
-> PoolParams crypto
Ledger.PoolParams
      { _poolId :: KeyHash 'StakePool StandardCrypto
Ledger._poolId     = VKey 'StakePool StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall crypto (kd :: KeyRole).
Crypto crypto =>
VKey kd crypto -> KeyHash kd crypto
Ledger.hashKey VKey 'StakePool StandardCrypto
poolColdVK
      , _poolVrf :: Hash StandardCrypto (VerKeyVRF StandardCrypto)
Ledger._poolVrf    = VerKeyVRF OptimumVRF -> Hash Blake2b_256 (VerKeyVRF OptimumVRF)
forall v h.
(VRFAlgorithm v, HashAlgorithm h) =>
VerKeyVRF v -> Hash h (VerKeyVRF v)
Ledger.hashVerKeyVRF VerKeyVRF StandardCrypto
VerKeyVRF OptimumVRF
poolVrfVK
      , _poolPledge :: Coin
Ledger._poolPledge = Integer -> Coin
Ledger.Coin Integer
0
      , _poolCost :: Coin
Ledger._poolCost   = Integer -> Coin
Ledger.Coin Integer
0
      , _poolMargin :: UnitInterval
Ledger._poolMargin = UnitInterval
forall a. Bounded a => a
minBound
      , _poolRAcnt :: RewardAcnt StandardCrypto
Ledger._poolRAcnt  =
          StakeAddress -> RewardAcnt StandardCrypto
toSophieStakeAddr (StakeAddress -> RewardAcnt StandardCrypto)
-> StakeAddress -> RewardAcnt StandardCrypto
forall a b. (a -> b) -> a -> b
$ NetworkId -> StakeCredential -> StakeAddress
makeStakeAddress NetworkId
nw (StakeCredential -> StakeAddress)
-> StakeCredential -> StakeAddress
forall a b. (a -> b) -> a -> b
$ Hash StakeKey -> StakeCredential
StakeCredentialByKey (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey StakeKey
rewardsSVK)
      , _poolOwners :: Set (KeyHash 'Staking StandardCrypto)
Ledger._poolOwners = Set (KeyHash 'Staking StandardCrypto)
forall a. Monoid a => a
mempty
      , _poolRelays :: StrictSeq StakePoolRelay
Ledger._poolRelays = StrictSeq StakePoolRelay
forall a. StrictSeq a
Seq.empty
      , _poolMD :: StrictMaybe PoolMetadata
Ledger._poolMD     = StrictMaybe PoolMetadata
forall a. StrictMaybe a
Ledger.SNothing
      }
 where
   strIndex :: String
strIndex = Word -> String
forall a b. (Show a, ConvertText String b) => a -> b
show Word
index
   poolColdVKF :: String
poolColdVKF = String
dir String -> ShowS
</> String
"cold" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"
   poolVrfVKF :: String
poolVrfVKF = String
dir String -> ShowS
</> String
"vrf" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"
   poolRewardVKF :: String
poolRewardVKF = String
dir String -> ShowS
</> String
"staking-reward" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
strIndex String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".vkey"

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

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

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

    StakeVerificationKey stakeVK <- (FileError TextEnvelopeError -> SophieGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> SophieGenesisCmdError
SophieGenesisCmdTextEnvReadFileError
      (ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
 -> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey))
-> (IO
      (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
    -> ExceptT
         (FileError TextEnvelopeError) IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. IO
  (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey StakeKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT
      (IO
   (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
 -> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey))
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
-> ExceptT SophieGenesisCmdError IO (VerificationKey StakeKey)
forall a b. (a -> b) -> a -> b
$ AsType (VerificationKey StakeKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey StakeKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType StakeKey -> AsType (VerificationKey StakeKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType StakeKey
AsStakeKey) String
stakeVKF

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

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


readSophieGenesis
  :: FilePath
  -> (SophieGenesis StandardSophie -> SophieGenesis StandardSophie)
  -> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
readSophieGenesis :: String
-> (SophieGenesis StandardSophie -> SophieGenesis StandardSophie)
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
readSophieGenesis String
fpath SophieGenesis StandardSophie -> SophieGenesis StandardSophie
adjustDefaults = do
    ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
readAndDecode
      ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
-> (SophieGenesisCmdError
    -> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie))
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \SophieGenesisCmdError
err ->
        case SophieGenesisCmdError
err of
          SophieGenesisCmdGenesisFileError (FileIOError String
_ IOException
ioe)
            | IOException -> Bool
isDoesNotExistError IOException
ioe -> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
writeDefault
          SophieGenesisCmdError
_                           -> SophieGenesisCmdError
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left SophieGenesisCmdError
err
  where
    readAndDecode :: ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
readAndDecode = do
      ByteString
lbs <- (IOException -> SophieGenesisCmdError)
-> IO ByteString -> ExceptT SophieGenesisCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieGenesisCmdError
SophieGenesisCmdGenesisFileError (FileError () -> SophieGenesisCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO ByteString -> ExceptT SophieGenesisCmdError IO ByteString)
-> IO ByteString -> ExceptT SophieGenesisCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fpath
      (String -> SophieGenesisCmdError)
-> ExceptT String IO (SophieGenesis StandardSophie)
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> SophieGenesisCmdError
SophieGenesisCmdAesonDecodeError String
fpath (Text -> SophieGenesisCmdError)
-> (String -> Text) -> String -> SophieGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack)
        (ExceptT String IO (SophieGenesis StandardSophie)
 -> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie))
-> (Either String (SophieGenesis StandardSophie)
    -> ExceptT String IO (SophieGenesis StandardSophie))
-> Either String (SophieGenesis StandardSophie)
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either String (SophieGenesis StandardSophie)
-> ExceptT String IO (SophieGenesis StandardSophie)
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String (SophieGenesis StandardSophie)
 -> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie))
-> Either String (SophieGenesis StandardSophie)
-> ExceptT SophieGenesisCmdError IO (SophieGenesis StandardSophie)
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String (SophieGenesis StandardSophie)
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
lbs

    defaults :: SophieGenesis StandardSophie
    defaults :: SophieGenesis StandardSophie
defaults = SophieGenesis StandardSophie -> SophieGenesis StandardSophie
adjustDefaults SophieGenesis StandardSophie
forall crypto. SophieGenesis crypto
sophieGenesisDefaults

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


updateTemplate
    :: SystemStart
    -- Genesis delegation (not stake-based):
    -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
    -- Vested delegation (not stake-based):
    -> Map (Hash VestedKey)   (Hash VestedDelegateKey, Hash VrfKey)
    -- Non-delegated initial UTxO spec:
    -> Maybe Entropic
    -> [AddressInEra SophieEra]
    -- Genesis staking: pools/delegation map & delegated initial UTxO spec:
    -> Map (Ledger.KeyHash 'Ledger.Staking StandardCrypto) (Ledger.PoolParams StandardCrypto)
    -> Entropic
    -> [AddressInEra SophieEra]
    -> [AddressInEra SophieEra]
    -> SophieGenesis StandardSophie
    -- Aurum genesis parameters
    -> Entropic            -- ^ Bcc per UTxO word
    -> ExecutionUnitPrices -- ^ Execution prices (memory, steps)
    -> ExecutionUnits      -- ^ Max Tx execution units
    -> ExecutionUnits      -- ^ Max block execution units
    -> Natural             -- ^ Max value size
    -> Natural             -- ^ Collateral percentage
    -> Natural             -- ^ Max collateral inputs
    -> (SophieGenesis StandardSophie, Aurum.AurumGenesis)
updateTemplate :: SystemStart
-> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
-> Maybe Entropic
-> [AddressInEra SophieEra]
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Entropic
-> [AddressInEra SophieEra]
-> [AddressInEra SophieEra]
-> SophieGenesis StandardSophie
-> Entropic
-> ExecutionUnitPrices
-> ExecutionUnits
-> ExecutionUnits
-> Natural
-> Natural
-> Natural
-> (SophieGenesis StandardSophie, AurumGenesis)
updateTemplate (SystemStart UTCTime
start)
               Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
vestedDelegMap Maybe Entropic
mAmountNonDeleg [AddressInEra SophieEra]
utxoAddrsNonDeleg
               Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs (Entropic Integer
amountDeleg) [AddressInEra SophieEra]
utxoAddrsDeleg [AddressInEra SophieEra]
stuffedUtxoAddrs
               SophieGenesis StandardSophie
template Entropic
coinsPerUTxOWord ExecutionUnitPrices
prices ExecutionUnits
maxTxExUnits ExecutionUnits
maxBlockExUnits
               Natural
maxValueSize Natural
collateralPercentage Natural
maxCollateralInputs = do

    let sophieGenesis :: SophieGenesis StandardSophie
sophieGenesis = SophieGenesis StandardSophie
template
          { sgSystemStart :: UTCTime
sgSystemStart = UTCTime
start
          , sgMaxEntropicSupply :: Word64
sgMaxEntropicSupply = Integer -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Word64) -> Integer -> Word64
forall a b. (a -> b) -> a -> b
$ Integer
nonDelegCoin Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
delegCoin
          , sgGenDelegs :: Map
  (KeyHash 'Genesis (Crypto StandardSophie))
  (GenDelegPair (Crypto StandardSophie))
sgGenDelegs = Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
Map
  (KeyHash 'Genesis (Crypto StandardSophie))
  (GenDelegPair (Crypto StandardSophie))
sophieDelKeys
          , sgVestedDelegs :: Map
  (KeyHash 'Vested (Crypto StandardSophie))
  (VestedDelegPair (Crypto StandardSophie))
sgVestedDelegs = Map
  (KeyHash 'Vested StandardCrypto) (VestedDelegPair StandardCrypto)
Map
  (KeyHash 'Vested (Crypto StandardSophie))
  (VestedDelegPair (Crypto StandardSophie))
sophieVestedDelKeys
          , sgInitialFunds :: Map (Addr (Crypto StandardSophie)) Coin
sgInitialFunds = [(Addr StandardCrypto, Coin)] -> Map (Addr StandardCrypto) Coin
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                              [ (AddressInEra SophieEra -> Addr StandardCrypto
forall era. AddressInEra era -> Addr StandardCrypto
toSophieAddr AddressInEra SophieEra
addr, Entropic -> Coin
toSophieEntropic Entropic
v)
                              | (AddressInEra SophieEra
addr, Entropic
v) <-
                                Integer
-> [AddressInEra SophieEra] -> [(AddressInEra SophieEra, Entropic)]
distribute Integer
nonDelegCoin [AddressInEra SophieEra]
utxoAddrsNonDeleg [(AddressInEra SophieEra, Entropic)]
-> [(AddressInEra SophieEra, Entropic)]
-> [(AddressInEra SophieEra, Entropic)]
forall a. [a] -> [a] -> [a]
++
                                Integer
-> [AddressInEra SophieEra] -> [(AddressInEra SophieEra, Entropic)]
distribute Integer
delegCoin    [AddressInEra SophieEra]
utxoAddrsDeleg [(AddressInEra SophieEra, Entropic)]
-> [(AddressInEra SophieEra, Entropic)]
-> [(AddressInEra SophieEra, Entropic)]
forall a. [a] -> [a] -> [a]
++
                                [AddressInEra SophieEra] -> [(AddressInEra SophieEra, Entropic)]
mkStuffedUtxo [AddressInEra SophieEra]
stuffedUtxoAddrs ]
          , sgStaking :: SophieGenesisStaking (Crypto StandardSophie)
sgStaking =
            SophieGenesisStaking :: forall crypto.
Map (KeyHash 'StakePool crypto) (PoolParams crypto)
-> Map (KeyHash 'Staking crypto) (KeyHash 'StakePool crypto)
-> SophieGenesisStaking crypto
SophieGenesisStaking
              { sgsPools :: Map (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
sgsPools = [(KeyHash 'StakePool StandardCrypto, PoolParams StandardCrypto)]
-> Map
     (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
                            [ (PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Ledger._poolId PoolParams StandardCrypto
poolParams, PoolParams StandardCrypto
poolParams)
                            | PoolParams StandardCrypto
poolParams <- Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> [PoolParams StandardCrypto]
forall k a. Map k a -> [a]
Map.elems Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs ]
              , sgsStake :: Map
  (KeyHash 'Staking StandardCrypto)
  (KeyHash 'StakePool StandardCrypto)
sgsStake = PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto
forall crypto. PoolParams crypto -> KeyHash 'StakePool crypto
Ledger._poolId (PoolParams StandardCrypto -> KeyHash 'StakePool StandardCrypto)
-> Map
     (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
-> Map
     (KeyHash 'Staking StandardCrypto)
     (KeyHash 'StakePool StandardCrypto)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map (KeyHash 'Staking StandardCrypto) (PoolParams StandardCrypto)
poolSpecs
              }
          }
        cModel :: Map Language CostModel
cModel = case Map Text Integer -> CostModel
Aurum.CostModel (Map Text Integer -> CostModel)
-> Maybe (Map Text Integer) -> Maybe CostModel
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Map Text Integer)
defaultCostModelParams of
                   Just (Aurum.CostModel Map Text Integer
m) ->
                     if Map Text Integer -> Bool
Aurum.validateCostModelParams Map Text Integer
m
                     then Language -> CostModel -> Map Language CostModel
forall k a. k -> a -> Map k a
Map.singleton Language
Aurum.ZerepochV1 (Map Text Integer -> CostModel
Aurum.CostModel Map Text Integer
m)
                     else Text -> Map Language CostModel
forall a. HasCallStack => Text -> a
panic Text
"updateTemplate: defaultCostModel is invalid"

                   Maybe CostModel
Nothing -> Text -> Map Language CostModel
forall a. HasCallStack => Text -> a
panic Text
"updateTemplate: Could not extract cost model params from defaultCostModel"
        --TODO: we need a better validation story. We also ought to wrap the
        -- genesis type in the API properly.
        prices' :: Prices
prices' = case ExecutionUnitPrices -> Maybe Prices
toAurumPrices ExecutionUnitPrices
prices of
                    Maybe Prices
Nothing -> Text -> Prices
forall a. HasCallStack => Text -> a
panic Text
"updateTemplate: invalid prices"
                    Just Prices
p  -> Prices
p
        aurumGenesis :: AurumGenesis
aurumGenesis = AurumGenesis :: Coin
-> Map Language CostModel
-> Prices
-> ExUnits
-> ExUnits
-> Natural
-> Natural
-> Natural
-> AurumGenesis
Aurum.AurumGenesis
          { coinsPerUTxOWord :: Coin
Aurum.coinsPerUTxOWord     = Entropic -> Coin
toSophieEntropic Entropic
coinsPerUTxOWord
          , costmdls :: Map Language CostModel
Aurum.costmdls             = Map Language CostModel
cModel
          , prices :: Prices
Aurum.prices               = Prices
prices'
          , maxTxExUnits :: ExUnits
Aurum.maxTxExUnits         = ExecutionUnits -> ExUnits
toAurumExUnits ExecutionUnits
maxTxExUnits
          , maxBlockExUnits :: ExUnits
Aurum.maxBlockExUnits      = ExecutionUnits -> ExUnits
toAurumExUnits ExecutionUnits
maxBlockExUnits
          , maxValSize :: Natural
Aurum.maxValSize           = Natural
maxValueSize
          , collateralPercentage :: Natural
Aurum.collateralPercentage = Natural
collateralPercentage
          , maxCollateralInputs :: Natural
Aurum.maxCollateralInputs  = Natural
maxCollateralInputs
          }
    (SophieGenesis StandardSophie
sophieGenesis, AurumGenesis
aurumGenesis)
  where
    nonDelegCoin, delegCoin :: Integer
    nonDelegCoin :: Integer
nonDelegCoin = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Integer) -> Word64 -> Integer
forall a b. (a -> b) -> a -> b
$ Word64 -> Maybe Word64 -> Word64
forall a. a -> Maybe a -> a
fromMaybe (SophieGenesis StandardSophie -> Word64
forall era. SophieGenesis era -> Word64
sgMaxEntropicSupply SophieGenesis StandardSophie
template) (Entropic -> Word64
forall a. Integral a => Entropic -> a
unEntropic (Entropic -> Word64) -> Maybe Entropic -> Maybe Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Entropic
mAmountNonDeleg)
    delegCoin :: Integer
delegCoin = Integer -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
amountDeleg

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

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

    mkStuffedUtxo :: [AddressInEra SophieEra] -> [(AddressInEra SophieEra, Entropic)]
    mkStuffedUtxo :: [AddressInEra SophieEra] -> [(AddressInEra SophieEra, Entropic)]
mkStuffedUtxo [AddressInEra SophieEra]
xs = (, Integer -> Entropic
Entropic Integer
minUtxoVal) (AddressInEra SophieEra -> (AddressInEra SophieEra, Entropic))
-> [AddressInEra SophieEra] -> [(AddressInEra SophieEra, Entropic)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AddressInEra SophieEra]
xs
      where (Coin Integer
minUtxoVal) = PParams' Identity StandardSophie -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
Sophie._minUTxOValue (PParams' Identity StandardSophie -> HKD Identity Coin)
-> PParams' Identity StandardSophie -> HKD Identity Coin
forall a b. (a -> b) -> a -> b
$ SophieGenesis StandardSophie -> PParams' Identity StandardSophie
forall era. SophieGenesis era -> PParams era
sgProtocolParams SophieGenesis StandardSophie
template

    sophieDelKeys :: Map (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
sophieDelKeys =
      [(KeyHash 'Genesis StandardCrypto, GenDelegPair StandardCrypto)]
-> Map
     (KeyHash 'Genesis StandardCrypto) (GenDelegPair StandardCrypto)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (KeyHash 'Genesis StandardCrypto
gh, KeyHash 'GenesisDelegate StandardCrypto
-> Hash StandardCrypto (VerKeyVRF StandardCrypto)
-> GenDelegPair StandardCrypto
forall crypto.
KeyHash 'GenesisDelegate crypto
-> Hash crypto (VerKeyVRF crypto) -> GenDelegPair crypto
Ledger.GenDelegPair KeyHash 'GenesisDelegate StandardCrypto
gdh Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
        | (GenesisKeyHash gh,
           (GenesisDelegateKeyHash gdh, VrfKeyHash h)) <- Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
-> [(Hash GenesisKey, (Hash GenesisDelegateKey, Hash VrfKey))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey)
genDelegMap
        ]
    sophieVestedDelKeys :: Map
  (KeyHash 'Vested StandardCrypto) (VestedDelegPair StandardCrypto)
sophieVestedDelKeys =
      [(KeyHash 'Vested StandardCrypto, VestedDelegPair StandardCrypto)]
-> Map
     (KeyHash 'Vested StandardCrypto) (VestedDelegPair StandardCrypto)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (KeyHash 'Vested StandardCrypto
ah, KeyHash 'VestedDelegate StandardCrypto
-> Hash StandardCrypto (VerKeyVRF StandardCrypto)
-> VestedDelegPair StandardCrypto
forall crypto.
KeyHash 'VestedDelegate crypto
-> Hash crypto (VerKeyVRF crypto) -> VestedDelegPair crypto
Ledger.VestedDelegPair KeyHash 'VestedDelegate StandardCrypto
adh Hash StandardCrypto (VerKeyVRF StandardCrypto)
h)
        | (VestedKeyHash ah,
           (VestedDelegateKeyHash adh, VrfKeyHash h)) <- Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
-> [(Hash VestedKey, (Hash VestedDelegateKey, Hash VrfKey))]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
vestedDelegMap
        ]

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

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

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

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

    let combinedMap :: Map Int (VerificationKey GenesisKey,
                                (VerificationKey GenesisDelegateKey,
                                 VerificationKey VrfKey))
        combinedMap :: Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap =
          (VerificationKey GenesisKey
 -> (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
 -> (VerificationKey GenesisKey,
     (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)))
-> Map Int (VerificationKey GenesisKey)
-> Map
     Int (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,)
            Map Int (VerificationKey GenesisKey)
gkm
            ((VerificationKey GenesisDelegateKey
 -> VerificationKey VrfKey
 -> (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisDelegateKey)
-> Map Int (VerificationKey VrfKey)
-> Map
     Int (VerificationKey GenesisDelegateKey, VerificationKey VrfKey)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,)
               Map Int (VerificationKey GenesisDelegateKey)
dkm Map Int (VerificationKey VrfKey)
vkm)

    -- All the maps should have an identical set of keys. Complain if not.
    let gkmExtra :: Map Int (VerificationKey GenesisKey)
gkmExtra = Map Int (VerificationKey GenesisKey)
gkm Map Int (VerificationKey GenesisKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
        dkmExtra :: Map Int (VerificationKey GenesisDelegateKey)
dkmExtra = Map Int (VerificationKey GenesisDelegateKey)
dkm Map Int (VerificationKey GenesisDelegateKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey GenesisDelegateKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
        vkmExtra :: Map Int (VerificationKey VrfKey)
vkmExtra = Map Int (VerificationKey VrfKey)
vkm Map Int (VerificationKey VrfKey)
-> Map
     Int
     (VerificationKey GenesisKey,
      (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey VrfKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey GenesisKey,
   (VerificationKey GenesisDelegateKey, VerificationKey VrfKey))
combinedMap
    Bool
-> ExceptT SophieGenesisCmdError IO ()
-> ExceptT SophieGenesisCmdError 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 SophieGenesisCmdError IO ()
 -> ExceptT SophieGenesisCmdError IO ())
-> ExceptT SophieGenesisCmdError IO ()
-> ExceptT SophieGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      SophieGenesisCmdError -> ExceptT SophieGenesisCmdError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SophieGenesisCmdError -> ExceptT SophieGenesisCmdError IO ())
-> SophieGenesisCmdError -> ExceptT SophieGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int] -> SophieGenesisCmdError
SophieGenesisCmdMismatchedGenesisKeyFiles
                     (Map Int (VerificationKey GenesisKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisKey)
gkm) (Map Int (VerificationKey GenesisDelegateKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey GenesisDelegateKey)
dkm) (Map Int (VerificationKey VrfKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey VrfKey)
vkm)

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

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


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

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

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

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

readVestedDelegsMap :: FilePath -> FilePath
                 -> ExceptT SophieGenesisCmdError IO
                            (Map (Hash VestedKey)
                                 (Hash VestedDelegateKey, Hash VrfKey))
readVestedDelegsMap :: String
-> String
-> ExceptT
     SophieGenesisCmdError
     IO
     (Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey))
readVestedDelegsMap String
vesteddir String
vesteddeldir = do
    Map Int (VerificationKey VestedKey)
akm <- String
-> ExceptT
     SophieGenesisCmdError IO (Map Int (VerificationKey VestedKey))
readVestedKeys String
vesteddir
    Map Int (VerificationKey VestedDelegateKey)
dkm <- String
-> ExceptT
     SophieGenesisCmdError
     IO
     (Map Int (VerificationKey VestedDelegateKey))
readVestedDelegateKeys String
vesteddeldir
    Map Int (VerificationKey VrfKey)
vkm <- String
-> ExceptT
     SophieGenesisCmdError IO (Map Int (VerificationKey VrfKey))
readVestedDelegateVrfKeys String
vesteddeldir

    let combinedMap :: Map Int (VerificationKey VestedKey,
                                (VerificationKey VestedDelegateKey,
                                 VerificationKey VrfKey))
        combinedMap :: Map
  Int
  (VerificationKey VestedKey,
   (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
combinedMap =
          (VerificationKey VestedKey
 -> (VerificationKey VestedDelegateKey, VerificationKey VrfKey)
 -> (VerificationKey VestedKey,
     (VerificationKey VestedDelegateKey, VerificationKey VrfKey)))
-> Map Int (VerificationKey VestedKey)
-> Map
     Int (VerificationKey VestedDelegateKey, VerificationKey VrfKey)
-> Map
     Int
     (VerificationKey VestedKey,
      (VerificationKey VestedDelegateKey, 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 VestedKey)
akm
            ((VerificationKey VestedDelegateKey
 -> VerificationKey VrfKey
 -> (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey VestedDelegateKey)
-> Map Int (VerificationKey VrfKey)
-> Map
     Int (VerificationKey VestedDelegateKey, 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 VestedDelegateKey)
dkm Map Int (VerificationKey VrfKey)
vkm)

    -- All the maps should have an identical set of keys. Complain if not.
    let akmExtra :: Map Int (VerificationKey VestedKey)
akmExtra = Map Int (VerificationKey VestedKey)
akm Map Int (VerificationKey VestedKey)
-> Map
     Int
     (VerificationKey VestedKey,
      (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey VestedKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey VestedKey,
   (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
combinedMap
        dkmExtra :: Map Int (VerificationKey VestedDelegateKey)
dkmExtra = Map Int (VerificationKey VestedDelegateKey)
dkm Map Int (VerificationKey VestedDelegateKey)
-> Map
     Int
     (VerificationKey VestedKey,
      (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
-> Map Int (VerificationKey VestedDelegateKey)
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.\\ Map
  Int
  (VerificationKey VestedKey,
   (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
combinedMap
        vkmExtra :: Map Int (VerificationKey VrfKey)
vkmExtra = Map Int (VerificationKey VrfKey)
vkm Map Int (VerificationKey VrfKey)
-> Map
     Int
     (VerificationKey VestedKey,
      (VerificationKey VestedDelegateKey, 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 VestedKey,
   (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
combinedMap
    Bool
-> ExceptT SophieGenesisCmdError IO ()
-> ExceptT SophieGenesisCmdError IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Map Int (VerificationKey VestedKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey VestedKey)
akmExtra Bool -> Bool -> Bool
&& Map Int (VerificationKey VestedDelegateKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey VestedDelegateKey)
dkmExtra Bool -> Bool -> Bool
&& Map Int (VerificationKey VrfKey) -> Bool
forall k a. Map k a -> Bool
Map.null Map Int (VerificationKey VrfKey)
vkmExtra) (ExceptT SophieGenesisCmdError IO ()
 -> ExceptT SophieGenesisCmdError IO ())
-> ExceptT SophieGenesisCmdError IO ()
-> ExceptT SophieGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$
      SophieGenesisCmdError -> ExceptT SophieGenesisCmdError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SophieGenesisCmdError -> ExceptT SophieGenesisCmdError IO ())
-> SophieGenesisCmdError -> ExceptT SophieGenesisCmdError IO ()
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int] -> [Int] -> SophieGenesisCmdError
SophieGenesisCmdMismatchedVestedKeyFiles
                     (Map Int (VerificationKey VestedKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey VestedKey)
akm) (Map Int (VerificationKey VestedDelegateKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey VestedDelegateKey)
dkm) (Map Int (VerificationKey VrfKey) -> [Int]
forall k a. Map k a -> [k]
Map.keys Map Int (VerificationKey VrfKey)
vkm)

    let vestedDelegsMap :: Map (Hash VestedKey)
                         (Hash VestedDelegateKey, Hash VrfKey)
        vestedDelegsMap :: Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
vestedDelegsMap =
          [(Hash VestedKey, (Hash VestedDelegateKey, Hash VrfKey))]
-> Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [ (Hash VestedKey
ah, (Hash VestedDelegateKey
dh, Hash VrfKey
vh))
                       | (VerificationKey VestedKey
a,(VerificationKey VestedDelegateKey
d,VerificationKey VrfKey
v)) <- Map
  Int
  (VerificationKey VestedKey,
   (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
-> [(VerificationKey VestedKey,
     (VerificationKey VestedDelegateKey, VerificationKey VrfKey))]
forall k a. Map k a -> [a]
Map.elems Map
  Int
  (VerificationKey VestedKey,
   (VerificationKey VestedDelegateKey, VerificationKey VrfKey))
combinedMap
                       , let ah :: Hash VestedKey
ah = VerificationKey VestedKey -> Hash VestedKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VestedKey
a
                             dh :: Hash VestedDelegateKey
dh = VerificationKey VestedDelegateKey -> Hash VestedDelegateKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VestedDelegateKey
d
                             vh :: Hash VrfKey
vh = VerificationKey VrfKey -> Hash VrfKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey VrfKey
v
                       ]

    Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
-> ExceptT
     SophieGenesisCmdError
     IO
     (Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Map (Hash VestedKey) (Hash VestedDelegateKey, Hash VrfKey)
vestedDelegsMap


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

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

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


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

extractFileNameIndexes :: [FilePath]
                       -> ExceptT SophieGenesisCmdError IO [(FilePath, Int)]
extractFileNameIndexes :: [String] -> ExceptT SophieGenesisCmdError IO [(String, Int)]
extractFileNameIndexes [String]
files = do
    case [ String
file | (String
file, Maybe Int
Nothing) <- [(String, Maybe Int)]
filesIxs ] of
      []     -> () -> ExceptT SophieGenesisCmdError IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      [String]
files' -> SophieGenesisCmdError -> ExceptT SophieGenesisCmdError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([String] -> SophieGenesisCmdError
SophieGenesisCmdFilesNoIndex [String]
files')
    case ([(String, Int)] -> Bool) -> [[(String, Int)]] -> [[(String, Int)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (\[(String, Int)]
g -> [(String, Int)] -> Int
forall a. HasLength a => a -> Int
length [(String, Int)]
g Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1)
       ([[(String, Int)]] -> [[(String, Int)]])
-> ([(String, Int)] -> [[(String, Int)]])
-> [(String, Int)]
-> [[(String, Int)]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((String, Int) -> (String, Int) -> Bool)
-> [(String, Int)] -> [[(String, Int)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Int -> Int -> Bool)
-> ((String, Int) -> Int) -> (String, Int) -> (String, Int) -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String, Int) -> Int
forall a b. (a, b) -> b
snd)
       ([(String, Int)] -> [[(String, Int)]])
-> ([(String, Int)] -> [(String, Int)])
-> [(String, Int)]
-> [[(String, Int)]]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((String, Int) -> (String, Int) -> Ordering)
-> [(String, Int)] -> [(String, Int)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int -> Int -> Ordering)
-> ((String, Int) -> Int)
-> (String, Int)
-> (String, Int)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String, Int) -> Int
forall a b. (a, b) -> b
snd)
       ([(String, Int)] -> [[(String, Int)]])
-> [(String, Int)] -> [[(String, Int)]]
forall a b. (a -> b) -> a -> b
$ [ (String
file, Int
ix) | (String
file, Just Int
ix) <- [(String, Maybe Int)]
filesIxs ] of
      [] -> () -> ExceptT SophieGenesisCmdError IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      ([(String, Int)]
g:[[(String, Int)]]
_) -> SophieGenesisCmdError -> ExceptT SophieGenesisCmdError IO ()
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ([String] -> SophieGenesisCmdError
SophieGenesisCmdFilesDupIndex (((String, Int) -> String) -> [(String, Int)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (String, Int) -> String
forall a b. (a, b) -> a
fst [(String, Int)]
g))

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

readInitialFundAddresses :: FilePath -> NetworkId
                         -> ExceptT SophieGenesisCmdError IO [AddressInEra SophieEra]
readInitialFundAddresses :: String
-> NetworkId
-> ExceptT SophieGenesisCmdError IO [AddressInEra SophieEra]
readInitialFundAddresses String
utxodir NetworkId
nw = do
    [String]
files <- IO [String] -> ExceptT SophieGenesisCmdError IO [String]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO [String]
listDirectory String
utxodir)
    [VerificationKey GenesisUTxOKey]
vkeys <- (FileError TextEnvelopeError -> SophieGenesisCmdError)
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT
     SophieGenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT FileError TextEnvelopeError -> SophieGenesisCmdError
SophieGenesisCmdTextEnvReadFileError (ExceptT
   (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
 -> ExceptT
      SophieGenesisCmdError IO [VerificationKey GenesisUTxOKey])
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
-> ExceptT
     SophieGenesisCmdError IO [VerificationKey GenesisUTxOKey]
forall a b. (a -> b) -> a -> b
$
               [ExceptT
   (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)]
-> ExceptT
     (FileError TextEnvelopeError) IO [VerificationKey GenesisUTxOKey]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence
                 [ IO
  (Either
     (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall (m :: * -> *) x a. m (Either x a) -> ExceptT x m a
newExceptT (IO
   (Either
      (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
 -> ExceptT
      (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey))
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
-> ExceptT
     (FileError TextEnvelopeError) IO (VerificationKey GenesisUTxOKey)
forall a b. (a -> b) -> a -> b
$
                     AsType (VerificationKey GenesisUTxOKey)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey GenesisUTxOKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType GenesisUTxOKey -> AsType (VerificationKey GenesisUTxOKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType GenesisUTxOKey
AsGenesisUTxOKey)
                                          (String
utxodir String -> ShowS
</> String
file)
                 | String
file <- [String]
files
                 , ShowS
takeExtension String
file String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".vkey" ]
    [AddressInEra SophieEra]
-> ExceptT SophieGenesisCmdError IO [AddressInEra SophieEra]
forall (m :: * -> *) a. Monad m => a -> m a
return [ AddressInEra SophieEra
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 SophieEra
addr = NetworkId
-> PaymentCredential
-> StakeAddressReference
-> AddressInEra SophieEra
forall era.
IsSophieBasedEra era =>
NetworkId
-> PaymentCredential -> StakeAddressReference -> AddressInEra era
makeSophieAddressInEra NetworkId
nw (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey Hash PaymentKey
vkh)
                                                StakeAddressReference
NoStakeAddress
           ]


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

--
-- Aurum genesis
--


aurumGenesisDefaultEntropicPerUtxoWord :: Entropic
aurumGenesisDefaultEntropicPerUtxoWord :: Entropic
aurumGenesisDefaultEntropicPerUtxoWord = Integer -> Entropic
Entropic Integer
1

aurumGenesisDefaultExecutionPrices :: ExecutionUnitPrices
aurumGenesisDefaultExecutionPrices :: ExecutionUnitPrices
aurumGenesisDefaultExecutionPrices =
    ExecutionUnitPrices :: Rational -> Rational -> ExecutionUnitPrices
ExecutionUnitPrices {
       priceExecutionSteps :: Rational
priceExecutionSteps  = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10,
       priceExecutionMemory :: Rational
priceExecutionMemory = Integer
1 Integer -> Integer -> Rational
forall a. Integral a => a -> a -> Ratio a
% Integer
10
    }

aurumGenesisDefaultMaxTxExecutionUnits :: ExecutionUnits
aurumGenesisDefaultMaxTxExecutionUnits :: ExecutionUnits
aurumGenesisDefaultMaxTxExecutionUnits =
    ExecutionUnits :: Word64 -> Word64 -> ExecutionUnits
ExecutionUnits {
      executionSteps :: Word64
executionSteps  = Word64
500_000_000_000,
      executionMemory :: Word64
executionMemory = Word64
500_000_000_000
    }

aurumGenesisDefaultMaxBlockExecutionUnits :: ExecutionUnits
aurumGenesisDefaultMaxBlockExecutionUnits :: ExecutionUnits
aurumGenesisDefaultMaxBlockExecutionUnits =
    ExecutionUnits :: Word64 -> Word64 -> ExecutionUnits
ExecutionUnits {
      executionSteps :: Word64
executionSteps  = Word64
500_000_000_000,
      executionMemory :: Word64
executionMemory = Word64
500_000_000_000
    }

aurumGenesisDefaultMaxValueSize :: Natural
aurumGenesisDefaultMaxValueSize :: Natural
aurumGenesisDefaultMaxValueSize = Natural
4000

aurumGenesisDefaultCollateralPercent :: Natural
aurumGenesisDefaultCollateralPercent :: Natural
aurumGenesisDefaultCollateralPercent = Natural
1 --TODO change to 100%

aurumGenesisDefaultMaxCollateralInputs :: Natural
aurumGenesisDefaultMaxCollateralInputs :: Natural
aurumGenesisDefaultMaxCollateralInputs = Natural
5


readAurumGenesis
  :: FilePath
  -> ExceptT SophieGenesisCmdError IO Aurum.AurumGenesis
readAurumGenesis :: String -> ExceptT SophieGenesisCmdError IO AurumGenesis
readAurumGenesis String
fpath = do
  ExceptT SophieGenesisCmdError IO AurumGenesis
readAndDecode
    ExceptT SophieGenesisCmdError IO AurumGenesis
-> (SophieGenesisCmdError
    -> ExceptT SophieGenesisCmdError IO AurumGenesis)
-> ExceptT SophieGenesisCmdError IO AurumGenesis
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
`catchError` \SophieGenesisCmdError
err ->
      case SophieGenesisCmdError
err of
        SophieGenesisCmdGenesisFileError (FileIOError String
_ IOException
ioe)
          | IOException -> Bool
isDoesNotExistError IOException
ioe -> Text -> ExceptT SophieGenesisCmdError IO AurumGenesis
forall a. HasCallStack => Text -> a
panic Text
"Sophie genesis file not found."
        SophieGenesisCmdError
_                           -> SophieGenesisCmdError
-> ExceptT SophieGenesisCmdError IO AurumGenesis
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left SophieGenesisCmdError
err

 where
  readAndDecode :: ExceptT SophieGenesisCmdError IO Aurum.AurumGenesis
  readAndDecode :: ExceptT SophieGenesisCmdError IO AurumGenesis
readAndDecode = do
      ByteString
lbs <- (IOException -> SophieGenesisCmdError)
-> IO ByteString -> ExceptT SophieGenesisCmdError IO ByteString
forall (m :: * -> *) x a.
MonadIO m =>
(IOException -> x) -> IO a -> ExceptT x m a
handleIOExceptT (FileError () -> SophieGenesisCmdError
SophieGenesisCmdGenesisFileError (FileError () -> SophieGenesisCmdError)
-> (IOException -> FileError ())
-> IOException
-> SophieGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IOException -> FileError ()
forall e. String -> IOException -> FileError e
FileIOError String
fpath) (IO ByteString -> ExceptT SophieGenesisCmdError IO ByteString)
-> IO ByteString -> ExceptT SophieGenesisCmdError IO ByteString
forall a b. (a -> b) -> a -> b
$ String -> IO ByteString
LBS.readFile String
fpath
      (String -> SophieGenesisCmdError)
-> ExceptT String IO AurumGenesis
-> ExceptT SophieGenesisCmdError IO AurumGenesis
forall (m :: * -> *) x y a.
Functor m =>
(x -> y) -> ExceptT x m a -> ExceptT y m a
firstExceptT (String -> Text -> SophieGenesisCmdError
SophieGenesisCmdAesonDecodeError String
fpath (Text -> SophieGenesisCmdError)
-> (String -> Text) -> String -> SophieGenesisCmdError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> Text
Text.pack)
        (ExceptT String IO AurumGenesis
 -> ExceptT SophieGenesisCmdError IO AurumGenesis)
-> (Either String AurumGenesis -> ExceptT String IO AurumGenesis)
-> Either String AurumGenesis
-> ExceptT SophieGenesisCmdError IO AurumGenesis
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either String AurumGenesis -> ExceptT String IO AurumGenesis
forall (m :: * -> *) x a. Monad m => Either x a -> ExceptT x m a
hoistEither (Either String AurumGenesis
 -> ExceptT SophieGenesisCmdError IO AurumGenesis)
-> Either String AurumGenesis
-> ExceptT SophieGenesisCmdError IO AurumGenesis
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String AurumGenesis
forall a. FromJSON a => ByteString -> Either String a
Aeson.eitherDecode' ByteString
lbs