{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}

module Cardano.CLI.Byron.Genesis
  ( ByronGenesisError (..)
  , GenesisParameters (..)
  , NewDirectory (..)
  , dumpGenesis
  , mkGenesis
  , readGenesis
  , renderByronGenesisError
  )
where

import Cardano.Api.Byron (ByronKey, NetworkId, SigningKey (..), toByronRequiresNetworkMagic)
import Cardano.Api.Byron qualified as Byron
import Cardano.Api.Error
import Cardano.Api.IO
import Cardano.Api.Key
import Cardano.Api.Monad.Error
import Cardano.Api.Pretty
import Cardano.Api.Serialise.Raw

import Cardano.CLI.Byron.Delegation
import Cardano.CLI.Byron.Key
import Cardano.CLI.Compatible.Exception
import Cardano.CLI.Orphan ()
import Cardano.CLI.Type.Common (GenesisFile (..))
import Cardano.Crypto qualified as Crypto
import Cardano.Prelude (canonicalDecodePretty, canonicalEncodePretty)

import Data.ByteString (ByteString)
import Data.ByteString.Lazy qualified as LB
import Data.List qualified as List
import Data.Map.Strict qualified as Map
import Data.String (IsString)
import Data.Text (Text)
import Data.Text.Encoding qualified as Text
import Data.Text.Lazy (toStrict)
import Data.Text.Lazy.Builder (toLazyText)
import Data.Time (UTCTime)
import Formatting.Buildable
import System.Directory (createDirectory, doesPathExist)

data ByronGenesisError
  = GenesisOutputDirAlreadyExists FilePath
  | GenesisReadError !FilePath !Byron.GenesisDataError
  | GenesisSpecError !Text
  | MakeGenesisDelegationError !Byron.GenesisDelegationError
  | NoGenesisDelegationForKey !Text
  | ProtocolParametersParseFailed !FilePath !Text
  deriving Int -> ByronGenesisError -> ShowS
[ByronGenesisError] -> ShowS
ByronGenesisError -> FilePath
(Int -> ByronGenesisError -> ShowS)
-> (ByronGenesisError -> FilePath)
-> ([ByronGenesisError] -> ShowS)
-> Show ByronGenesisError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ByronGenesisError -> ShowS
showsPrec :: Int -> ByronGenesisError -> ShowS
$cshow :: ByronGenesisError -> FilePath
show :: ByronGenesisError -> FilePath
$cshowList :: [ByronGenesisError] -> ShowS
showList :: [ByronGenesisError] -> ShowS
Show

instance Error ByronGenesisError where
  prettyError :: forall ann. ByronGenesisError -> Doc ann
prettyError = ByronGenesisError -> Doc ann
forall ann. ByronGenesisError -> Doc ann
renderByronGenesisError

renderByronGenesisError :: ByronGenesisError -> Doc ann
renderByronGenesisError :: forall ann. ByronGenesisError -> Doc ann
renderByronGenesisError = \case
  ProtocolParametersParseFailed FilePath
pParamFp Text
parseError ->
    Doc ann
"Protocol parameters parse failed at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow FilePath
pParamFp Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
forall ann. Text -> Doc ann
pretty Text
parseError
  MakeGenesisDelegationError GenesisDelegationError
genDelegError ->
    Doc ann
"Error creating genesis delegation: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> GenesisDelegationError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow GenesisDelegationError
genDelegError
  GenesisOutputDirAlreadyExists FilePath
genOutDir ->
    Doc ann
"Genesis output directory already exists: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow FilePath
genOutDir
  GenesisReadError FilePath
genFp GenesisDataError
genDataError ->
    Doc ann
"Error while reading genesis file at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> FilePath -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow FilePath
genFp Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" Error: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> GenesisDataError -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow GenesisDataError
genDataError
  GenesisSpecError Text
genSpecError ->
    Doc ann
"Error while creating genesis spec" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Text
genSpecError
  NoGenesisDelegationForKey Text
verKey ->
    Doc ann
