diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index c92064613..b483219a0 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -218,6 +218,7 @@ library containers, contra-tracer, cryptonite, + data-default-class, deepseq, directory, exceptions, diff --git a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs index 0b19f9567..6547fb240 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Genesis.hs @@ -1,8 +1,10 @@ {-# LANGUAGE GeneralisedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE RecordWildCards #-} module Cardano.CLI.Byron.Genesis ( ByronGenesisError (..) + , DumpGenesis (..) , GenesisParameters (..) , NewDirectory (..) , dumpGenesis @@ -23,12 +25,14 @@ import Cardano.CLI.Types.Common (GenesisFile (..)) import qualified Cardano.Crypto as Crypto import Cardano.Prelude (canonicalDecodePretty, canonicalEncodePretty) +import Control.Monad (when) import Control.Monad.IO.Class import Control.Monad.Trans (MonadTrans (..)) import Control.Monad.Trans.Except (ExceptT (..), withExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT, left, right) import Data.ByteString (ByteString) import qualified Data.ByteString.Lazy as LB +import Data.Default.Class import qualified Data.List as List import qualified Data.Map.Strict as Map import Data.String (IsString) @@ -156,43 +160,65 @@ readGenesis (GenesisFile file) nw = , Byron.configUTxOConfiguration = Byron.defaultUTxOConfiguration } +-- | Toggles to decide what to write in 'dumpGenesis'. Useful because if we write +-- everything all the time, deleting after the fact isn't super reliable on Windows. +-- Use the 'Default' instance to write everything. +data DumpGenesis = DumpGenesis + { writeGenesis :: Bool + , writeGenesisKeys :: Bool + , writeDelegateKeys :: Bool + , writePoorKeys :: Bool + , writeDelegationCert :: Bool + , writeAvvmSecrets :: Bool + } + +instance Default DumpGenesis where + def = DumpGenesis True True True True True True + -- | 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 + :: DumpGenesis + -> NewDirectory -> Byron.GenesisData -> Byron.GeneratedSecrets -> ExceptT ByronGenesisError IO () -dumpGenesis (NewDirectory outDir) genesisData gs = do +dumpGenesis DumpGenesis{..} (NewDirectory outDir) genesisData gs = do exists <- liftIO $ doesPathExist outDir if exists then left $ GenesisOutputDirAlreadyExists outDir else liftIO $ createDirectory outDir - liftIO $ LB.writeFile genesisJSONFile (canonicalEncodePretty genesisData) + when writeGenesis (liftIO $ LB.writeFile genesisJSONFile (canonicalEncodePretty genesisData)) dlgCerts <- mapM (findDelegateCert . ByronSigningKey) $ Byron.gsRichSecrets gs - liftIO $ - wOut - "genesis-keys" - "key" - serialiseToRawBytes - (map ByronSigningKey $ Byron.gsDlgIssuersSecrets gs) - liftIO $ - wOut - "delegate-keys" - "key" - serialiseToRawBytes - (map ByronSigningKey $ Byron.gsRichSecrets gs) - liftIO $ - wOut - "poor-keys" - "key" - serialiseToRawBytes - (map (ByronSigningKey . Byron.poorSecretToKey) $ Byron.gsPoorSecrets gs) - liftIO $ wOut "delegation-cert" "json" serialiseDelegationCert dlgCerts - liftIO $ wOut "avvm-secrets" "secret" printFakeAvvmSecrets $ Byron.gsFakeAvvmSecrets gs + when writeGenesisKeys $ + liftIO $ + wOut + "genesis-keys" + "key" + serialiseToRawBytes + (map ByronSigningKey $ Byron.gsDlgIssuersSecrets gs) + when writeDelegateKeys $ + liftIO $ + wOut + "delegate-keys" + "key" + serialiseToRawBytes + (map ByronSigningKey $ Byron.gsRichSecrets gs) + when writePoorKeys $ + liftIO $ + wOut + "poor-keys" + "key" + serialiseToRawBytes + (map (ByronSigningKey . Byron.poorSecretToKey) $ Byron.gsPoorSecrets gs) + when writeDelegationCert $ liftIO $ wOut "delegation-cert" "json" serialiseDelegationCert dlgCerts + when writeAvvmSecrets $ + liftIO $ + wOut "avvm-secrets" "secret" printFakeAvvmSecrets $ + Byron.gsFakeAvvmSecrets gs where dlgCertMap = Byron.unGenesisDelegation $ Byron.gdHeavyDelegation genesisData diff --git a/cardano-cli/src/Cardano/CLI/Byron/Run.hs b/cardano-cli/src/Cardano/CLI/Byron/Run.hs index e24ccd27a..9f1c5989a 100644 --- a/cardano-cli/src/Cardano/CLI/Byron/Run.hs +++ b/cardano-cli/src/Cardano/CLI/Byron/Run.hs @@ -27,6 +27,7 @@ import qualified Cardano.Crypto.Signing as Crypto import Data.Bifunctor (Bifunctor (..)) import qualified Data.ByteString.Char8 as BS +import Data.Default.Class import Data.Text (Text) import qualified Data.Text.IO as Text import qualified Data.Text.Lazy.Builder as Builder @@ -91,7 +92,7 @@ runNodeCmds (UpdateProposal nw sKey pVer sVer sysTag insHash outputFp params) = runGenesisCommand :: NewDirectory -> GenesisParameters -> ExceptT ByronClientCmdError IO () runGenesisCommand outDir params = do (genData, genSecrets) <- firstExceptT ByronCmdGenesisError $ mkGenesis params - firstExceptT ByronCmdGenesisError $ dumpGenesis outDir genData genSecrets + firstExceptT ByronCmdGenesisError $ dumpGenesis def outDir genData genSecrets runValidateCBOR :: CBORObject -> FilePath -> ExceptT ByronClientCmdError IO () runValidateCBOR cborObject fp = do diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs index a200e55fc..82e072fe8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs @@ -393,11 +393,12 @@ runGenesisCreateTestNetDataCmd let byronGenesisParameters = mkByronGenesisParameters actualNetworkWord32 byronGenesisFp shelleyGenesis' byronOutputDir = outputDir "byron-gen-command" + dumpGenesis = Byron.DumpGenesis False False True True True False (byronGenesis, byronSecrets) <- firstExceptT GenesisCmdByronError $ Byron.mkGenesis byronGenesisParameters firstExceptT GenesisCmdByronError $ - Byron.dumpGenesis (NewDirectory byronOutputDir) byronGenesis byronSecrets + Byron.dumpGenesis dumpGenesis (NewDirectory byronOutputDir) byronGenesis byronSecrets -- Move things from byron-gen-command to the nodes' directories forM_ [1 .. min byronPoolNumber numPools] $ \index -> do