88{-# LANGUAGE GADTs #-}
99{-# LANGUAGE NamedFieldPuns #-}
1010{-# LANGUAGE NumericUnderscores #-}
11+ {-# LANGUAGE RecordWildCards #-}
1112{-# LANGUAGE ScopedTypeVariables #-}
1213{-# LANGUAGE TupleSections #-}
1314{-# LANGUAGE TypeApplications #-}
@@ -24,6 +25,8 @@ module Cardano.CLI.EraBased.Run.Genesis.CreateTestnetData
2425where
2526
2627import Cardano.Api hiding (ConwayEra )
28+ import Cardano.Api.Byron (rationalToLovelacePortion )
29+ import qualified Cardano.Api.Byron as Byron hiding (GenesisParameters )
2730import Cardano.Api.Consensus (ShelleyGenesisStaking (.. ))
2831import Cardano.Api.Ledger (StrictMaybe (SNothing ))
2932import qualified Cardano.Api.Ledger as L
@@ -34,6 +37,8 @@ import Cardano.Api.Shelley (Hash (..), KESPeriod (KESPeriod),
3437 VrfKey , alonzoGenesisDefaults , conwayGenesisDefaults , shelleyGenesisDefaults ,
3538 toShelleyAddr , toShelleyNetwork , toShelleyStakeAddr )
3639
40+ import Cardano.CLI.Byron.Genesis (NewDirectory (NewDirectory ))
41+ import qualified Cardano.CLI.Byron.Genesis as Byron
3742import qualified Cardano.CLI.Commands.Node as Cmd
3843import Cardano.CLI.EraBased.Commands.Genesis as Cmd
3944import qualified Cardano.CLI.EraBased.Commands.Governance.Committee as CC
@@ -52,11 +57,14 @@ import Cardano.CLI.Types.Errors.GenesisCmdError
5257import Cardano.CLI.Types.Errors.NodeCmdError
5358import Cardano.CLI.Types.Errors.StakePoolCmdError
5459import Cardano.CLI.Types.Key
60+ import qualified Cardano.Crypto as Crypto hiding (Hash )
5561import qualified Cardano.Crypto.Hash as Crypto
5662import Cardano.Prelude (canonicalEncodePretty )
5763
5864import Control.DeepSeq (NFData , deepseq )
5965import Control.Monad (forM , forM_ , unless , void , when )
66+ import Data.Aeson (toJSON , (.=) )
67+ import qualified Data.Aeson as Aeson
6068import qualified Data.Aeson.Encode.Pretty as Aeson
6169import Data.Bifunctor (Bifunctor (.. ))
6270import Data.ByteString (ByteString )
@@ -67,7 +75,8 @@ import Data.Functor.Identity (Identity)
6775import Data.ListMap (ListMap (.. ))
6876import Data.Map.Strict (Map )
6977import qualified Data.Map.Strict as Map
70- import Data.Maybe (fromMaybe )
78+ import Data.Maybe (fromJust , fromMaybe )
79+ import Data.Ratio ((%) )
7180import qualified Data.Sequence.Strict as Seq
7281import qualified Data.Set as Set
7382import Data.String (fromString )
@@ -78,12 +87,13 @@ import GHC.Exts (IsList (..))
7887import GHC.Generics (Generic )
7988import GHC.Num (Natural )
8089import Lens.Micro ((^.) )
81- import System.Directory ( createDirectoryIfMissing )
90+ import System.Directory
8291import System.FilePath ((</>) )
8392import qualified System.Random as Random
8493import System.Random (StdGen )
8594import qualified Text.JSON.Canonical (ToJSON )
8695import Text.JSON.Canonical (parseCanonicalJSON , renderCanonicalJSON )
96+ import Text.Printf (printf )
8797
8898runGenesisKeyGenGenesisCmd
8999 :: GenesisKeyGenGenesisCmdArgs
@@ -241,7 +251,8 @@ runGenesisCreateTestNetDataCmd
241251 case networkId of
242252 Just networkFromFlag -> networkFromFlag
243253 Nothing -> fromNetworkMagic (NetworkMagic $ sgNetworkMagic shelleyGenesisInit)
244- shelleyGenesis = shelleyGenesisInit{sgNetworkMagic = unNetworkMagic (toNetworkMagic actualNetworkId)}
254+ actualNetworkWord32 = unNetworkMagic (toNetworkMagic actualNetworkId)
255+ shelleyGenesis = shelleyGenesisInit{sgNetworkMagic = actualNetworkWord32}
245256 -- {0 -> genesis-keys/genesis0/key.vkey, 1 -> genesis-keys/genesis1/key.vkey, ...}
246257 genesisVKeysPaths = mkPaths numGenesisKeys genesisDir " genesis" " key.vkey"
247258 -- {0 -> delegate-keys/delegate0/key.vkey, 1 -> delegate-keys/delegate1/key.vkey, ...}
@@ -278,7 +289,7 @@ runGenesisCreateTestNetDataCmd
278289
279290 -- Pools
280291 poolParams <- forM [1 .. numPools] $ \ index -> do
281- let poolDir = poolsDir </> ( " pool " <> show index)
292+ let poolDir = mkPoolDir index
282293
283294 createPoolCredentials desiredKeyOutputFormat poolDir
284295 -- Indexes of directories created on disk start at 1, but
@@ -377,7 +388,32 @@ runGenesisCreateTestNetDataCmd
377388 stuffedUtxoAddrs
378389 shelleyGenesis
379390
380- -- Write genesis.json file to output
391+ let byronGenesisFp = outputDir </> " byron.genesis.spec.json" -- This file is used by the performance testing team.
392+ void $ writeFileGenesis byronGenesisFp $ WritePretty defaultByronProtocolParamsJsonValue
393+
394+ let byronGenesisParameters = mkByronGenesisParameters actualNetworkWord32 byronGenesisFp shelleyGenesis'
395+ byronOutputDir = outputDir </> " byron-gen-command"
396+ (byronGenesis, byronSecrets) <-
397+ firstExceptT GenesisCmdByronError $ Byron. mkGenesis byronGenesisParameters
398+
399+ firstExceptT GenesisCmdByronError $
400+ Byron. dumpGenesis (NewDirectory byronOutputDir) byronGenesis byronSecrets
401+
402+ -- Move things from byron-gen-command to the nodes' directories
403+ forM_ [1 .. numPools] $ \ index -> do
404+ let poolDir = mkPoolDir index
405+ inputIndex = printf " %03d" (index - 1 ) -- mkGenesis is 0-based
406+ mkInputFile filePrefix suffix = byronOutputDir </> filePrefix <> inputIndex <> suffix
407+ liftIO $ do
408+ renameFile (mkInputFile " delegate-keys." " .key" ) (poolDir </> " byron-delegate.key" )
409+ renameFile (mkInputFile " delegation-cert." " .json" ) (poolDir </> " byron-delegation.cert" )
410+
411+ -- Install the byron genesis where it's supposed to be
412+ liftIO $ renameFile (byronOutputDir </> " genesis.json" ) (outputDir </> " byron-genesis.json" )
413+ -- Note that we leave some content in the "byron-gen-command" directory:
414+ -- 1. Deleting a non-empty directory on Windows is hard (yes -> https://github.com/haskell/directory/pull/108)
415+ -- 2. Users of cardano-testnet may use them
416+
381417 forM_
382418 [ (" conway-genesis.json" , WritePretty conwayGenesis')
383419 , (" shelley-genesis.json" , WritePretty shelleyGenesis')
@@ -392,6 +428,31 @@ runGenesisCreateTestNetDataCmd
392428 utxoKeysDir = outputDir </> " utxo-keys"
393429 poolsDir = outputDir </> " pools-keys"
394430 stakeDelegatorsDir = outputDir </> " stake-delegators"
431+ mkPoolDir idx = poolsDir </> (" pool" <> show idx)
432+ byronPoolNumber = max 1 numPools -- byron genesis creation needs a >= 1 number of pools
433+
434+ -- All arbitrary values come from cardano-testnet
435+ mkByronGenesisParameters actualNetworkWord32 byronGenesisFp shelleyGenesis =
436+ Byron. GenesisParameters {.. }
437+ where
438+ gpStartTime = sgSystemStart shelleyGenesis
439+ gpProtocolParamsFile = byronGenesisFp
440+ gpK = Byron. BlockCount 10
441+ protocolMagicId = Crypto. ProtocolMagicId actualNetworkWord32
442+ gpProtocolMagic = Crypto. AProtocolMagic (L. Annotated protocolMagicId () ) Crypto. RequiresMagic
443+ gpTestnetBalance =
444+ Byron. TestnetBalanceOptions
445+ 0 -- poor adresses
446+ byronPoolNumber -- delegate addresses (BFT nodes)
447+ (fromJust $ Byron. toByronLovelace $ L. Coin $ 3_000_000_000 * fromIntegral byronPoolNumber)
448+ 1
449+ gpFakeAvvmOptions =
450+ Byron. FakeAvvmOptions
451+ 0 -- avvm entry count
452+ (fromJust $ Byron. toByronLovelace $ L. Coin 0 ) -- avvm entry balance
453+ gpAvvmBalanceFactor = rationalToLovelacePortion $ 1 % 1
454+ gpSeed = Nothing
455+
395456 mkDelegationMapEntry
396457 :: Delegation -> (L. KeyHash L. Staking L. StandardCrypto , L. PoolParams L. StandardCrypto )
397458 mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d)
@@ -496,6 +557,37 @@ runGenesisCreateTestNetDataCmd
496557desiredKeyOutputFormat :: KeyOutputFormat
497558desiredKeyOutputFormat = KeyOutputFormatTextEnvelope
498559
560+ -- | We need to pass these values to create the Byron genesis file.
561+ -- The values here don't matter as the testnet conditions are ultimately determined
562+ -- by the Shelley genesis.
563+ defaultByronProtocolParamsJsonValue :: Aeson. Value
564+ defaultByronProtocolParamsJsonValue =
565+ Aeson. object
566+ [ " heavyDelThd" .= toJSON @ String " 300000000000"
567+ , " maxBlockSize" .= toJSON @ String " 2000000"
568+ , " maxTxSize" .= toJSON @ String " 4096"
569+ , " maxHeaderSize" .= toJSON @ String " 2000000"
570+ , " maxProposalSize" .= toJSON @ String " 700"
571+ , " mpcThd" .= toJSON @ String " 20000000000000"
572+ , " scriptVersion" .= toJSON @ Int 0
573+ , " slotDuration" .= toJSON @ String " 1000"
574+ , " softforkRule"
575+ .= Aeson. object
576+ [ " initThd" .= toJSON @ String " 900000000000000"
577+ , " minThd" .= toJSON @ String " 600000000000000"
578+ , " thdDecrement" .= toJSON @ String " 50000000000000"
579+ ]
580+ , " txFeePolicy"
581+ .= Aeson. object
582+ [ " multiplier" .= toJSON @ String " 43946000000"
583+ , " summand" .= toJSON @ String " 155381000000000"
584+ ]
585+ , " unlockStakeEpoch" .= toJSON @ String " 18446744073709551615"
586+ , " updateImplicit" .= toJSON @ String " 10000"
587+ , " updateProposalThd" .= toJSON @ String " 100000000000000"
588+ , " updateVoteThd" .= toJSON @ String " 1000000000000"
589+ ]
590+
499591writeREADME
500592 :: ()
501593 => FilePath
0 commit comments