"Error while creating genesis, no delegation certificate for this verification key:" Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow 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
$c== :: NewDirectory -> NewDirectory -> Bool
== :: NewDirectory -> NewDirectory -> Bool
$c/= :: NewDirectory -> NewDirectory -> Bool
/= :: 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
$ccompare :: NewDirectory -> NewDirectory -> Ordering
compare :: NewDirectory -> NewDirectory -> Ordering
$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
>= :: NewDirectory -> NewDirectory -> Bool
$cmax :: NewDirectory -> NewDirectory -> NewDirectory
max :: NewDirectory -> NewDirectory -> NewDirectory
$cmin :: NewDirectory -> NewDirectory -> NewDirectory
min :: NewDirectory -> NewDirectory -> NewDirectory
Ord, Int -> NewDirectory -> ShowS
[NewDirectory] -> ShowS
NewDirectory -> FilePath
(Int -> NewDirectory -> ShowS)
-> (NewDirectory -> FilePath)
-> ([NewDirectory] -> ShowS)
-> Show NewDirectory
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NewDirectory -> ShowS
showsPrec :: Int -> NewDirectory -> ShowS
$cshow :: NewDirectory -> FilePath
show :: NewDirectory -> FilePath
$cshowList :: [NewDirectory] -> ShowS
showList :: [NewDirectory] -> ShowS
Show, FilePath -> NewDirectory
(FilePath -> NewDirectory) -> IsString NewDirectory
forall a. (FilePath -> a) -> IsString a
$cfromString :: FilePath -> NewDirectory
fromString :: FilePath -> NewDirectory
IsString)

-- | Parameters required for generation of new genesis.
data GenesisParameters = GenesisParameters
  { GenesisParameters -> UTCTime
gpStartTime :: !UTCTime
  , GenesisParameters -> FilePath
gpProtocolParamsFile :: !FilePath
  , GenesisParameters -> BlockCount
gpK :: !Byron.BlockCount
  , GenesisParameters -> ProtocolMagic
gpProtocolMagic :: !Crypto.ProtocolMagic
  , GenesisParameters -> TestnetBalanceOptions
gpTestnetBalance :: !Byron.TestnetBalanceOptions
  , GenesisParameters -> FakeAvvmOptions
gpFakeAvvmOptions :: !Byron.FakeAvvmOptions
  , GenesisParameters -> LovelacePortion
gpAvvmBalanceFactor :: !Byron.LovelacePortion
  , GenesisParameters -> Maybe Integer
gpSeed :: !(Maybe Integer)
  }
  deriving Int -> GenesisParameters -> ShowS
[GenesisParameters] -> ShowS
GenesisParameters -> FilePath
(Int -> GenesisParameters -> ShowS)
-> (GenesisParameters -> FilePath)
-> ([GenesisParameters] -> ShowS)
-> Show GenesisParameters
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GenesisParameters -> ShowS
showsPrec :: Int -> GenesisParameters -> ShowS
$cshow :: GenesisParameters -> FilePath
show :: GenesisParameters -> FilePath
$cshowList :: [GenesisParameters] -> ShowS
showList :: [GenesisParameters] -> ShowS
Show

mkGenesisSpec :: GenesisParameters -> ExceptT ByronGenesisError IO Byron.GenesisSpec
mkGenesisSpec :: GenesisParameters -> ExceptT ByronGenesisError IO GenesisSpec
mkGenesisSpec GenesisParameters
gp = do
  ByteString
