From f2b3644babb4a3404a04e55fe317752a1721b6dc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Tue, 19 Nov 2024 10:16:29 +0100 Subject: [PATCH 1/2] genesis creation: share code --- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 46 ++++--------------- .../EraBased/Run/Genesis/CreateTestnetData.hs | 33 +++++++++++++ 2 files changed, 43 insertions(+), 36 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 71e75ec8dd..ba0c1dcfd5 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -41,6 +41,7 @@ import qualified Cardano.CLI.Byron.Key as Byron import qualified Cardano.CLI.Commands.Node as Cmd import Cardano.CLI.EraBased.Commands.Genesis as Cmd import Cardano.CLI.EraBased.Run.Genesis.Common +import Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData (WriteFileGenesis (..)) import qualified Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData as TN import Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd) import qualified Cardano.CLI.IO.Lazy as Lazy @@ -54,7 +55,6 @@ import Cardano.CLI.Types.Key import qualified Cardano.Crypto as CC import qualified Cardano.Crypto.Hash as Crypto import qualified Cardano.Crypto.Signing as Byron -import Cardano.Prelude (canonicalEncodePretty) import Cardano.Slotting.Slot (EpochSize (EpochSize)) import Control.DeepSeq (NFData, force) @@ -72,7 +72,6 @@ import Data.Char (isDigit) import Data.Fixed (Fixed (MkFixed)) import Data.Function (on) import Data.Functor (void) -import Data.Functor.Identity (Identity) import qualified Data.List as List import qualified Data.List.Split as List import Data.ListMap (ListMap (..)) @@ -95,8 +94,6 @@ import qualified System.IO as IO import System.IO.Error (isDoesNotExistError) import qualified System.Random as Random import System.Random (StdGen) -import qualified Text.JSON.Canonical (ToJSON) -import Text.JSON.Canonical (parseCanonicalJSON, renderCanonicalJSON) import Text.Read (readMaybe) runGenesisCmds :: GenesisCmds era -> ExceptT GenesisCmdError IO () @@ -278,9 +275,9 @@ runGenesisCreateCmd [] template - void $ writeFileGenesis (rootdir "genesis.json") $ WritePretty shelleyGenesis - void $ writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis - void $ writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis + void $ TN.writeFileGenesis (rootdir "genesis.json") $ WritePretty shelleyGenesis + void $ TN.writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis + void $ TN.writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis where -- TODO: rationalise the naming convention on these genesis json files. @@ -478,13 +475,13 @@ runGenesisCreateCardanoCmd writeSecrets deldir "shelley" "counter.json" toCounter opCerts byronGenesisHash <- - writeFileGenesis (rootdir "byron-genesis.json") $ WriteCanonical byronGenesis + TN.writeFileGenesis (rootdir "byron-genesis.json") $ WriteCanonical byronGenesis shelleyGenesisHash <- - writeFileGenesis (rootdir "shelley-genesis.json") $ WritePretty shelleyGenesis + TN.writeFileGenesis (rootdir "shelley-genesis.json") $ WritePretty shelleyGenesis alonzoGenesisHash <- - writeFileGenesis (rootdir "alonzo-genesis.json") $ WritePretty alonzoGenesis + TN.writeFileGenesis (rootdir "alonzo-genesis.json") $ WritePretty alonzoGenesis conwayGenesisHash <- - writeFileGenesis (rootdir "conway-genesis.json") $ WritePretty conwayGenesis + TN.writeFileGenesis (rootdir "conway-genesis.json") $ WritePretty conwayGenesis liftIO $ do case mNodeConfigTemplate of @@ -690,8 +687,8 @@ runGenesisCreateStakedCmd liftIO $ LBS.writeFile (rootdir "genesis.json") $ encodePretty shelleyGenesis - void $ writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis - void $ writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis + void $ TN.writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis + void $ TN.writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis -- TODO: rationalise the naming convention on these genesis json files. liftIO $ @@ -1151,29 +1148,6 @@ updateTemplate unLovelace :: Integral a => Lovelace -> a unLovelace (L.Coin coin) = fromIntegral coin -writeFileGenesis - :: FilePath - -> WriteFileGenesis - -> ExceptT GenesisCmdError IO (Crypto.Hash Crypto.Blake2b_256 ByteString) -writeFileGenesis fpath genesis = do - handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ - BS.writeFile fpath content - return $ Crypto.hashWith id content - where - content = case genesis of - WritePretty a -> LBS.toStrict $ encodePretty a - WriteCanonical a -> - LBS.toStrict - . renderCanonicalJSON - . either (error . ("error parsing json that was just encoded!? " ++) . show) id - . parseCanonicalJSON - . canonicalEncodePretty - $ a - -data WriteFileGenesis where - WriteCanonical :: Text.JSON.Canonical.ToJSON Identity genesis => genesis -> WriteFileGenesis - WritePretty :: ToJSON genesis => genesis -> WriteFileGenesis - -- ---------------------------------------------------------------------------- readGenDelegsMap 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 f294acc58c..1782867186 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs @@ -18,6 +18,8 @@ module Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData , runGenesisKeyGenDelegateCmd , runGenesisCreateTestNetDataCmd , runGenesisKeyGenDelegateVRF + , writeFileGenesis + , WriteFileGenesis (..) ) where @@ -50,13 +52,19 @@ import Cardano.CLI.Types.Errors.GenesisCmdError import Cardano.CLI.Types.Errors.NodeCmdError import Cardano.CLI.Types.Errors.StakePoolCmdError import Cardano.CLI.Types.Key +import qualified Cardano.Crypto.Hash as Crypto +import Cardano.Prelude (canonicalEncodePretty) import Control.DeepSeq (NFData, deepseq) import Control.Monad (forM, forM_, unless, void, when) import qualified Data.Aeson as Aeson +import qualified Data.Aeson.Encode.Pretty as Aeson import Data.Bifunctor (Bifunctor (..)) +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Function ((&)) +import Data.Functor.Identity (Identity) import Data.ListMap (ListMap (..)) import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map @@ -75,6 +83,8 @@ import System.Directory (createDirectoryIfMissing) import System.FilePath (()) import qualified System.Random as Random import System.Random (StdGen) +import qualified Text.JSON.Canonical (ToJSON) +import Text.JSON.Canonical (parseCanonicalJSON, renderCanonicalJSON) runGenesisKeyGenGenesisCmd :: GenesisKeyGenGenesisCmdArgs @@ -165,6 +175,29 @@ runGenesisKeyGenUTxOCmd skeyDesc = "Genesis Initial UTxO Signing Key" vkeyDesc = "Genesis Initial UTxO Verification Key" +writeFileGenesis + :: FilePath + -> WriteFileGenesis + -> ExceptT GenesisCmdError IO (Crypto.Hash Crypto.Blake2b_256 ByteString) +writeFileGenesis fpath genesis = do + handleIOExceptT (GenesisCmdGenesisFileError . FileIOError fpath) $ + BS.writeFile fpath content + return $ Crypto.hashWith id content + where + content = case genesis of + WritePretty a -> LBS.toStrict $ Aeson.encodePretty a + WriteCanonical a -> + LBS.toStrict + . renderCanonicalJSON + . either (error . ("error parsing json that was just encoded!? " ++) . show) id + . parseCanonicalJSON + . canonicalEncodePretty + $ a + +data WriteFileGenesis where + WriteCanonical :: Text.JSON.Canonical.ToJSON Identity genesis => genesis -> WriteFileGenesis + WritePretty :: ToJSON genesis => genesis -> WriteFileGenesis + runGenesisCreateTestNetDataCmd :: GenesisCreateTestNetDataCmdArgs era -> ExceptT GenesisCmdError IO () From 059da05a8bd55216083533d513f55252f66234ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Tue, 19 Nov 2024 11:31:49 +0100 Subject: [PATCH 2/2] Use sharing --- .../src/Cardano/CLI/EraBased/Run/Genesis.hs | 20 +++++++++++-------- .../EraBased/Run/Genesis/CreateTestnetData.hs | 10 ++++++---- 2 files changed, 18 insertions(+), 12 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index ba0c1dcfd5..07e25a8565 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -62,7 +62,6 @@ import Control.Exception (evaluate) import Control.Monad (forM, forM_, unless, when) import Data.Aeson hiding (Key) import qualified Data.Aeson as Aeson -import Data.Aeson.Encode.Pretty (encodePretty) import qualified Data.Aeson.KeyMap as Aeson import Data.Bifunctor (Bifunctor (..)) import Data.ByteString (ByteString) @@ -275,9 +274,12 @@ runGenesisCreateCmd [] template - void $ TN.writeFileGenesis (rootdir "genesis.json") $ WritePretty shelleyGenesis - void $ TN.writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis - void $ TN.writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis + forM_ + [ ("genesis.json", WritePretty shelleyGenesis) + , ("genesis.alonzo.json", WritePretty alonzoGenesis) + , ("genesis.conway.json", WritePretty conwayGenesis) + ] + $ \(filename, genesis) -> TN.writeFileGenesis (rootdir filename) genesis where -- TODO: rationalise the naming convention on these genesis json files. @@ -685,10 +687,12 @@ runGenesisCreateStakedCmd stuffedUtxoAddrs template - liftIO $ LBS.writeFile (rootdir "genesis.json") $ encodePretty shelleyGenesis - - void $ TN.writeFileGenesis (rootdir "genesis.alonzo.json") $ WritePretty alonzoGenesis - void $ TN.writeFileGenesis (rootdir "genesis.conway.json") $ WritePretty conwayGenesis + forM_ + [ ("genesis.json", WritePretty shelleyGenesis) + , ("genesis.alonzo.json", WritePretty alonzoGenesis) + , ("genesis.conway.json", WritePretty conwayGenesis) + ] + $ \(filename, genesis) -> TN.writeFileGenesis (rootdir filename) genesis -- TODO: rationalise the naming convention on these genesis json files. liftIO $ 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 1782867186..b4a3136fa1 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis/CreateTestnetData.hs @@ -57,7 +57,6 @@ import Cardano.Prelude (canonicalEncodePretty) import Control.DeepSeq (NFData, deepseq) import Control.Monad (forM, forM_, unless, void, when) -import qualified Data.Aeson as Aeson import qualified Data.Aeson.Encode.Pretty as Aeson import Data.Bifunctor (Bifunctor (..)) import Data.ByteString (ByteString) @@ -379,9 +378,12 @@ runGenesisCreateTestNetDataCmd shelleyGenesis -- Write genesis.json file to output - liftIO $ LBS.writeFile (outputDir "conway-genesis.json") $ Aeson.encode conwayGenesis' - liftIO $ LBS.writeFile (outputDir "shelley-genesis.json") $ Aeson.encode shelleyGenesis' - liftIO $ LBS.writeFile (outputDir "alonzo-genesis.json") $ Aeson.encode alonzoGenesis + forM_ + [ ("conway-genesis.json", WritePretty conwayGenesis') + , ("shelley-genesis.json", WritePretty shelleyGenesis') + , ("alonzo-genesis.json", WritePretty alonzoGenesis) + ] + $ \(filename, genesis) -> writeFileGenesis (outputDir filename) genesis where genesisDir = outputDir "genesis-keys" delegateDir = outputDir "delegate-keys"