Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

genesis creation: share code #973

Merged
merged 2 commits into from
Nov 20, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
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
Loading