protoParamsRaw <- IO ByteString -> ExceptT ByronGenesisError IO ByteString
forall (m :: * -> *) a.
Monad m =>
m a -> ExceptT ByronGenesisError m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO ByteString -> ExceptT ByronGenesisError IO ByteString)
-> (FilePath -> IO ByteString)
-> FilePath
-> ExceptT ByronGenesisError IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ByteString
LB.readFile (FilePath -> ExceptT ByronGenesisError IO ByteString)
-> FilePath -> ExceptT ByronGenesisError IO ByteString
forall a b. (a -> b) -> a -> b
$ GenesisParameters -> FilePath
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
      (FilePath -> Text -> ByronGenesisError
ProtocolParametersParseFailed (GenesisParameters -> FilePath
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 b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text ProtocolParameters
-> IO (Either Text ProtocolParameters)
forall a. a -> IO a
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

  -- We're relying on the generator to fake AVVM and delegation.
  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
Byron.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 b c a. (b -> c) -> (a -> b) -> a -> c
. Either Text GenesisSpec -> IO (Either Text GenesisSpec)
forall a. a -> IO a
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
Byron.mkGenesisSpec
        (Map CompactRedeemVerificationKey Lovelace -> GenesisAvvmBalances
Byron.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 -> Byron.GenesisInitializer
  mkGenesisInitialiser :: Bool -> GenesisInitializer
mkGenesisInitialiser =
    TestnetBalanceOptions
-> FakeAvvmOptions -> Rational -> Bool -> GenesisInitializer
Byron.GenesisInitializer
      (GenesisParameters -> TestnetBalanceOptions
gpTestnetBalance GenesisParameters
gp)
      (GenesisParameters -> FakeAvvmOptions
gpFakeAvvmOptions GenesisParameters
gp)
      (LovelacePortion -> Rational
Byron.lovelacePortionToRational (GenesisParameters -> LovelacePortion
gpAvvmBalanceFactor GenesisParameters
gp))

-- | Generate a genesis, for given blockchain start time, protocol parameters,
-- security parameter, protocol magic, testnet balance options, fake AVVM options,
-- AVVM balance factor and seed.  Throw an error in the following cases: if the
-- protocol parameters file can't be read or fails parse, if genesis delegation
-- couldn't be generated, if the parameter-derived genesis specification is wrong,
-- or if the genesis fails generation.
mkGenesis
  :: GenesisParameters
  -> CIO e (Byron.GenesisData, Byron.GeneratedSecrets)
mkGenesis :: forall e.
GenesisParameters -> CIO e (GenesisData, GeneratedSecrets)
mkGenesis GenesisParameters
gp = do
  GenesisSpec
genesisSpec <- ExceptT ByronGenesisError IO GenesisSpec -> RIO e GenesisSpec
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT ByronGenesisError IO GenesisSpec -> RIO e GenesisSpec)
-> ExceptT ByronGenesisError IO GenesisSpec -> RIO e GenesisSpec
forall a b. (a -> b) -> a -> b
$ GenesisParameters -> ExceptT ByronGenesisError IO GenesisSpec
mkGenesisSpec GenesisParameters
gp

  ExceptT
  GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
-> RIO e (GenesisData, GeneratedSecrets)
forall e (m :: * -> *) a.
(HasCallStack, MonadIO m, Show e, Typeable e, Error e) =>
ExceptT e IO a -> m a
fromExceptTCli (ExceptT
   GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
 -> RIO e (GenesisData, GeneratedSecrets))
-> ExceptT
     GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
-> RIO e (GenesisData, GeneratedSecrets)
forall a b. (a -> b) -> a -> b
$
    UTCTime
-> GenesisSpec
-> ExceptT
     GenesisDataGenerationError IO (GenesisData, GeneratedSecrets)
Byron.generateGenesisData (GenesisParameters -> UTCTime
gpStartTime GenesisParameters
gp) GenesisSpec
genesisSpec

-- | Read genesis from a file.
readGenesis
  :: GenesisFile
  -> NetworkId
  -> ExceptT ByronGenesisError IO Byron.Config
readGenesis :: GenesisFile -> NetworkId -> ExceptT ByronGenesisError IO Config
readGenesis (GenesisFile FilePath
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 (FilePath -> GenesisDataError -> ByronGenesisError
GenesisReadError FilePath
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) <- FilePath -> ExceptT GenesisDataError IO (GenesisData, GenesisHash)
forall (m :: * -> *).
(MonadError GenesisDataError m, MonadIO m) =>
FilePath -> m (GenesisData, GenesisHash)
Byron.readGenesisData FilePath
file
    Config -> ExceptT GenesisDataError IO Config
forall a. a -> ExceptT GenesisDataError IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
      Byron.Config
        { configGenesisData :: GenesisData
Byron.configGenesisData = GenesisData
genesisData
        , configGenesisHash :: GenesisHash
Byron.configGenesisHash = GenesisHash
genesisHash
        , configReqNetMagic :: RequiresNetworkMagic
Byron.configReqNetMagic = NetworkId -> RequiresNetworkMagic
toByronRequiresNetworkMagic NetworkId
nw
        , configUTxOConfiguration :: UTxOConfiguration
Byron.configUTxOConfiguration = UTxOConfiguration
Byron.defaultUTxOConfiguration
        }

-- | Write out genesis into a directory that must not yet exist.  An error is
-- thrown if the directory already exists, or the genesis has delegate keys that
-- are not delegated to.
dumpGenesis
  :: NewDirectory
  -> Byron.GenesisData
  -> Byron.GeneratedSecrets
  -> ExceptT ByronGenesisError IO ()
dumpGenesis :: NewDirectory
-> GenesisData
-> GeneratedSecrets
-> ExceptT ByronGenesisError IO ()
dumpGenesis (NewDirectory FilePath
outDir) GenesisData
genesisData GeneratedSecrets
gs = do
  Bool
exists <- IO Bool -> ExceptT ByronGenesisError IO Bool
forall a. IO a -> ExceptT ByronGenesisError IO a
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
$ FilePath -> IO Bool
doesPathExist FilePath
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
$ FilePath -> ByronGenesisError
GenesisOutputDirAlreadyExists FilePath
outDir
    else IO () -> ExceptT ByronGenesisError IO ()
forall a. IO a -> ExceptT ByronGenesisError IO a
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
$ FilePath -> IO ()
createDirectory FilePath
outDir
  IO () -> ExceptT ByronGenesisError IO ()
forall a. IO a -> ExceptT ByronGenesisError IO a
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
$ FilePath -> ByteString -> IO ()
LB.writeFile FilePath
genesisJSONFile (GenesisData -> ByteString
forall a. ToJSON Identity a => a -> ByteString
canonicalEncodePretty GenesisData
genesisData)

  [Certificate]
dlgCerts <- (SigningKey -> ExceptT ByronGenesisError IO Certificate)
-> [SigningKey] -> ExceptT ByronGenesisError IO [Certificate]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert (SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate)
-> (SigningKey -> SigningKey ByronKey)
-> SigningKey
-> ExceptT ByronGenesisError IO Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey -> SigningKey ByronKey
ByronSigningKey) ([SigningKey] -> ExceptT ByronGenesisError IO [Certificate])
-> [SigningKey] -> ExceptT ByronGenesisError IO [Certificate]
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [SigningKey]
Byron.gsRichSecrets GeneratedSecrets
gs

  IO () -> ExceptT ByronGenesisError IO ()
forall a. IO a -> ExceptT ByronGenesisError IO a
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
$
    FilePath
-> FilePath
-> (SigningKey ByronKey -> ByteString)
-> [SigningKey ByronKey]
-> IO ()
forall a. FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
wOut
      FilePath
"genesis-keys"
      FilePath
"key"
      SigningKey ByronKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes
      ((SigningKey -> SigningKey ByronKey)
-> [SigningKey] -> [SigningKey ByronKey]
forall a b. (a -> b) -> [a] -> [b]
map SigningKey -> SigningKey ByronKey
ByronSigningKey ([SigningKey] -> [SigningKey ByronKey])
-> [SigningKey] -> [SigningKey ByronKey]
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [SigningKey]
Byron.gsDlgIssuersSecrets GeneratedSecrets
gs)
  IO () -> ExceptT ByronGenesisError IO ()
forall a. IO a -> ExceptT ByronGenesisError IO a
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
$
    FilePath
-> FilePath
-> (SigningKey ByronKey -> ByteString)
-> [SigningKey ByronKey]
-> IO ()
forall a. FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
wOut
      FilePath
"delegate-keys"
      FilePath
"key"
      SigningKey ByronKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes
      ((SigningKey -> SigningKey ByronKey)
-> [SigningKey] -> [SigningKey ByronKey]
forall a b. (a -> b) -> [a] -> [b]
map SigningKey -> SigningKey ByronKey
ByronSigningKey ([SigningKey] -> [SigningKey ByronKey])
-> [SigningKey] -> [SigningKey ByronKey]
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [SigningKey]
Byron.gsRichSecrets GeneratedSecrets
gs)
  IO () -> ExceptT ByronGenesisError IO ()
forall a. IO a -> ExceptT ByronGenesisError IO a
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
$
    FilePath
-> FilePath
-> (SigningKey ByronKey -> ByteString)
-> [SigningKey ByronKey]
-> IO ()
forall a. FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
wOut
      FilePath
"poor-keys"
      FilePath
"key"
      SigningKey ByronKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes
      ((PoorSecret -> SigningKey ByronKey)
-> [PoorSecret] -> [SigningKey ByronKey]
forall a b. (a -> b) -> [a] -> [b]
map (SigningKey -> SigningKey ByronKey
ByronSigningKey (SigningKey -> SigningKey ByronKey)
-> (PoorSecret -> SigningKey) -> PoorSecret -> SigningKey ByronKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoorSecret -> SigningKey
Byron.poorSecretToKey) ([PoorSecret] -> [SigningKey ByronKey])
-> [PoorSecret] -> [SigningKey ByronKey]
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [PoorSecret]
Byron.gsPoorSecrets GeneratedSecrets
gs)
  IO () -> ExceptT ByronGenesisError IO ()
forall a. IO a -> ExceptT ByronGenesisError IO a
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
$ FilePath
-> FilePath
-> (Certificate -> ByteString)
-> [Certificate]
-> IO ()
forall a. FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
wOut FilePath
"delegation-cert" FilePath
"json" Certificate -> ByteString
serialiseDelegationCert [Certificate]
dlgCerts
  IO () -> ExceptT ByronGenesisError IO ()
forall a. IO a -> ExceptT ByronGenesisError IO a
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
$ FilePath
-> FilePath
-> (RedeemSigningKey -> ByteString)
-> [RedeemSigningKey]
-> IO ()
forall a. FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
wOut FilePath
"avvm-secrets" FilePath
"secret" RedeemSigningKey -> ByteString
printFakeAvvmSecrets ([RedeemSigningKey] -> IO ()) -> [RedeemSigningKey] -> IO ()
forall a b. (a -> b) -> a -> b
$ GeneratedSecrets -> [RedeemSigningKey]
Byron.gsFakeAvvmSecrets GeneratedSecrets
gs
 where
  dlgCertMap :: Map KeyHash Certificate
dlgCertMap = GenesisDelegation -> Map KeyHash Certificate
Byron.unGenesisDelegation (GenesisDelegation -> Map KeyHash Certificate)
-> GenesisDelegation -> Map KeyHash Certificate
forall a b. (a -> b) -> a -> b
$ GenesisData -> GenesisDelegation
Byron.gdHeavyDelegation GenesisData
genesisData

  findDelegateCert :: SigningKey ByronKey -> ExceptT ByronGenesisError IO Byron.Certificate
  findDelegateCert :: SigningKey ByronKey -> ExceptT ByronGenesisError IO Certificate
findDelegateCert bSkey :: SigningKey ByronKey
bSkey@(ByronSigningKey SigningKey
sk) =
    case (Certificate -> Bool) -> [Certificate] -> Maybe Certificate
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
List.find (SigningKey -> Certificate -> Bool
isCertForSK SigningKey
sk) (Map KeyHash Certificate -> [Certificate]
forall k a. Map k a -> [a]
Map.elems Map KeyHash Certificate
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 b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByronGenesisError
NoGenesisDelegationForKey
          (Text -> ByronGenesisError)
-> (VerificationKey ByronKey -> Text)
-> VerificationKey ByronKey
-> ByronGenesisError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey ByronKey -> Text
prettyPublicKey
          (VerificationKey ByronKey
 -> ExceptT ByronGenesisError IO Certificate)
-> VerificationKey ByronKey
-> ExceptT ByronGenesisError IO Certificate
forall a b. (a -> b) -> a -> b
$ SigningKey ByronKey -> VerificationKey ByronKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey ByronKey
bSkey
      Just Certificate
x -> Certificate -> ExceptT ByronGenesisError IO Certificate
forall (m :: * -> *) a x. Monad m => a -> ExceptT x m a
right Certificate
x

  genesisJSONFile :: FilePath
  genesisJSONFile :: FilePath
genesisJSONFile = FilePath
outDir FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
"/genesis.json"

  printFakeAvvmSecrets :: Crypto.RedeemSigningKey -> ByteString
  printFakeAvvmSecrets :: RedeemSigningKey -> ByteString
printFakeAvvmSecrets RedeemSigningKey
rskey = Text -> ByteString
Text.encodeUtf8 (Text -> ByteString) -> (Builder -> Text) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyText -> Text
toStrict (LazyText -> Text) -> (Builder -> LazyText) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
toLazyText (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ RedeemSigningKey -> Builder
forall p. Buildable p => p -> Builder
build RedeemSigningKey
rskey

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

  wOut :: String -> String -> (a -> ByteString) -> [a] -> IO ()
  wOut :: forall a. FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
wOut = FilePath
-> FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
forall a.
FilePath
-> FilePath -> FilePath -> (a -> ByteString) -> [a] -> IO ()
writeSecrets FilePath
outDir