{-# LANGUAGE GeneralisedNewtypeDeriving #-}
module Cardano.CLI.Byron.Genesis
( ByronGenesisError(..)
, GenesisParameters(..)
, NewDirectory(..)
, dumpGenesis
, mkGenesis
, readGenesis
, renderByronGenesisError
)
where
import Cardano.Prelude hiding (option, show, trace)
import Prelude (String)
import Control.Monad.Trans.Except.Extra (firstExceptT, left, right)
import qualified Data.ByteString.Lazy as LB
import qualified Data.Map.Strict as Map
import Data.Text.Lazy.Builder (toLazyText)
import Data.Time (UTCTime)
import Formatting.Buildable
import System.Directory (createDirectory, doesPathExist)
import Cardano.Api (Key (..), NetworkId, writeSecrets)
import Cardano.Api.Byron (ByronKey, SerialiseAsRawBytes (..), SigningKey (..),
toByronRequiresNetworkMagic)
import qualified Cardano.Chain.Common as Common
import Cardano.Chain.Delegation hiding (Map, epoch)
import Cardano.Chain.Genesis (GeneratedSecrets (..))
import qualified Cardano.Chain.Genesis as Genesis
import qualified Cardano.Chain.UTxO as UTxO
import qualified Cardano.Crypto as Crypto
import Cardano.CLI.Byron.Delegation
import Cardano.CLI.Byron.Key
import Cardano.CLI.Helpers (textShow)
import Cardano.CLI.Types (GenesisFile (..))
data ByronGenesisError
= ByronDelegationCertSerializationError !ByronDelegationError
| ByronDelegationKeySerializationError ByronDelegationError
| GenesisGenerationError !Genesis.GenesisDataGenerationError
| GenesisOutputDirAlreadyExists FilePath
| GenesisReadError !FilePath !Genesis.GenesisDataError
| GenesisSpecError !Text
| MakeGenesisDelegationError !Genesis.GenesisDelegationError
| NoGenesisDelegationForKey !Text
| ProtocolParametersParseFailed !FilePath !Text
| PoorKeyFailure !ByronKeyFailure
deriving Int -> ByronGenesisError -> ShowS
[ByronGenesisError] -> ShowS
ByronGenesisError -> String
(Int -> ByronGenesisError -> ShowS)
-> (ByronGenesisError -> String)
-> ([ByronGenesisError] -> ShowS)
-> Show ByronGenesisError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByronGenesisError] -> ShowS
$cshowList :: [ByronGenesisError] -> ShowS
show :: ByronGenesisError -> String
$cshow :: ByronGenesisError -> String
showsPrec :: Int -> ByronGenesisError -> ShowS
$cshowsPrec :: Int -> ByronGenesisError -> ShowS
Show
renderByronGenesisError :: ByronGenesisError -> Text
renderByronGenesisError :: ByronGenesisError -> Text
renderByronGenesisError ByronGenesisError
err =
case ByronGenesisError
err of
ProtocolParametersParseFailed String
pParamFp Text
parseError ->
Text
"Protocol parameters parse failed at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
pParamFp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
parseError
ByronDelegationCertSerializationError ByronDelegationError
bDelegSerErr ->
Text
"Error while serializing the delegation certificate: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByronDelegationError -> Text
forall a. Show a => a -> Text
textShow ByronDelegationError
bDelegSerErr
ByronDelegationKeySerializationError ByronDelegationError
bKeySerErr ->
Text
"Error while serializing the delegation key: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByronDelegationError -> Text
forall a. Show a => a -> Text
textShow ByronDelegationError
bKeySerErr
PoorKeyFailure ByronKeyFailure
bKeyFailure ->
Text
"Error creating poor keys: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByronKeyFailure -> Text
forall a. Show a => a -> Text
textShow ByronKeyFailure
bKeyFailure
MakeGenesisDelegationError GenesisDelegationError
genDelegError ->
Text
"Error creating genesis delegation: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GenesisDelegationError -> Text
forall a. Show a => a -> Text
textShow GenesisDelegationError
genDelegError
GenesisGenerationError GenesisDataGenerationError
genDataGenError ->
Text
"Error generating genesis: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GenesisDataGenerationError -> Text
forall a. Show a => a -> Text
textShow GenesisDataGenerationError
genDataGenError
GenesisOutputDirAlreadyExists String
genOutDir ->
Text
"Genesis output directory already exists: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
genOutDir
GenesisReadError String
genFp GenesisDataError
genDataError ->
Text
"Error while reading genesis file at: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a. Show a => a -> Text
textShow String
genFp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" Error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> GenesisDataError -> Text
forall a. Show a => a -> Text
textShow GenesisDataError
genDataError
GenesisSpecError Text
genSpecError ->
Text
"Error while creating genesis spec" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
textShow Text
genSpecError
NoGenesisDelegationForKey Text
verKey ->
Text
"Error while creating genesis, no delegation certificate for this verification key:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
textShow Text
verKey
newtype NewDirectory =
NewDirectory FilePath
deriving (NewDirectory -> NewDirectory -> Bool
(NewDirectory -> NewDirectory -> Bool)
-> (NewDirectory -> NewDirectory -> Bool) -> Eq NewDirectory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewDirectory -> NewDirectory -> Bool
$c/= :: NewDirectory -> NewDirectory -> Bool
== :: NewDirectory -> NewDirectory -> Bool
$c== :: NewDirectory -> NewDirectory -> Bool
Eq, Eq NewDirectory
Eq NewDirectory
-> (NewDirectory -> NewDirectory -> Ordering)
-> (NewDirectory -> NewDirectory -> Bool)
-> (NewDirectory -> NewDirectory -> Bool)
-> (NewDirectory -> NewDirectory -> Bool)
-> (NewDirectory -> NewDirectory -> Bool)
-> (NewDirectory -> NewDirectory -> NewDirectory)
-> (NewDirectory -> NewDirectory -> NewDirectory)
-> Ord NewDirectory
NewDirectory -> NewDirectory -> Bool
NewDirectory -> NewDirectory -> Ordering
NewDirectory -> NewDirectory -> NewDirectory
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NewDirectory -> NewDirectory -> NewDirectory
$cmin :: NewDirectory -> NewDirectory -> NewDirectory
max :: NewDirectory -> NewDirectory -> NewDirectory
$cmax :: NewDirectory -> NewDirectory -> NewDirectory
>= :: NewDirectory -> NewDirectory -> Bool
$c>= :: NewDirectory -> NewDirectory -> Bool
> :: NewDirectory -> NewDirectory -> Bool
$c> :: NewDirectory -> NewDirectory -> Bool
<= :: NewDirectory -> NewDirectory -> Bool
$c<= :: NewDirectory -> NewDirectory -> Bool
< :: NewDirectory -> NewDirectory -> Bool
$c< :: NewDirectory -> NewDirectory -> Bool
compare :: NewDirectory -> NewDirectory -> Ordering
$ccompare :: NewDirectory -> NewDirectory -> Ordering
$cp1Ord :: Eq NewDirectory
Ord, Int -> NewDirectory -> ShowS
[NewDirectory] -> ShowS
NewDirectory -> String
(Int -> NewDirectory -> ShowS)
-> (NewDirectory -> String)
-> ([NewDirectory] -> ShowS)
-> Show NewDirectory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewDirectory] -> ShowS
$cshowList :: [NewDirectory] -> ShowS
show :: NewDirectory -> String
$cshow :: NewDirectory -> String
showsPrec :: Int -> NewDirectory -> ShowS
$cshowsPrec :: Int -> NewDirectory -> ShowS
Show, String -> NewDirectory
(String -> NewDirectory) -> IsString NewDirectory
forall a. (String -> a) -> IsString a
fromString :: String -> NewDirectory
$cfromString :: String -> NewDirectory
IsString)
data GenesisParameters = GenesisParameters
{ GenesisParameters -> UTCTime
gpStartTime :: !UTCTime
, GenesisParameters -> String
gpProtocolParamsFile :: !FilePath
, GenesisParameters -> BlockCount
gpK :: !Common.BlockCount
, GenesisParameters -> ProtocolMagic
gpProtocolMagic :: !Crypto.ProtocolMagic
, GenesisParameters -> TestnetBalanceOptions
gpTestnetBalance :: !Genesis.TestnetBalanceOptions
, GenesisParameters -> FakeAvvmOptions
gpFakeAvvmOptions :: !Genesis.FakeAvvmOptions
, GenesisParameters -> LovelacePortion
gpAvvmBalanceFactor :: !Common.LovelacePortion
, GenesisParameters -> Maybe Integer
gpSeed :: !(Maybe Integer)
} deriving Int -> GenesisParameters -> ShowS
[GenesisParameters] -> ShowS
GenesisParameters -> String
(Int -> GenesisParameters -> ShowS)
-> (GenesisParameters -> String)
-> ([GenesisParameters] -> ShowS)
-> Show GenesisParameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GenesisParameters] -> ShowS
$cshowList :: [GenesisParameters] -> ShowS
show :: GenesisParameters -> String
$cshow :: GenesisParameters -> String
showsPrec :: Int -> GenesisParameters -> ShowS
$cshowsPrec :: Int -> GenesisParameters -> ShowS
Show
mkGenesisSpec :: GenesisParameters -> ExceptT ByronGenesisError IO Genesis.GenesisSpec
mkGenesisSpec :: GenesisParameters -> ExceptT ByronGenesisError IO GenesisSpec
mkGenesisSpec GenesisParameters
gp = do
ByteString
protoParamsRaw <- IO ByteString -> ExceptT ByronGenesisError IO ByteString
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ByteString -> ExceptT ByronGenesisError IO ByteString)
-> (String -> IO ByteString)
-> String
-> ExceptT ByronGenesisError IO ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> IO ByteString
LB.readFile (String -> ExceptT ByronGenesisError IO ByteString)
-> String -> ExceptT ByronGenesisError IO ByteString
forall a b. (a -> b) -> a -> b
$ GenesisParameters -> String
gpProtocolParamsFile GenesisParameters
gp
ProtocolParameters
protocolParameters <- (Text -> ByronGenesisError)
-> ExceptT Text IO ProtocolParameters
-> ExceptT ByronGenesisError IO ProtocolParameters
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT
(String -> Text -> ByronGenesisError
ProtocolParametersParseFailed (GenesisParameters -> String
gpProtocolParamsFile GenesisParameters
gp)) (ExceptT Text IO ProtocolParameters
-> ExceptT ByronGenesisError IO ProtocolParameters)
-> ExceptT Text IO ProtocolParameters
-> ExceptT ByronGenesisError IO ProtocolParameters
forall a b. (a -> b) -> a -> b
$
IO (Either Text ProtocolParameters)
-> ExceptT Text IO ProtocolParameters
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Text ProtocolParameters)
-> ExceptT Text IO ProtocolParameters)
-> (Either Text ProtocolParameters
-> IO (Either Text ProtocolParameters))
-> Either Text ProtocolParameters
-> ExceptT Text IO ProtocolParameters
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Text ProtocolParameters
-> IO (Either Text ProtocolParameters)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text ProtocolParameters
-> ExceptT Text IO ProtocolParameters)
-> Either Text ProtocolParameters
-> ExceptT Text IO ProtocolParameters
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text ProtocolParameters
forall a.
FromJSON (Either SchemaError) a =>
ByteString -> Either Text a
canonicalDecodePretty ByteString
protoParamsRaw
GenesisDelegation
genesisDelegation <- (GenesisDelegationError -> ByronGenesisError)
-> ExceptT GenesisDelegationError IO GenesisDelegation
-> ExceptT ByronGenesisError IO GenesisDelegation
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT GenesisDelegationError -> ByronGenesisError
MakeGenesisDelegationError (ExceptT GenesisDelegationError IO GenesisDelegation
-> ExceptT ByronGenesisError IO GenesisDelegation)
-> ExceptT GenesisDelegationError IO GenesisDelegation
-> ExceptT ByronGenesisError IO GenesisDelegation
forall a b. (a -> b) -> a -> b
$
[Certificate]
-> ExceptT GenesisDelegationError IO GenesisDelegation
forall (m :: * -> *).
MonadError GenesisDelegationError m =>
[Certificate] -> m GenesisDelegation
Genesis.mkGenesisDelegation []
(Text -> ByronGenesisError)
-> ExceptT Text IO GenesisSpec
-> ExceptT ByronGenesisError IO GenesisSpec
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT Text -> ByronGenesisError
GenesisSpecError (ExceptT Text IO GenesisSpec
-> ExceptT ByronGenesisError IO GenesisSpec)
-> ExceptT Text IO GenesisSpec
-> ExceptT ByronGenesisError IO GenesisSpec
forall a b. (a -> b) -> a -> b
$
IO (Either Text GenesisSpec) -> ExceptT Text IO GenesisSpec
forall e (m :: * -> *) a. m (Either e a) -> ExceptT e m a
ExceptT (IO (Either Text GenesisSpec) -> ExceptT Text IO GenesisSpec)
-> (Either Text GenesisSpec -> IO (Either Text GenesisSpec))
-> Either Text GenesisSpec
-> ExceptT Text IO GenesisSpec
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Either Text GenesisSpec -> IO (Either Text GenesisSpec)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text GenesisSpec -> ExceptT Text IO GenesisSpec)
-> Either Text GenesisSpec -> ExceptT Text IO GenesisSpec
forall a b. (a -> b) -> a -> b
$ GenesisAvvmBalances
-> GenesisDelegation
-> ProtocolParameters
-> BlockCount
-> ProtocolMagic
-> GenesisInitializer
-> Either Text GenesisSpec
Genesis.mkGenesisSpec
(Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances
Genesis.GenesisAvvmBalances Map CompactRedeemVerificationKey Lovelace
forall a. Monoid a => a
mempty)
GenesisDelegation
genesisDelegation
ProtocolParameters
protocolParameters
(GenesisParameters -> BlockCount
gpK GenesisParameters
gp)
(GenesisParameters -> ProtocolMagic
gpProtocolMagic GenesisParameters
gp)
(Bool -> GenesisInitializer
mkGenesisInitialiser Bool
True)
where
mkGenesisInitialiser :: Bool -> Genesis.GenesisInitializer
mkGenesisInitialiser :: Bool -> GenesisInitializer
mkGenesisInitialiser Bool
useHeavyDlg =
TestnetBalanceOptions
-> FakeAvvmOptions -> Rational -> Bool -> GenesisInitializer
Genesis.GenesisInitializer
(GenesisParameters -> TestnetBalanceOptions
gpTestnetBalance GenesisParameters
gp)
(GenesisParameters -> FakeAvvmOptions
gpFakeAvvmOptions GenesisParameters
gp)
(LovelacePortion -> Rational
Common.lovelacePortionToRational (GenesisParameters -> LovelacePortion
gpAvvmBalanceFactor GenesisParameters
gp))
Bool
useHeavyDlg
mkGenesis
:: GenesisParameters
-> ExceptT ByronGenesisError IO (Genesis.GenesisData, Genesis.GeneratedSecrets)
mkGenesis :: GenesisParameters
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
mkGenesis GenesisParameters
gp = do
GenesisSpec
genesisSpec <- GenesisParameters -> ExceptT ByronGenesisError IO GenesisSpec
mkGenesisSpec GenesisParameters
gp
(GenesisDataGenerationError -> ByronGenesisError)
-> ExceptT
GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
withExceptT GenesisDataGenerationError -> ByronGenesisError
GenesisGenerationError (ExceptT
GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets))
-> ExceptT
GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
-> ExceptT ByronGenesisError IO (GenesisData, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$
UTCTime
-> GenesisSpec
-> ExceptT
GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
Genesis.generateGenesisData (GenesisParameters -> UTCTime
gpStartTime GenesisParameters
gp) GenesisSpec
genesisSpec
readGenesis :: GenesisFile
-> NetworkId
-> ExceptT ByronGenesisError IO Genesis.Config
readGenesis :: GenesisFile -> NetworkId -> ExceptT ByronGenesisError IO Config
readGenesis (GenesisFile String
file) NetworkId
nw =
(GenesisDataError -> ByronGenesisError)
-> ExceptT GenesisDataError IO Config
-> ExceptT ByronGenesisError IO Config
forall (m :: * -> *) e e' a.
Functor m =>
(e -> e') -> ExceptT e m a -> ExceptT e' m a
firstExceptT (String -> GenesisDataError -> ByronGenesisError
GenesisReadError String
file) (ExceptT GenesisDataError IO Config
-> ExceptT ByronGenesisError IO Config)
-> ExceptT GenesisDataError IO Config
-> ExceptT ByronGenesisError IO Config
forall a b. (a -> b) -> a -> b
$ do
(GenesisData
genesisData, GenesisHash
genesisHash) <- String -> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
forall (m :: * -> *).
(MonadError GenesisDataError m, MonadIO m) =>
String -> m (GenesisData, GenesisHash)
Genesis.readGenesisData String
file
Config -> ExceptT GenesisDataError IO Config
forall (m :: * -> *) a. Monad m => a -> m a
return Config :: GenesisData
-> GenesisHash
-> RequiresNetworkMagic
-> UTxOConfiguration
-> Config
Genesis.Config {
configGenesisData :: GenesisData
Genesis.configGenesisData = GenesisData
genesisData,
configGenesisHash :: GenesisHash
Genesis.configGenesisHash = GenesisHash
genesisHash,
configReqNetMagic :: RequiresNetworkMagic
Genesis.configReqNetMagic = NetworkId -> RequiresNetworkMagic
toByronRequiresNetworkMagic NetworkId
nw,
configUTxOConfiguration :: UTxOConfiguration
Genesis.configUTxOConfiguration = UTxOConfiguration
UTxO.defaultUTxOConfiguration
}
dumpGenesis
:: NewDirectory
-> Genesis.GenesisData
-> Genesis.GeneratedSecrets
-> ExceptT ByronGenesisError IO ()
dumpGenesis :: NewDirectory
-> GenesisData
-> GeneratedSecrets
-> ExceptT ByronGenesisError IO ()
dumpGenesis (NewDirectory String
outDir) GenesisData
genesisData GeneratedSecrets
gs = do
Bool
exists <- IO Bool -> ExceptT ByronGenesisError IO Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> ExceptT ByronGenesisError IO Bool)
-> IO Bool -> ExceptT ByronGenesisError IO Bool
forall a b. (a -> b) -> a -> b
$ String -> IO Bool
doesPathExist String
outDir
if Bool
exists
then ByronGenesisError -> ExceptT ByronGenesisError IO ()
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ByronGenesisError -> ExceptT ByronGenesisError IO ())
-> ByronGenesisError -> ExceptT ByronGenesisError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByronGenesisError
GenesisOutputDirAlreadyExists String
outDir
else IO () -> ExceptT ByronGenesisError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronGenesisError IO ())
-> IO () -> ExceptT ByronGenesisError IO ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
createDirectory String
outDir
IO () -> ExceptT ByronGenesisError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronGenesisError IO ())
-> IO () -> ExceptT ByronGenesisError IO ()
forall a b. (a -> b) -> a -> b
$ String -> ByteString -> IO ()
LB.writeFile String
genesisJSONFile (GenesisData -> ByteString
forall a. ToJSON Identity a => a -> ByteString
canonicalEncodePretty GenesisData
genesisData)
[Certificate]
dlgCerts <- (SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate)
-> [SigningKey ByronKey]
-> ExceptT ByronGenesisError IO [Certificate]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert ([SigningKey ByronKey]
-> ExceptT ByronGenesisError IO [Certificate])
-> ([SigningKey] -> [SigningKey ByronKey])
-> [SigningKey]
-> ExceptT ByronGenesisError IO [Certificate]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (SigningKey -> SigningKey ByronKey)
-> [SigningKey] -> [SigningKey ByronKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey -> SigningKey ByronKey
ByronSigningKey ([SigningKey] -> ExceptT ByronGenesisError IO [Certificate])
-> [SigningKey] -> ExceptT ByronGenesisError IO [Certificate]
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [SigningKey]
gsRichSecrets GeneratedSecrets
gs
IO () -> ExceptT ByronGenesisError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronGenesisError IO ())
-> IO () -> ExceptT ByronGenesisError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> String
-> (SigningKey ByronKey -> ByteString)
-> [SigningKey ByronKey]
-> IO ()
forall a. String -> String -> (a -> ByteString) -> [a] -> IO ()
wOut String
"genesis-keys" String
"key"
SigningKey ByronKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes
((SigningKey -> SigningKey ByronKey)
-> [SigningKey] -> [SigningKey ByronKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey -> SigningKey ByronKey
ByronSigningKey ([SigningKey] -> [SigningKey ByronKey])
-> [SigningKey] -> [SigningKey ByronKey]
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [SigningKey]
gsDlgIssuersSecrets GeneratedSecrets
gs)
IO () -> ExceptT ByronGenesisError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronGenesisError IO ())
-> IO () -> ExceptT ByronGenesisError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> String
-> (SigningKey ByronKey -> ByteString)
-> [SigningKey ByronKey]
-> IO ()
forall a. String -> String -> (a -> ByteString) -> [a] -> IO ()
wOut String
"delegate-keys" String
"key"
SigningKey ByronKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes
((SigningKey -> SigningKey ByronKey)
-> [SigningKey] -> [SigningKey ByronKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map SigningKey -> SigningKey ByronKey
ByronSigningKey ([SigningKey] -> [SigningKey ByronKey])
-> [SigningKey] -> [SigningKey ByronKey]
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [SigningKey]
gsRichSecrets GeneratedSecrets
gs)
IO () -> ExceptT ByronGenesisError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronGenesisError IO ())
-> IO () -> ExceptT ByronGenesisError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> String
-> (SigningKey ByronKey -> ByteString)
-> [SigningKey ByronKey]
-> IO ()
forall a. String -> String -> (a -> ByteString) -> [a] -> IO ()
wOut String
"poor-keys" String
"key"
SigningKey ByronKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes
((PoorSecret -> SigningKey ByronKey)
-> [PoorSecret] -> [SigningKey ByronKey]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (SigningKey -> SigningKey ByronKey
ByronSigningKey (SigningKey -> SigningKey ByronKey)
-> (PoorSecret -> SigningKey) -> PoorSecret -> SigningKey ByronKey
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PoorSecret -> SigningKey
Genesis.poorSecretToKey) ([PoorSecret] -> [SigningKey ByronKey])
-> [PoorSecret] -> [SigningKey ByronKey]
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [PoorSecret]
gsPoorSecrets GeneratedSecrets
gs)
IO () -> ExceptT ByronGenesisError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronGenesisError IO ())
-> IO () -> ExceptT ByronGenesisError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> String -> (Certificate -> ByteString) -> [Certificate] -> IO ()
forall a. String -> String -> (a -> ByteString) -> [a] -> IO ()
wOut String
"delegation-cert" String
"json" Certificate -> ByteString
serialiseDelegationCert [Certificate]
dlgCerts
IO () -> ExceptT ByronGenesisError IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ExceptT ByronGenesisError IO ())
-> IO () -> ExceptT ByronGenesisError IO ()
forall a b. (a -> b) -> a -> b
$ String
-> String
-> (RedeemSigningKey -> ByteString)
-> [RedeemSigningKey]
-> IO ()
forall a. String -> String -> (a -> ByteString) -> [a] -> IO ()
wOut String
"avvm-secrets" String
"secret" RedeemSigningKey -> ByteString
printFakeAvvmSecrets ([RedeemSigningKey] -> IO ()) -> [RedeemSigningKey] -> IO ()
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [RedeemSigningKey]
gsFakeAvvmSecrets GeneratedSecrets
gs
where
dlgCertMap :: Map Common.KeyHash Certificate
dlgCertMap :: Map KeyHash Certificate
dlgCertMap = GenesisDelegation -> Map KeyHash Certificate
Genesis.unGenesisDelegation (GenesisDelegation -> Map KeyHash Certificate)
-> GenesisDelegation -> Map KeyHash Certificate
forall a b. (a -> b) -> a -> b
$ GenesisData -> GenesisDelegation
Genesis.gdHeavyDelegation GenesisData
genesisData
findDelegateCert :: SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert :: SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert bSkey :: SigningKey ByronKey
bSkey@(ByronSigningKey sk) =
case (Certificate -> Bool) -> [Certificate] -> Maybe Certificate
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (SigningKey -> Certificate -> Bool
isCertForSK SigningKey
sk) (Map KeyHash Certificate -> [Certificate]
forall k a. Map k a -> [a]
Map.elems Map KeyHash Certificate
dlgCertMap) of
Maybe Certificate
Nothing -> ByronGenesisError -> ExceptT ByronGenesisError IO Certificate
forall (m :: * -> *) x a. Monad m => x -> ExceptT x m a
left (ByronGenesisError -> ExceptT ByronGenesisError IO Certificate)
-> (VerificationKey ByronKey -> ByronGenesisError)
-> VerificationKey ByronKey
-> ExceptT ByronGenesisError IO Certificate
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByronGenesisError
NoGenesisDelegationForKey
(Text -> ByronGenesisError)
-> (VerificationKey ByronKey -> Text)
-> VerificationKey ByronKey
-> ByronGenesisError
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. VerificationKey ByronKey -> Text
prettyPublicKey (VerificationKey ByronKey
-> ExceptT ByronGenesisError IO Certificate)
-> VerificationKey ByronKey
-> ExceptT ByronGenesisError IO Certificate
forall a b. (a -> b) -> a -> b
$ SigningKey ByronKey -> VerificationKey ByronKey
forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey ByronKey
bSkey
Just Certificate
x -> Certificate -> ExceptT ByronGenesisError IO Certificate
forall (m :: * -> *) a x. Monad m => a -> ExceptT x m a
right Certificate
x
genesisJSONFile :: FilePath
genesisJSONFile :: String
genesisJSONFile = String
outDir String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"/genesis.json"
printFakeAvvmSecrets :: Crypto.RedeemSigningKey -> ByteString
printFakeAvvmSecrets :: RedeemSigningKey -> ByteString
printFakeAvvmSecrets RedeemSigningKey
rskey = Text -> ByteString
encodeUtf8 (Text -> ByteString) -> (Builder -> Text) -> Builder -> ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Text
toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Builder -> Text
toLazyText (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ RedeemSigningKey -> Builder
forall p. Buildable p => p -> Builder
build RedeemSigningKey
rskey
isCertForSK :: Crypto.SigningKey -> Certificate -> Bool
isCertForSK :: SigningKey -> Certificate -> Bool
isCertForSK SigningKey
sk Certificate
cert = Certificate -> VerificationKey
forall a. ACertificate a -> VerificationKey
delegateVK Certificate
cert VerificationKey -> VerificationKey -> Bool
forall a. Eq a => a -> a -> Bool
== SigningKey -> VerificationKey
Crypto.toVerification SigningKey
sk
wOut :: String -> String -> (a -> ByteString) -> [a] -> IO ()
wOut :: String -> String -> (a -> ByteString) -> [a] -> IO ()
wOut = String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
forall a.
String -> String -> String -> (a -> ByteString) -> [a] -> IO ()
writeSecrets String
outDir