Skip to content

Commit

Permalink
Merge pull request #973 from IntersectMBO/smelc/genesis-share-writing…
Browse files Browse the repository at this point in the history
…-code

genesis creation: share code
  • Loading branch information
smelc authored Nov 20, 2024
2 parents 3983bcb + 059da05 commit 5d0a4f1
Show file tree
Hide file tree
Showing 2 changed files with 56 additions and 43 deletions.
56 changes: 17 additions & 39 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -54,15 +55,13 @@ 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)
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)
Expand All @@ -72,7 +71,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 (..))
Expand All @@ -95,8 +93,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 ()
Expand Down Expand Up @@ -278,9 +274,12 @@ 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
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.

Expand Down Expand Up @@ -478,13 +477,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
Expand Down Expand Up @@ -688,10 +687,12 @@ runGenesisCreateStakedCmd
stuffedUtxoAddrs
template

liftIO $ LBS.writeFile (rootdir </> "genesis.json") $ encodePretty shelleyGenesis

void $ writeFileGenesis (rootdir </> "genesis.alonzo.json") $ WritePretty alonzoGenesis
void $ 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 $
Expand Down Expand Up @@ -1151,29 +1152,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
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,8 @@ module Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData
, runGenesisKeyGenDelegateCmd
, runGenesisCreateTestNetDataCmd
, runGenesisKeyGenDelegateVRF
, writeFileGenesis
, WriteFileGenesis (..)
)
where

Expand Down Expand Up @@ -50,13 +52,18 @@ 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
Expand All @@ -75,6 +82,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
Expand Down Expand Up @@ -165,6 +174,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 ()
Expand Down Expand Up @@ -346,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"
Expand Down

0 comments on commit 5d0a4f1

Please sign in to comment.