diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 4669cc1eb7..8c5739ba1f 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -93,6 +93,7 @@ library Cardano.CLI.EraBased.Run Cardano.CLI.EraBased.Run.Address Cardano.CLI.EraBased.Run.Address.Info + Cardano.CLI.EraBased.Run.CreateTestnetData Cardano.CLI.EraBased.Run.Genesis Cardano.CLI.EraBased.Run.Governance Cardano.CLI.EraBased.Run.Governance.Actions @@ -340,6 +341,7 @@ test-suite cardano-cli-golden , cardano-ledger-byron , cborg , containers + , directory , filepath , hedgehog ^>= 1.3 , hedgehog-extras ^>= 0.4.7.0 @@ -360,6 +362,7 @@ test-suite cardano-cli-golden Test.Golden.Byron.UpdateProposal Test.Golden.Byron.Vote Test.Golden.Byron.Witness + Test.Golden.CreateTestnetData Test.Golden.Conway.Transaction.Assemble Test.Golden.EraBased.Governance.AnswerPoll Test.Golden.EraBased.Governance.CreatePoll diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index 2db1b5a876..3a6b77eed8 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -7,6 +7,7 @@ module Cardano.CLI.EraBased.Commands.Genesis , GenesisCreateCmdArgs (..) , GenesisCreateCardanoCmdArgs (..) , GenesisCreateStakedCmdArgs (..) + , GenesisCreateTestNetDataCmdArgs (..) , GenesisKeyGenGenesisCmdArgs (..) , GenesisKeyGenDelegateCmdArgs (..) , GenesisKeyGenUTxOCmdArgs (..) @@ -27,6 +28,7 @@ data GenesisCmds era = GenesisCreate !GenesisCreateCmdArgs | GenesisCreateCardano !GenesisCreateCardanoCmdArgs | GenesisCreateStaked !GenesisCreateStakedCmdArgs + | GenesisCreateTestNetData !GenesisCreateTestNetDataCmdArgs | GenesisKeyGenGenesis !GenesisKeyGenGenesisCmdArgs | GenesisKeyGenDelegate !GenesisKeyGenDelegateCmdArgs | GenesisKeyGenUTxO !GenesisKeyGenUTxOCmdArgs @@ -81,6 +83,20 @@ data GenesisCreateStakedCmdArgs = GenesisCreateStakedCmdArgs , mStakePoolRelaySpecFile :: !(Maybe FilePath) -- ^ Relay specification filepath } deriving Show +data GenesisCreateTestNetDataCmdArgs = GenesisCreateTestNetDataCmdArgs + { specShelley :: !(Maybe FilePath) -- ^ Path to the @genesis-shelley@ file to use. If unspecified, a default one will be used if omitted. + , numGenesisKeys :: !Word -- ^ The number of genesis keys credentials to create and write to disk. + , numPools :: !Word -- ^ The number of stake pools credentials to create and write to disk. + , numStakeDelegators :: !Word -- ^ The number of delegators to pools to create and write to disk. + , numStuffedUtxo :: !Word -- ^ The number of UTxO accounts to make. They are "stuffed" because the credentials are not written to disk. + , numUtxoKeys :: !Word -- ^ The number of UTxO credentials to create and write to disk. + , supply :: !(Maybe Lovelace) -- ^ The number of Lovelace to distribute over initial, non-delegating stake holders. + , supplyDelegated :: !(Maybe Lovelace) -- ^ The number of Lovelace to distribute over delegating stake holders. + , networkId :: !NetworkId -- ^ The network ID to use. + , systemStart :: !(Maybe SystemStart) -- ^ The genesis start time. + , outputDir :: !FilePath -- ^ Directory where to write credentials and files. + } deriving Show + data GenesisKeyGenGenesisCmdArgs = GenesisKeyGenGenesisCmdArgs { verificationKeyPath :: !(VerificationKeyFile Out) , signingKeyPath :: !(SigningKeyFile Out) @@ -122,6 +138,8 @@ renderGenesisCmds = \case "genesis create-cardano" GenesisCreateStaked {} -> "genesis create-staked" + GenesisCreateTestNetData {} -> + "genesis create-testnet-data" GenesisKeyGenGenesis {} -> "genesis key-gen-genesis" GenesisKeyGenDelegate {} -> diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index 4dc8aa8664..44b70be812 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -86,6 +86,13 @@ pGenesisCmds envCli = [ "Create a staked Shelley genesis file from a genesis " , "template and genesis/delegation/spending keys." ] + , Just + $ subParser "create-testnet-data" + $ Opt.info (pGenesisCreateTestNetData envCli) + $ Opt.progDesc + $ mconcat + [ "Create data to use for starting a testnet." + ] , Just $ subParser "hash" $ Opt.info pGenesisHash @@ -191,6 +198,86 @@ pGenesisCreateStaked envCli = <*> pStuffedUtxoCount <*> Opt.optional pRelayJsonFp +pGenesisCreateTestNetData :: EnvCli -> Parser (GenesisCmds era) +pGenesisCreateTestNetData envCli = + fmap GenesisCreateTestNetData $ GenesisCreateTestNetDataCmdArgs + <$> (optional $ pSpecFile "shelley") + <*> pNumGenesisKeys + <*> pNumPools + <*> pNumStakeDelegs + <*> pNumStuffedUtxoCount + <*> pNumUtxoKeys + <*> pSupply + <*> pSupplyDelegated + <*> pNetworkId envCli + <*> pMaybeSystemStart + <*> pOutputDir + where + pSpecFile era = Opt.strOption $ mconcat + [ Opt.long $ "spec-" <> era + , Opt.metavar "FILE" + , Opt.help $ "The " <> era <> " specification file to use as input. A default one is generated if omitted." + ] + pNumGenesisKeys = Opt.option Opt.auto $ mconcat + [ Opt.long "genesis-keys" + , Opt.metavar "INT" + , Opt.help "The number of genesis keys to make (default is 3)." + , Opt.value 3 + ] + pNumPools :: Parser Word + pNumPools = + Opt.option Opt.auto $ mconcat + [ Opt.long "pools" + , Opt.metavar "INT" + , Opt.help "The number of stake pool credential sets to make (default is 0)." + , Opt.value 0 + ] + pNumStakeDelegs :: Parser Word + pNumStakeDelegs = + Opt.option Opt.auto $ mconcat + [ Opt.long "stake-delegators" + , Opt.metavar "INT" + , Opt.help "The number of stake delegator credential sets to make (default is 0)." + , Opt.value 0 + ] + pNumStuffedUtxoCount :: Parser Word + pNumStuffedUtxoCount = + Opt.option Opt.auto $ mconcat + [ Opt.long "stuffed-utxo" + , Opt.metavar "INT" + , Opt.help "The number of fake UTxO entries to generate (default is 0)." + , Opt.value 0 + ] + pNumUtxoKeys :: Parser Word + pNumUtxoKeys = + Opt.option Opt.auto $ mconcat + [ Opt.long "utxo-keys" + , Opt.metavar "INT" + , Opt.help "The number of UTxO keys to make (default is 0)." + , Opt.value 0 + ] + pSupply :: Parser (Maybe Lovelace) + pSupply = + Opt.optional $ fmap Lovelace $ Opt.option Opt.auto $ mconcat + [ Opt.long "supply" + , Opt.metavar "LOVELACE" + , Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial, non-delegating stake holders. Defaults to 1 million Ada (i.e. 10^12 Lovelace)." + , Opt.value 1000000000000 + ] + pSupplyDelegated :: Parser (Maybe Lovelace) + pSupplyDelegated = + Opt.optional $ fmap Lovelace $ Opt.option Opt.auto $ mconcat + [ Opt.long "supply-delegated" + , Opt.metavar "LOVELACE" + , Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial, delegating stake holders. Defaults to 1 million Ada (i.e. 10^12 Lovelace)." + , Opt.value 1000000000000 + ] + pOutputDir = Opt.strOption $ mconcat + [ Opt.long "out-dir" + , Opt.metavar "DIR" + , Opt.help "The directory where to generate the data. Created if not existing." + ] + pGenesisHash :: Parser (GenesisCmds era) pGenesisHash = GenesisHashFile <$> pGenesisFile "The genesis file." diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs new file mode 100644 index 0000000000..a42866443b --- /dev/null +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs @@ -0,0 +1,603 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE GADTs #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TupleSections #-} +{-# LANGUAGE TypeApplications #-} + +{- HLINT ignore "Redundant <$>" -} +{- HLINT ignore "Use let" -} + +module Cardano.CLI.EraBased.Run.CreateTestnetData + ( genStuffedAddress + , getCurrentTimePlus30 + , readAndDecodeShelleyGenesis + , runGenesisKeyGenUTxOCmd + , runGenesisKeyGenGenesisCmd + , runGenesisKeyGenDelegateCmd + , runGenesisCreateTestNetDataCmd + , runGenesisKeyGenDelegateVRF + , updateCreateStakedOutputTemplate + ) where + +import Cardano.Api +import Cardano.Api.Shelley + +import Cardano.CLI.EraBased.Commands.Genesis as Cmd +import qualified Cardano.CLI.EraBased.Commands.Node as Cmd +import qualified Cardano.CLI.EraBased.Run.Key as Key +import Cardano.CLI.EraBased.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd, + runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd) +import Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd) +import qualified Cardano.CLI.IO.Lazy as Lazy +import Cardano.CLI.Types.Common +import Cardano.CLI.Types.Errors.GenesisCmdError +import Cardano.CLI.Types.Errors.NodeCmdError +import Cardano.CLI.Types.Errors.StakePoolCmdError +import Cardano.CLI.Types.Key +import Cardano.Crypto.Hash (HashAlgorithm) +import qualified Cardano.Crypto.Hash as Hash +import qualified Cardano.Crypto.Random as Crypto +import qualified Cardano.Ledger.BaseTypes as Ledger +import Cardano.Ledger.Binary (ToCBOR (..)) +import Cardano.Ledger.Coin (Coin (..)) +import Cardano.Ledger.Core (ppMinUTxOValueL) +import Cardano.Ledger.Crypto (ADDRHASH, Crypto, StandardCrypto) +import Cardano.Ledger.Era () +import qualified Cardano.Ledger.Keys as Ledger +import qualified Cardano.Ledger.Shelley.API as Ledger +import Ouroboros.Consensus.Shelley.Node (ShelleyGenesisStaking (..)) + +import Control.DeepSeq (NFData, force) +import Control.Monad (forM, forM_, unless, void) +import Control.Monad.Except (MonadError (..), runExceptT) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Trans.Except (ExceptT) +import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, + newExceptT) +import qualified Data.Aeson as Aeson +import Data.Bifunctor (Bifunctor (..)) +import qualified Data.Binary.Get as Bin +import Data.ByteString (ByteString) +import qualified Data.ByteString.Lazy.Char8 as LBS +import Data.Coerce (coerce) +import Data.Data (Proxy (..)) +import Data.ListMap (ListMap (..)) +import qualified Data.ListMap as ListMap +import Data.Map.Strict (Map, fromList, toList) +import qualified Data.Map.Strict as Map +import Data.Maybe (fromMaybe) +import qualified Data.Sequence.Strict as Seq +import Data.String (fromString) +import qualified Data.Text as Text +import Data.Time (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime) +import Data.Word (Word64) +import GHC.Generics (Generic) +import Lens.Micro ((^.)) +import System.Directory (createDirectoryIfMissing) +import System.FilePath (()) +import qualified System.Random as Random +import System.Random (StdGen) + +import Crypto.Random (getRandomBytes) + + +runGenesisKeyGenGenesisCmd + :: GenesisKeyGenGenesisCmdArgs + -> ExceptT GenesisCmdError IO () +runGenesisKeyGenGenesisCmd + Cmd.GenesisKeyGenGenesisCmdArgs + { Cmd.verificationKeyPath + , Cmd.signingKeyPath + } = do + skey <- liftIO $ generateSigningKey AsGenesisKey + let vkey = getVerificationKey skey + firstExceptT GenesisCmdGenesisFileError . newExceptT $ do + void $ writeLazyByteStringFile signingKeyPath $ textEnvelopeToJSON (Just skeyDesc) skey + writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON (Just Key.genesisVkeyDesc) vkey + where + skeyDesc :: TextEnvelopeDescr + skeyDesc = "Genesis Signing Key" + + +runGenesisKeyGenDelegateCmd + :: GenesisKeyGenDelegateCmdArgs + -> ExceptT GenesisCmdError IO () +runGenesisKeyGenDelegateCmd + Cmd.GenesisKeyGenDelegateCmdArgs + { Cmd.verificationKeyPath + , Cmd.signingKeyPath + , Cmd.opCertCounterPath + } = do + skey <- liftIO $ generateSigningKey AsGenesisDelegateKey + let vkey = getVerificationKey skey + firstExceptT GenesisCmdGenesisFileError . newExceptT $ do + void $ writeLazyByteStringFile signingKeyPath + $ textEnvelopeToJSON (Just skeyDesc) skey + void $ writeLazyByteStringFile verificationKeyPath + $ textEnvelopeToJSON (Just Key.genesisVkeyDelegateDesc) vkey + writeLazyByteStringFile opCertCounterPath + $ textEnvelopeToJSON (Just certCtrDesc) + $ OperationalCertificateIssueCounter + initialCounter + (castVerificationKey vkey) -- Cast to a 'StakePoolKey' + where + skeyDesc, certCtrDesc :: TextEnvelopeDescr + skeyDesc = "Genesis delegate operator key" + certCtrDesc = "Next certificate issue number: " + <> fromString (show initialCounter) + + initialCounter :: Word64 + initialCounter = 0 + + +runGenesisKeyGenDelegateVRF :: + VerificationKeyFile Out + -> SigningKeyFile Out + -> ExceptT GenesisCmdError IO () +runGenesisKeyGenDelegateVRF vkeyPath skeyPath = do + skey <- liftIO $ generateSigningKey AsVrfKey + let vkey = getVerificationKey skey + firstExceptT GenesisCmdGenesisFileError . newExceptT $ do + void $ writeLazyByteStringFile skeyPath + $ textEnvelopeToJSON (Just skeyDesc) skey + writeLazyByteStringFile vkeyPath + $ textEnvelopeToJSON (Just vkeyDesc) vkey + where + skeyDesc, vkeyDesc :: TextEnvelopeDescr + skeyDesc = "VRF Signing Key" + vkeyDesc = "VRF Verification Key" + + +runGenesisKeyGenUTxOCmd + :: GenesisKeyGenUTxOCmdArgs + -> ExceptT GenesisCmdError IO () +runGenesisKeyGenUTxOCmd + Cmd.GenesisKeyGenUTxOCmdArgs + { Cmd.verificationKeyPath + , Cmd.signingKeyPath + } = do + skey <- liftIO $ generateSigningKey AsGenesisUTxOKey + let vkey = getVerificationKey skey + firstExceptT GenesisCmdGenesisFileError . newExceptT $ do + void $ writeLazyByteStringFile signingKeyPath + $ textEnvelopeToJSON (Just skeyDesc) skey + writeLazyByteStringFile verificationKeyPath + $ textEnvelopeToJSON (Just vkeyDesc) vkey + where + skeyDesc, vkeyDesc :: TextEnvelopeDescr + skeyDesc = "Genesis Initial UTxO Signing Key" + vkeyDesc = "Genesis Initial UTxO Verification Key" + + +runGenesisCreateTestNetDataCmd + :: GenesisCreateTestNetDataCmdArgs + -> ExceptT GenesisCmdError IO () +runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs + { networkId + , specShelley + , numGenesisKeys + , numPools + , numStakeDelegators + , numStuffedUtxo + , numUtxoKeys + , supply + , supplyDelegated + , systemStart + , outputDir } + = do + liftIO $ createDirectoryIfMissing False outputDir + shelleyGenesis <- + case specShelley of + Just shelleyPath -> + newExceptT $ readAndDecodeShelleyGenesis shelleyPath + Nothing -> do + -- No template given: a default file is created + pure $ shelleyGenesisDefaults { sgNetworkMagic = unNetworkMagic (toNetworkMagic networkId) } + + let -- {0 -> genesis-keys/genesis0/key.vkey, 1 -> genesis-keys/genesis1/key.vkey, ...} + genesisVKeysPaths = mkPaths numGenesisKeys (outputDir "genesis-keys") "genesis" "key.vkey" + -- {0 -> delegate-keys/delegate0/key.vkey, 1 -> delegate-keys/delegate1/key.vkey, ...} + delegateKeys = mkPaths numGenesisKeys (outputDir "delegate-keys") "delegate" "key.vkey" + -- {0 -> delegate-keys/delegate0/vrf.vkey, 1 -> delegate-keys/delegate1/vrf.vkey, ...} + delegateVrfKeys = mkPaths numGenesisKeys (outputDir "delegate-keys") "delegate" "vrf.vkey" + + forM_ [ 1 .. numGenesisKeys ] $ \index -> do + createGenesisKeys (genesisDir ("genesis" <> show index)) + createDelegateKeys keyOutputFormat (outputDir "delegate-keys" ("delegate" <> show index)) + + -- UTxO keys + let utxoKeys = [outputDir "utxo-keys" ("utxo" <> show index) "utxo.vkey" + | index <- [ 1 .. numUtxoKeys ]] + forM_ [ 1 .. numUtxoKeys ] $ \index -> + createUtxoKeys $ outputDir "utxo-keys" ("utxo" <> show index) + + let mayStakePoolRelays = Nothing -- TODO @smelc temporary? + + -- Pools + poolParams <- forM [ 1 .. numPools ] $ \index -> do + let poolsDir = outputDir "pools-keys" + poolDir = poolsDir ("pool" <> show index) + + createPoolCredentials keyOutputFormat poolDir + buildPoolParams networkId poolDir Nothing (fromMaybe mempty mayStakePoolRelays) + + -- Stake delegators + let (delegsPerPool, delegsRemaining) = divMod numStakeDelegators numPools + delegsForPool poolIx = if delegsRemaining /= 0 && poolIx == numPools + then delegsPerPool + else delegsPerPool + delegsRemaining + distribution = [pool | (pool, poolIx) <- zip poolParams [1 ..], _ <- [1 .. delegsForPool poolIx]] + + g <- Random.getStdGen + + -- Distribute M delegates across N pools: + delegations <- liftIO $ Lazy.forStateM g distribution $ flip computeInsecureDelegation networkId + + genDlgs <- readGenDelegsMap genesisVKeysPaths delegateKeys delegateVrfKeys + nonDelegAddrs <- readInitialFundAddresses utxoKeys networkId + start <- maybe (SystemStart <$> getCurrentTimePlus30) pure systemStart + + let network = toShelleyNetwork networkId + stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ genStuffedAddress network + + let stake = second Ledger.ppId . mkDelegationMapEntry <$> delegations + stakePools = [ (Ledger.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ] + delegAddrs = dInitialUtxoAddr <$> delegations + !shelleyGenesis' = + updateCreateStakedOutputTemplate + -- Shelley genesis parameters + start genDlgs supply (length nonDelegAddrs) nonDelegAddrs stakePools stake + supplyDelegated (length delegations) delegAddrs stuffedUtxoAddrs shelleyGenesis + + -- Write genesis.json file to output + liftIO $ LBS.writeFile (outputDir "genesis.json") $ Aeson.encode shelleyGenesis' + where + genesisDir = outputDir "genesis-keys" + keyOutputFormat = KeyOutputFormatTextEnvelope + mkDelegationMapEntry :: Delegation -> (Ledger.KeyHash Ledger.Staking StandardCrypto, Ledger.PoolParams StandardCrypto) + mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) + +-- @mkPaths numKeys dir segment filename@ returns the paths to the keys to generate. +-- For example @mkPaths 3 dir prefix fn.ext@ returns +-- [dir/segment1/fn.ext, dir/segment2/fn.ext, dir/segment3/fn.ext] +mkPaths :: Word -> String -> String -> String -> Map Int FilePath +mkPaths numKeys dir segment filename = + fromList [(fromIntegral idx, dir (segment <> show idx) filename) + | idx <- [1 .. numKeys]] + +genStuffedAddress :: Ledger.Network -> IO (AddressInEra ShelleyEra) +genStuffedAddress network = + shelleyAddressInEra ShelleyBasedEraShelley <$> + (ShelleyAddress + <$> pure network + <*> (Ledger.KeyHashObj . mkKeyHash . read64BitInt + <$> Crypto.runSecureRandom (getRandomBytes 8)) + <*> pure Ledger.StakeRefNull) + where + read64BitInt :: ByteString -> Int + read64BitInt = (fromIntegral :: Word64 -> Int) + . Bin.runGet Bin.getWord64le . LBS.fromStrict + + mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash.Hash h a + mkDummyHash _ = coerce . Ledger.hashWithSerialiser @h toCBOR + + mkKeyHash :: forall c discriminator. Crypto c => Int -> Ledger.KeyHash discriminator c + mkKeyHash = Ledger.KeyHash . mkDummyHash (Proxy @(ADDRHASH c)) + +createDelegateKeys :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO () +createDelegateKeys fmt dir = do + liftIO $ createDirectoryIfMissing True dir + runGenesisKeyGenDelegateCmd + Cmd.GenesisKeyGenDelegateCmdArgs + { Cmd.verificationKeyPath = File @(VerificationKey ()) $ dir "key.vkey" + , Cmd.signingKeyPath = onlyOut coldSK + , Cmd.opCertCounterPath = onlyOut opCertCtr + } + runGenesisKeyGenDelegateVRF + (File @(VerificationKey ()) $ dir "vrf.vkey") + (File @(SigningKey ()) $ dir "vrf.skey") + firstExceptT GenesisCmdNodeCmdError $ do + runNodeKeyGenKesCmd $ Cmd.NodeKeyGenKESCmdArgs + fmt + (onlyOut kesVK) + (File @(SigningKey ()) $ dir "kes.skey") + runNodeIssueOpCertCmd $ Cmd.NodeIssueOpCertCmdArgs + (VerificationKeyFilePath (onlyIn kesVK)) + (onlyIn coldSK) + opCertCtr + (KESPeriod 0) + (File $ dir "opcert.cert") + where + kesVK = File @(VerificationKey ()) $ dir "kes.vkey" + coldSK = File @(SigningKey ()) $ dir "key.skey" + opCertCtr = File $ dir "opcert.counter" + +createGenesisKeys :: FilePath -> ExceptT GenesisCmdError IO () +createGenesisKeys dir = do + liftIO $ createDirectoryIfMissing True dir + runGenesisKeyGenGenesisCmd + GenesisKeyGenGenesisCmdArgs + { verificationKeyPath = File @(VerificationKey ()) $ dir "key.vkey" + , signingKeyPath = File @(SigningKey ()) $ dir "key.skey" + } + +createUtxoKeys :: FilePath -> ExceptT GenesisCmdError IO () +createUtxoKeys dir = do + liftIO $ createDirectoryIfMissing True dir + runGenesisKeyGenUTxOCmd + Cmd.GenesisKeyGenUTxOCmdArgs + { Cmd.verificationKeyPath = File @(VerificationKey ()) $ dir "utxo.vkey" + , Cmd.signingKeyPath = File @(SigningKey ()) $ dir "utxo.skey" + } + +createPoolCredentials :: KeyOutputFormat -> FilePath -> ExceptT GenesisCmdError IO () +createPoolCredentials fmt dir = do + liftIO $ createDirectoryIfMissing True dir + firstExceptT GenesisCmdNodeCmdError $ do + runNodeKeyGenKesCmd $ Cmd.NodeKeyGenKESCmdArgs + fmt + (onlyOut kesVK) + (File @(SigningKey ()) $ dir "kes.skey") + runNodeKeyGenVrfCmd $ Cmd.NodeKeyGenVRFCmdArgs + fmt + (File @(VerificationKey ()) $ dir "vrf.vkey") + (File @(SigningKey ()) $ dir "vrf.skey") + runNodeKeyGenColdCmd $ Cmd.NodeKeyGenColdCmdArgs + fmt + (File @(VerificationKey ()) $ dir "cold.vkey") + (onlyOut coldSK) + (onlyOut opCertCtr) + runNodeIssueOpCertCmd $ Cmd.NodeIssueOpCertCmdArgs + (VerificationKeyFilePath (onlyIn kesVK)) + (onlyIn coldSK) + opCertCtr + (KESPeriod 0) + (File $ dir "opcert.cert") + firstExceptT GenesisCmdStakeAddressCmdError $ + runStakeAddressKeyGenCmd + fmt + (File @(VerificationKey ()) $ dir "staking-reward.vkey") + (File @(SigningKey ()) $ dir "staking-reward.skey") + where + kesVK = File @(VerificationKey ()) $ dir "kes.vkey" + coldSK = File @(SigningKey ()) $ dir "cold.skey" + opCertCtr = File $ dir "opcert.counter" + +data Delegation = Delegation + { dInitialUtxoAddr :: !(AddressInEra ShelleyEra) + , dDelegStaking :: !(Ledger.KeyHash Ledger.Staking StandardCrypto) + , dPoolParams :: !(Ledger.PoolParams StandardCrypto) + } + deriving (Generic, NFData) + +buildPoolParams + :: NetworkId + -> FilePath -- ^ File directory where the necessary pool credentials were created + -> Maybe Word + -> Map Word [Ledger.StakePoolRelay] -- ^ User submitted stake pool relay map + -> ExceptT GenesisCmdError IO (Ledger.PoolParams StandardCrypto) +buildPoolParams nw dir index specifiedRelays = do + StakePoolVerificationKey poolColdVK + <- firstExceptT (GenesisCmdStakePoolCmdError . StakePoolCmdReadFileError) + . newExceptT $ readFileTextEnvelope (AsVerificationKey AsStakePoolKey) poolColdVKF + + VrfVerificationKey poolVrfVK + <- firstExceptT (GenesisCmdNodeCmdError . NodeCmdReadFileError) + . newExceptT $ readFileTextEnvelope (AsVerificationKey AsVrfKey) poolVrfVKF + rewardsSVK + <- firstExceptT GenesisCmdTextEnvReadFileError + . newExceptT $ readFileTextEnvelope (AsVerificationKey AsStakeKey) poolRewardVKF + + pure Ledger.PoolParams + { Ledger.ppId = Ledger.hashKey poolColdVK + , Ledger.ppVrf = Ledger.hashVerKeyVRF poolVrfVK + , Ledger.ppPledge = Ledger.Coin 0 + , Ledger.ppCost = Ledger.Coin 0 + , Ledger.ppMargin = minBound + , Ledger.ppRewardAcnt = + toShelleyStakeAddr $ makeStakeAddress nw $ StakeCredentialByKey (verificationKeyHash rewardsSVK) + , Ledger.ppOwners = mempty + , Ledger.ppRelays = lookupPoolRelay specifiedRelays + , Ledger.ppMetadata = Ledger.SNothing + } + where + lookupPoolRelay + :: Map Word [Ledger.StakePoolRelay] -> Seq.StrictSeq Ledger.StakePoolRelay + lookupPoolRelay m = + case index of + Nothing -> mempty + Just index' -> maybe mempty Seq.fromList (Map.lookup index' m) + + strIndex = maybe "" show index + poolColdVKF = File $ dir "cold" ++ strIndex ++ ".vkey" + poolVrfVKF = File $ dir "vrf" ++ strIndex ++ ".vkey" + poolRewardVKF = File $ dir "staking-reward" ++ strIndex ++ ".vkey" + +-- | This function should only be used for testing purposes. +-- Keys returned by this function are not cryptographically secure. +computeInsecureDelegation + :: StdGen + -> NetworkId + -> Ledger.PoolParams StandardCrypto + -> IO (StdGen, Delegation) +computeInsecureDelegation g0 nw pool = do + (paymentVK, g1) <- first getVerificationKey <$> generateInsecureSigningKey g0 AsPaymentKey + (stakeVK , g2) <- first getVerificationKey <$> generateInsecureSigningKey g1 AsStakeKey + + let stakeAddressReference = StakeAddressByValue . StakeCredentialByKey . verificationKeyHash $ stakeVK + let initialUtxoAddr = makeShelleyAddress nw (PaymentCredentialByKey (verificationKeyHash paymentVK)) stakeAddressReference + + delegation <- pure $ force Delegation + { dInitialUtxoAddr = shelleyAddressInEra ShelleyBasedEraShelley initialUtxoAddr + , dDelegStaking = Ledger.hashKey (unStakeVerificationKey stakeVK) + , dPoolParams = pool + } + + pure (g2, delegation) + + +updateCreateStakedOutputTemplate + :: SystemStart -- ^ System start time + -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based) + -> Maybe Lovelace -- ^ Amount of lovelace not delegated + -> Int -- ^ Number of UTxO addresses that are delegating + -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating + -> [(Ledger.KeyHash 'Ledger.StakePool StandardCrypto, Ledger.PoolParams StandardCrypto)] -- ^ Pool map + -> [(Ledger.KeyHash 'Ledger.Staking StandardCrypto, Ledger.KeyHash 'Ledger.StakePool StandardCrypto)] -- ^ Delegaton map + -> Maybe Lovelace -- ^ Amount of lovelace to delegate + -> Int -- ^ Number of UTxO address for delegation + -> [AddressInEra ShelleyEra] -- ^ UTxO address for delegation + -> [AddressInEra ShelleyEra] -- ^ Stuffed UTxO addresses + -> ShelleyGenesis StandardCrypto -- ^ Template from which to build a genesis + -> ShelleyGenesis StandardCrypto -- ^ Updated genesis +updateCreateStakedOutputTemplate + (SystemStart start) + genDelegMap mAmountNonDeleg nUtxoAddrsNonDeleg utxoAddrsNonDeleg pools stake + amountDeleg + nUtxoAddrsDeleg utxoAddrsDeleg stuffedUtxoAddrs + template = do + let pparamsFromTemplate = sgProtocolParams template + shelleyGenesis = template + { sgSystemStart = start + , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin + , sgGenDelegs = shelleyDelKeys + , sgInitialFunds = ListMap.fromList + [ (toShelleyAddr addr, toShelleyLovelace v) + | (addr, v) <- + distribute (nonDelegCoin - subtractForTreasury) nUtxoAddrsNonDeleg utxoAddrsNonDeleg + ++ + distribute (delegCoin - subtractForTreasury) nUtxoAddrsDeleg utxoAddrsDeleg + ++ + mkStuffedUtxo stuffedUtxoAddrs + ] + , sgStaking = + ShelleyGenesisStaking + { sgsPools = ListMap pools + , sgsStake = ListMap stake + } + , sgProtocolParams = pparamsFromTemplate + } + shelleyGenesis + where + maximumLovelaceSupply :: Word64 + maximumLovelaceSupply = sgMaxLovelaceSupply template + -- If the initial funds are equal to the maximum funds, rewards cannot be created. + subtractForTreasury :: Integer + subtractForTreasury = nonDelegCoin `quot` 10 + nonDelegCoin, delegCoin :: Integer + nonDelegCoin = fromIntegral (maybe maximumLovelaceSupply unLovelace mAmountNonDeleg) + delegCoin = maybe 0 fromIntegral amountDeleg + + distribute :: Integer -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] + distribute funds nAddrs addrs = zip addrs (fmap Lovelace (coinPerAddr + remainder:repeat coinPerAddr)) + where coinPerAddr, remainder :: Integer + (coinPerAddr, remainder) = funds `divMod` fromIntegral nAddrs + + mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] + mkStuffedUtxo xs = (, Lovelace minUtxoVal) <$> xs + where Coin minUtxoVal = sgProtocolParams template ^. ppMinUTxOValueL + + shelleyDelKeys = Map.fromList + [ (gh, Ledger.GenDelegPair gdh h) + | (GenesisKeyHash gh, + (GenesisDelegateKeyHash gdh, VrfKeyHash h)) <- Map.toList genDelegMap + ] + + unLovelace :: Integral a => Lovelace -> a + unLovelace (Lovelace coin) = fromIntegral coin + +readAndDecodeShelleyGenesis + :: FilePath + -> IO (Either GenesisCmdError (ShelleyGenesis StandardCrypto)) +readAndDecodeShelleyGenesis fpath = runExceptT $ do + lbs <- handleIOExceptT (GenesisCmdGenesisFileReadError . FileIOError fpath) $ LBS.readFile fpath + firstExceptT (GenesisCmdGenesisFileDecodeError fpath . Text.pack) + . hoistEither $ Aeson.eitherDecode' lbs + +-- | Current UTCTime plus 30 seconds +getCurrentTimePlus30 :: ExceptT a IO UTCTime +getCurrentTimePlus30 = + plus30sec <$> liftIO getCurrentTime + where + plus30sec :: UTCTime -> UTCTime + plus30sec = addUTCTime (30 :: NominalDiffTime) + +readGenDelegsMap :: Map Int FilePath + -> Map Int FilePath + -> Map Int FilePath + -> ExceptT GenesisCmdError IO + (Map (Hash GenesisKey) + (Hash GenesisDelegateKey, Hash VrfKey)) +readGenDelegsMap genesisKeys delegateKeys delegateVrfKeys = do + gkm <- readKeys (AsVerificationKey AsGenesisKey) genesisKeys + dkm <- readKeys (AsVerificationKey AsGenesisDelegateKey) delegateKeys + vkm <- readKeys (AsVerificationKey AsVrfKey) delegateVrfKeys + + let combinedMap :: Map Int (VerificationKey GenesisKey, + (VerificationKey GenesisDelegateKey, + VerificationKey VrfKey)) + combinedMap = + Map.intersectionWith (,) + gkm + (Map.intersectionWith (,) dkm vkm) + + -- All the maps should have an identical set of keys. Complain if not. + let gkmExtra = gkm Map.\\ combinedMap + dkmExtra = dkm Map.\\ combinedMap + vkmExtra = vkm Map.\\ combinedMap + unless (Map.null gkmExtra && Map.null dkmExtra && Map.null vkmExtra) $ + throwError $ GenesisCmdMismatchedGenesisKeyFiles + (Map.keys gkm) (Map.keys dkm) (Map.keys vkm) + + let delegsMap :: Map (Hash GenesisKey) + (Hash GenesisDelegateKey, Hash VrfKey) + delegsMap = + Map.fromList [ (gh, (dh, vh)) + | (g,(d,v)) <- Map.elems combinedMap + , let gh = verificationKeyHash g + dh = verificationKeyHash d + vh = verificationKeyHash v + ] + + pure delegsMap + + +-- | Given a map @{0 -> someKey0, 1 -> someKey1}@, lift reading +-- the files to the map's values. +readKeys :: () + => HasTextEnvelope a + => Ord k + => AsType a + -> Map k FilePath + -> ExceptT GenesisCmdError IO (Map k a) +readKeys asType genesisVKeys = do + firstExceptT GenesisCmdTextEnvReadFileError $ + Map.fromList <$> + sequence + [ (,) ix <$> readKey (File file) + | (ix, file) <- toList genesisVKeys ] + where + readKey = newExceptT . readFileTextEnvelope asType + + +readInitialFundAddresses :: [FilePath] -> NetworkId + -> ExceptT GenesisCmdError IO [AddressInEra ShelleyEra] +readInitialFundAddresses utxoKeys nw = do + vkeys <- firstExceptT GenesisCmdTextEnvReadFileError $ + sequence + [ newExceptT $ + readFileTextEnvelope (AsVerificationKey AsGenesisUTxOKey) + (File file) + | file <- utxoKeys ] + return [ addr | vkey <- vkeys + , let vkh = verificationKeyHash (castVerificationKey vkey) + addr = makeShelleyAddressInEra ShelleyBasedEraShelley nw (PaymentCredentialByKey vkh) + NoStakeAddress + ] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 86c4289572..54cf0205f7 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -15,6 +15,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE NamedFieldPuns #-} +{- HLINT ignore "Replace case with maybe" -} {- HLINT ignore "Reduce duplication" -} {- HLINT ignore "Redundant <$>" -} {- HLINT ignore "Use let" -} @@ -27,15 +28,10 @@ module Cardano.CLI.EraBased.Run.Genesis , runGenesisCreateCmd , runGenesisCreateStakedCmd , runGenesisHashFileCmd - , runGenesisKeyGenDelegateCmd - , runGenesisKeyGenGenesisCmd - , runGenesisKeyGenUTxOCmd , runGenesisKeyHashCmd , runGenesisTxInCmd , runGenesisVerKeyCmd - , readAndDecodeShelleyGenesis - -- * Protocol Parameters , readProtocolParameters ) where @@ -58,7 +54,7 @@ import Cardano.CLI.Byron.Genesis as Byron import qualified Cardano.CLI.Byron.Key as Byron import Cardano.CLI.EraBased.Commands.Genesis as Cmd import qualified Cardano.CLI.EraBased.Commands.Node as Cmd -import qualified Cardano.CLI.EraBased.Run.Key as Key +import qualified Cardano.CLI.EraBased.Run.CreateTestnetData as TN import Cardano.CLI.EraBased.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd, runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd) import Cardano.CLI.EraBased.Run.StakeAddress (runStakeAddressKeyGenCmd) @@ -70,18 +66,15 @@ import Cardano.CLI.Types.Errors.ProtocolParamsError import Cardano.CLI.Types.Errors.StakePoolCmdError import Cardano.CLI.Types.Key import qualified Cardano.Crypto as CC -import Cardano.Crypto.Hash (HashAlgorithm) import qualified Cardano.Crypto.Hash as Crypto -import qualified Cardano.Crypto.Hash as Hash -import qualified Cardano.Crypto.Random as Crypto import qualified Cardano.Crypto.Signing as Byron import qualified Cardano.Ledger.Alonzo.Genesis as Alonzo import qualified Cardano.Ledger.BaseTypes as Ledger -import Cardano.Ledger.Binary (Annotated (Annotated), ToCBOR (..)) +import Cardano.Ledger.Binary (Annotated (Annotated)) import Cardano.Ledger.Coin (Coin (..)) import qualified Cardano.Ledger.Conway.Genesis as Conway import Cardano.Ledger.Core (ppMinUTxOValueL) -import Cardano.Ledger.Crypto (ADDRHASH, Crypto, StandardCrypto) +import Cardano.Ledger.Crypto (StandardCrypto) import Cardano.Ledger.Era () import qualified Cardano.Ledger.Keys as Ledger import qualified Cardano.Ledger.Shelley.API as Ledger @@ -92,7 +85,7 @@ import Ouroboros.Consensus.Shelley.Node (ShelleyGenesisStaking (..)) import Control.DeepSeq (NFData, force) import Control.Monad (forM, forM_, unless, when) -import Control.Monad.Except (MonadError (..), runExceptT) +import Control.Monad.Except (MonadError (..)) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT, throwE, withExceptT) import Control.Monad.Trans.Except.Extra (firstExceptT, handleIOExceptT, hoistEither, left, @@ -102,31 +95,25 @@ import qualified Data.Aeson as Aeson import Data.Aeson.Encode.Pretty (encodePretty) import qualified Data.Aeson.KeyMap as Aeson import Data.Bifunctor (Bifunctor (..)) -import qualified Data.Binary.Get as Bin import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as LBS import Data.Char (isDigit) -import Data.Coerce (coerce) -import Data.Data (Proxy (..)) import Data.Either (fromRight) import Data.Fixed (Fixed (MkFixed)) import Data.Function (on) import Data.Functor (void) -import Data.Functor.Identity +import Data.Functor.Identity (Identity) import qualified Data.List as List import qualified Data.List.Split as List -import Data.ListMap (ListMap (..)) import qualified Data.ListMap as ListMap import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import Data.Maybe (fromMaybe) import qualified Data.Sequence.Strict as Seq -import Data.String (fromString) import Data.Text (Text) import qualified Data.Text as Text import qualified Data.Text.IO as Text -import Data.Time.Clock (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime) import Data.Word (Word64) import qualified Data.Yaml as Yaml import GHC.Generics (Generic) @@ -141,13 +128,12 @@ import qualified Text.JSON.Canonical (ToJSON) import Text.JSON.Canonical (parseCanonicalJSON, renderCanonicalJSON) import Text.Read (readMaybe) -import Crypto.Random as Crypto runGenesisCmds :: GenesisCmds era -> ExceptT GenesisCmdError IO () runGenesisCmds = \case - GenesisKeyGenGenesis args -> runGenesisKeyGenGenesisCmd args - GenesisKeyGenDelegate args -> runGenesisKeyGenDelegateCmd args - GenesisKeyGenUTxO args -> runGenesisKeyGenUTxOCmd args + GenesisKeyGenGenesis args -> TN.runGenesisKeyGenGenesisCmd args + GenesisKeyGenDelegate args -> TN.runGenesisKeyGenDelegateCmd args + GenesisKeyGenUTxO args -> TN.runGenesisKeyGenUTxOCmd args GenesisCmdKeyHash vk -> runGenesisKeyHashCmd vk GenesisVerKey args -> runGenesisVerKeyCmd args GenesisTxIn args -> runGenesisTxInCmd args @@ -155,96 +141,9 @@ runGenesisCmds = \case GenesisCreate args -> runGenesisCreateCmd args GenesisCreateCardano args -> runGenesisCreateCardanoCmd args GenesisCreateStaked args -> runGenesisCreateStakedCmd args + GenesisCreateTestNetData args -> TN.runGenesisCreateTestNetDataCmd args GenesisHashFile gf -> runGenesisHashFileCmd gf -runGenesisKeyGenGenesisCmd - :: GenesisKeyGenGenesisCmdArgs - -> ExceptT GenesisCmdError IO () -runGenesisKeyGenGenesisCmd - Cmd.GenesisKeyGenGenesisCmdArgs - { Cmd.verificationKeyPath - , Cmd.signingKeyPath - } = do - skey <- liftIO $ generateSigningKey AsGenesisKey - let vkey = getVerificationKey skey - firstExceptT GenesisCmdGenesisFileError . newExceptT $ do - void $ writeLazyByteStringFile signingKeyPath $ textEnvelopeToJSON (Just skeyDesc) skey - writeLazyByteStringFile verificationKeyPath $ textEnvelopeToJSON (Just Key.genesisVkeyDesc) vkey - where - skeyDesc :: TextEnvelopeDescr - skeyDesc = "Genesis Signing Key" - - -runGenesisKeyGenDelegateCmd - :: GenesisKeyGenDelegateCmdArgs - -> ExceptT GenesisCmdError IO () -runGenesisKeyGenDelegateCmd - Cmd.GenesisKeyGenDelegateCmdArgs - { Cmd.verificationKeyPath - , Cmd.signingKeyPath - , Cmd.opCertCounterPath - } = do - skey <- liftIO $ generateSigningKey AsGenesisDelegateKey - let vkey = getVerificationKey skey - firstExceptT GenesisCmdGenesisFileError . newExceptT $ do - void $ writeLazyByteStringFile signingKeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - void $ writeLazyByteStringFile verificationKeyPath - $ textEnvelopeToJSON (Just Key.genesisVkeyDelegateDesc) vkey - writeLazyByteStringFile opCertCounterPath - $ textEnvelopeToJSON (Just certCtrDesc) - $ OperationalCertificateIssueCounter - initialCounter - (castVerificationKey vkey) -- Cast to a 'StakePoolKey' - where - skeyDesc, certCtrDesc :: TextEnvelopeDescr - skeyDesc = "Genesis delegate operator key" - certCtrDesc = "Next certificate issue number: " - <> fromString (show initialCounter) - - initialCounter :: Word64 - initialCounter = 0 - - -runGenesisKeyGenDelegateVRF :: - VerificationKeyFile Out - -> SigningKeyFile Out - -> ExceptT GenesisCmdError IO () -runGenesisKeyGenDelegateVRF vkeyPath skeyPath = do - skey <- liftIO $ generateSigningKey AsVrfKey - let vkey = getVerificationKey skey - firstExceptT GenesisCmdGenesisFileError . newExceptT $ do - void $ writeLazyByteStringFile skeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - writeLazyByteStringFile vkeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - where - skeyDesc, vkeyDesc :: TextEnvelopeDescr - skeyDesc = "VRF Signing Key" - vkeyDesc = "VRF Verification Key" - - -runGenesisKeyGenUTxOCmd - :: GenesisKeyGenUTxOCmdArgs - -> ExceptT GenesisCmdError IO () -runGenesisKeyGenUTxOCmd - Cmd.GenesisKeyGenUTxOCmdArgs - { Cmd.verificationKeyPath - , Cmd.signingKeyPath - } = do - skey <- liftIO $ generateSigningKey AsGenesisUTxOKey - let vkey = getVerificationKey skey - firstExceptT GenesisCmdGenesisFileError . newExceptT $ do - void $ writeLazyByteStringFile signingKeyPath - $ textEnvelopeToJSON (Just skeyDesc) skey - writeLazyByteStringFile verificationKeyPath - $ textEnvelopeToJSON (Just vkeyDesc) vkey - where - skeyDesc, vkeyDesc :: TextEnvelopeDescr - skeyDesc = "Genesis Initial UTxO Signing Key" - vkeyDesc = "Genesis Initial UTxO Verification Key" - - runGenesisKeyHashCmd :: VerificationKeyFile In -> ExceptT GenesisCmdError IO () runGenesisKeyHashCmd vkeyPath = do vkey <- firstExceptT GenesisCmdTextEnvReadFileError . newExceptT $ @@ -382,7 +281,7 @@ runGenesisCreateCmd genDlgs <- readGenDelegsMap gendir deldir utxoAddrs <- readInitialFundAddresses utxodir network - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart + start <- maybe (SystemStart <$> TN.getCurrentTimePlus30) pure mSystemStart let shelleyGenesis = updateTemplate @@ -484,7 +383,7 @@ runGenesisCreateCardanoCmd , Cmd.conwayGenesisTemplate , Cmd.mNodeConfigTemplate } = do - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart + start <- maybe (SystemStart <$> TN.getCurrentTimePlus30) pure mSystemStart (byronGenesis', byronSecrets) <- convertToShelleyError $ Byron.mkGenesis $ byronParams start let byronGenesis = byronGenesis' @@ -523,7 +422,7 @@ runGenesisCreateCardanoCmd , sgSystemStart = getSystemStart start , sgSlotLength = secondsToNominalDiffTimeMicro $ MkFixed (fromIntegral slotLength) * 1000 } - shelleyGenesisTemplate' <- liftIO $ overrideShelleyGenesis . fromRight (error "shelley genesis template not found") <$> readAndDecodeShelleyGenesis shelleyGenesisTemplate + shelleyGenesisTemplate' <- liftIO $ overrideShelleyGenesis . fromRight (error "shelley genesis template not found") <$> TN.readAndDecodeShelleyGenesis shelleyGenesisTemplate alonzoGenesis <- readAlonzoGenesis alonzoGenesisTemplate conwayGenesis <- readConwayGenesis conwayGenesisTemplate (delegateMap, vrfKeys, kesKeys, opCerts) <- liftIO $ generateShelleyNodeSecrets shelleyDelegateKeys shelleyGenesisvkeys @@ -643,7 +542,7 @@ runGenesisCreateStakedCmd , Cmd.mSystemStart , Cmd.mNonDelegatedSupply , Cmd.delegatedSupply - , Cmd.network + , Cmd.network = networkId , Cmd.numBulkPoolCredFiles , Cmd.numBulkPoolsPerFile , Cmd.numStuffedUtxo @@ -685,7 +584,7 @@ runGenesisCreateStakedCmd poolParams <- forM [ 1 .. numPools ] $ \index -> do createPoolCredentials keyOutputFormat pooldir index - buildPoolParams network pooldir index (fromMaybe mempty mayStakePoolRelays) + buildPoolParams networkId pooldir (Just index) (fromMaybe mempty mayStakePoolRelays) when (numBulkPoolCredFiles * numBulkPoolsPerFile > numPools) $ left $ GenesisCmdTooFewPoolsForBulkCreds numPools numBulkPoolCredFiles numBulkPoolsPerFile @@ -706,24 +605,25 @@ runGenesisCreateStakedCmd g <- Random.getStdGen -- Distribute M delegates across N pools: - delegations <- liftIO $ Lazy.forStateM g distribution $ flip computeInsecureDelegation network + delegations <- liftIO $ Lazy.forStateM g distribution $ flip computeInsecureDelegation networkId let numDelegations = length delegations genDlgs <- readGenDelegsMap gendir deldir - nonDelegAddrs <- readInitialFundAddresses utxodir network - start <- maybe (SystemStart <$> getCurrentTimePlus30) pure mSystemStart + nonDelegAddrs <- readInitialFundAddresses utxodir networkId + start <- maybe (SystemStart <$> TN.getCurrentTimePlus30) pure mSystemStart - stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) genStuffedAddress + let network = toShelleyNetwork networkId + stuffedUtxoAddrs <- liftIO $ Lazy.replicateM (fromIntegral numStuffedUtxo) $ TN.genStuffedAddress network let stake = second Ledger.ppId . mkDelegationMapEntry <$> delegations stakePools = [ (Ledger.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ] delegAddrs = dInitialUtxoAddr <$> delegations !shelleyGenesis = - updateCreateStakedOutputTemplate + TN.updateCreateStakedOutputTemplate -- Shelley genesis parameters start genDlgs mNonDelegatedSupply (length nonDelegAddrs) nonDelegAddrs stakePools stake - delegatedSupply numDelegations delegAddrs stuffedUtxoAddrs template + (Just delegatedSupply) numDelegations delegAddrs stuffedUtxoAddrs template liftIO $ LBS.writeFile (rootdir "genesis.json") $ Aeson.encode shelleyGenesis @@ -750,41 +650,22 @@ runGenesisCreateStakedCmd | numBulkPoolCredFiles * numBulkPoolsPerFile > 0 ] where - adjustTemplate t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic network) } + adjustTemplate t = t { sgNetworkMagic = unNetworkMagic (toNetworkMagic networkId) } mkDelegationMapEntry :: Delegation -> (Ledger.KeyHash Ledger.Staking StandardCrypto, Ledger.PoolParams StandardCrypto) mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) - genStuffedAddress :: IO (AddressInEra ShelleyEra) - genStuffedAddress = - shelleyAddressInEra ShelleyBasedEraShelley <$> - (ShelleyAddress - <$> pure Ledger.Testnet - <*> (Ledger.KeyHashObj . mkKeyHash . read64BitInt - <$> Crypto.runSecureRandom (getRandomBytes 8)) - <*> pure Ledger.StakeRefNull) - - read64BitInt :: ByteString -> Int - read64BitInt = (fromIntegral :: Word64 -> Int) - . Bin.runGet Bin.getWord64le . LBS.fromStrict - - mkDummyHash :: forall h a. HashAlgorithm h => Proxy h -> Int -> Hash.Hash h a - mkDummyHash _ = coerce . Ledger.hashWithSerialiser @h toCBOR - - mkKeyHash :: forall c discriminator. Crypto c => Int -> Ledger.KeyHash discriminator c - mkKeyHash = Ledger.KeyHash . mkDummyHash (Proxy @(ADDRHASH c)) - -- ------------------------------------------------------------------------------------------------- createDelegateKeys :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdError IO () createDelegateKeys fmt dir index = do liftIO $ createDirectoryIfMissing False dir - runGenesisKeyGenDelegateCmd + TN.runGenesisKeyGenDelegateCmd Cmd.GenesisKeyGenDelegateCmdArgs { Cmd.verificationKeyPath = File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vkey" , Cmd.signingKeyPath = onlyOut coldSK , Cmd.opCertCounterPath = onlyOut opCertCtr } - runGenesisKeyGenDelegateVRF + TN.runGenesisKeyGenDelegateVRF (File @(VerificationKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.vkey") (File @(SigningKey ()) $ dir "delegate" ++ strIndex ++ ".vrf.skey") firstExceptT GenesisCmdNodeCmdError $ do @@ -808,7 +689,7 @@ createGenesisKeys :: FilePath -> Word -> ExceptT GenesisCmdError IO () createGenesisKeys dir index = do liftIO $ createDirectoryIfMissing False dir let strIndex = show index - runGenesisKeyGenGenesisCmd + TN.runGenesisKeyGenGenesisCmd GenesisKeyGenGenesisCmdArgs { verificationKeyPath = File @(VerificationKey ()) $ dir "genesis" ++ strIndex ++ ".vkey" , signingKeyPath = File @(SigningKey ()) $ dir "genesis" ++ strIndex ++ ".skey" @@ -818,7 +699,7 @@ createUtxoKeys :: FilePath -> Word -> ExceptT GenesisCmdError IO () createUtxoKeys dir index = do liftIO $ createDirectoryIfMissing False dir let strIndex = show index - runGenesisKeyGenUTxOCmd + TN.runGenesisKeyGenUTxOCmd Cmd.GenesisKeyGenUTxOCmdArgs { Cmd.verificationKeyPath = File @(VerificationKey ()) $ dir "utxo" ++ strIndex ++ ".vkey" , Cmd.signingKeyPath = File @(SigningKey ()) $ dir "utxo" ++ strIndex ++ ".skey" @@ -868,7 +749,7 @@ data Delegation = Delegation buildPoolParams :: NetworkId -> FilePath -- ^ File directory where the necessary pool credentials were created - -> Word + -> Maybe Word -> Map Word [Ledger.StakePoolRelay] -- ^ User submitted stake pool relay map -> ExceptT GenesisCmdError IO (Ledger.PoolParams StandardCrypto) buildPoolParams nw dir index specifiedRelays = do @@ -898,9 +779,12 @@ buildPoolParams nw dir index specifiedRelays = do where lookupPoolRelay :: Map Word [Ledger.StakePoolRelay] -> Seq.StrictSeq Ledger.StakePoolRelay - lookupPoolRelay m = maybe mempty Seq.fromList (Map.lookup index m) + lookupPoolRelay m = + case index of + Nothing -> mempty + Just index' -> maybe mempty Seq.fromList (Map.lookup index' m) - strIndex = show index + strIndex = maybe "" show index poolColdVKF = File $ dir "cold" ++ strIndex ++ ".vkey" poolVrfVKF = File $ dir "vrf" ++ strIndex ++ ".vkey" poolRewardVKF = File $ dir "staking-reward" ++ strIndex ++ ".vkey" @@ -953,14 +837,6 @@ computeInsecureDelegation g0 nw pool = do pure (g2, delegation) --- | Current UTCTime plus 30 seconds -getCurrentTimePlus30 :: ExceptT a IO UTCTime -getCurrentTimePlus30 = - plus30sec <$> liftIO getCurrentTime - where - plus30sec :: UTCTime -> UTCTime - plus30sec = addUTCTime (30 :: NominalDiffTime) - -- | Attempts to read Shelley genesis from disk -- and if not found creates a default Shelley genesis. readShelleyGenesisWithDefault @@ -968,7 +844,7 @@ readShelleyGenesisWithDefault -> (ShelleyGenesis StandardCrypto -> ShelleyGenesis StandardCrypto) -> ExceptT GenesisCmdError IO (ShelleyGenesis StandardCrypto) readShelleyGenesisWithDefault fpath adjustDefaults = do - newExceptT (readAndDecodeShelleyGenesis fpath) + newExceptT (TN.readAndDecodeShelleyGenesis fpath) `catchError` \err -> case err of GenesisCmdGenesisFileReadError (FileIOError _ ioe) @@ -983,14 +859,6 @@ readShelleyGenesisWithDefault fpath adjustDefaults = do LBS.writeFile fpath (encode defaults) return defaults -readAndDecodeShelleyGenesis - :: FilePath - -> IO (Either GenesisCmdError (ShelleyGenesis StandardCrypto)) -readAndDecodeShelleyGenesis fpath = runExceptT $ do - lbs <- handleIOExceptT (GenesisCmdGenesisFileReadError . FileIOError fpath) $ LBS.readFile fpath - firstExceptT (GenesisCmdGenesisFileDecodeError fpath . Text.pack) - . hoistEither $ Aeson.eitherDecode' lbs - updateTemplate :: SystemStart -- ^ System start time -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based) @@ -1069,76 +937,6 @@ updateTemplate (SystemStart start) unLovelace :: Integral a => Lovelace -> a unLovelace (Lovelace coin) = fromIntegral coin -updateCreateStakedOutputTemplate - :: SystemStart -- ^ System start time - -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based) - -> Maybe Lovelace -- ^ Amount of lovelace not delegated - -> Int -- ^ Number of UTxO addresses that are delegating - -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating - -> [(Ledger.KeyHash 'Ledger.StakePool StandardCrypto, Ledger.PoolParams StandardCrypto)] -- ^ Pool map - -> [(Ledger.KeyHash 'Ledger.Staking StandardCrypto, Ledger.KeyHash 'Ledger.StakePool StandardCrypto)] -- ^ Delegaton map - -> Lovelace -- ^ Amount of lovelace to delegate - -> Int -- ^ Number of UTxO address for delegationg - -> [AddressInEra ShelleyEra] -- ^ UTxO address for delegationg - -> [AddressInEra ShelleyEra] -- ^ Stuffed UTxO addresses - -> ShelleyGenesis StandardCrypto -- ^ Template from which to build a genesis - -> ShelleyGenesis StandardCrypto -- ^ Updated genesis -updateCreateStakedOutputTemplate - (SystemStart start) - genDelegMap mAmountNonDeleg nUtxoAddrsNonDeleg utxoAddrsNonDeleg pools stake - (Lovelace amountDeleg) - nUtxoAddrsDeleg utxoAddrsDeleg stuffedUtxoAddrs - template = do - let pparamsFromTemplate = sgProtocolParams template - shelleyGenesis = template - { sgSystemStart = start - , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin - , sgGenDelegs = shelleyDelKeys - , sgInitialFunds = ListMap.fromList - [ (toShelleyAddr addr, toShelleyLovelace v) - | (addr, v) <- - distribute (nonDelegCoin - subtractForTreasury) nUtxoAddrsNonDeleg utxoAddrsNonDeleg - ++ - distribute (delegCoin - subtractForTreasury) nUtxoAddrsDeleg utxoAddrsDeleg - ++ - mkStuffedUtxo stuffedUtxoAddrs - ] - , sgStaking = - ShelleyGenesisStaking - { sgsPools = ListMap pools - , sgsStake = ListMap stake - } - , sgProtocolParams = pparamsFromTemplate - } - shelleyGenesis - where - maximumLovelaceSupply :: Word64 - maximumLovelaceSupply = sgMaxLovelaceSupply template - -- If the initial funds are equal to the maximum funds, rewards cannot be created. - subtractForTreasury :: Integer - subtractForTreasury = nonDelegCoin `quot` 10 - nonDelegCoin, delegCoin :: Integer - nonDelegCoin = fromIntegral (maybe maximumLovelaceSupply unLovelace mAmountNonDeleg) - delegCoin = fromIntegral amountDeleg - - distribute :: Integer -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] - distribute funds nAddrs addrs = zip addrs (fmap Lovelace (coinPerAddr + remainder:repeat coinPerAddr)) - where coinPerAddr, remainder :: Integer - (,) coinPerAddr remainder = funds `divMod` fromIntegral nAddrs - - mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)] - mkStuffedUtxo xs = (, Lovelace minUtxoVal) <$> xs - where Coin minUtxoVal = sgProtocolParams template ^. ppMinUTxOValueL - - shelleyDelKeys = Map.fromList - [ (gh, Ledger.GenDelegPair gdh h) - | (GenesisKeyHash gh, - (GenesisDelegateKeyHash gdh, VrfKeyHash h)) <- Map.toList genDelegMap - ] - - unLovelace :: Integral a => Lovelace -> a - unLovelace (Lovelace coin) = fromIntegral coin - writeFileGenesis :: FilePath -> WriteFileGenesis @@ -1152,7 +950,7 @@ writeFileGenesis fpath genesis = do WritePretty a -> LBS.toStrict $ encodePretty a WriteCanonical a -> LBS.toStrict . renderCanonicalJSON - . either (error "error parsing json that was just encoded!?") id + . either (error . ("error parsing json that was just encoded!? " ++) . show) id . parseCanonicalJSON . canonicalEncodePretty $ a diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs index 39da1f183a..39d35d5b94 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Query.hs @@ -45,7 +45,7 @@ import Cardano.Api.Pretty import Cardano.Api.Shelley hiding (QueryInShelleyBasedEra (..)) import qualified Cardano.CLI.EraBased.Commands.Query as Cmd -import Cardano.CLI.EraBased.Run.Genesis (readAndDecodeShelleyGenesis) +import Cardano.CLI.EraBased.Run.CreateTestnetData (readAndDecodeShelleyGenesis) import Cardano.CLI.Helpers import Cardano.CLI.Read import Cardano.CLI.Types.Common diff --git a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs index c50ff9c396..b69a5e526b 100644 --- a/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/Legacy/Run/Genesis.hs @@ -15,6 +15,7 @@ import Cardano.Chain.Common (BlockCount) import Cardano.CLI.EraBased.Commands.Genesis (GenesisKeyGenGenesisCmdArgs (GenesisKeyGenGenesisCmdArgs)) import qualified Cardano.CLI.EraBased.Commands.Genesis as Cmd +import qualified Cardano.CLI.EraBased.Run.CreateTestnetData as CreateTestnetData import Cardano.CLI.EraBased.Run.Genesis import Cardano.CLI.Legacy.Commands.Genesis import Cardano.CLI.Types.Common @@ -51,7 +52,7 @@ runLegacyGenesisKeyGenGenesisCmd :: () => VerificationKeyFile Out -> SigningKeyFile Out -> ExceptT GenesisCmdError IO () -runLegacyGenesisKeyGenGenesisCmd vk sk = runGenesisKeyGenGenesisCmd $ GenesisKeyGenGenesisCmdArgs vk sk +runLegacyGenesisKeyGenGenesisCmd vk sk = CreateTestnetData.runGenesisKeyGenGenesisCmd $ GenesisKeyGenGenesisCmdArgs vk sk runLegacyGenesisKeyGenDelegateCmd :: () => VerificationKeyFile Out @@ -59,7 +60,7 @@ runLegacyGenesisKeyGenDelegateCmd :: () -> OpCertCounterFile Out -> ExceptT GenesisCmdError IO () runLegacyGenesisKeyGenDelegateCmd vkf skf okf = - runGenesisKeyGenDelegateCmd + CreateTestnetData.runGenesisKeyGenDelegateCmd Cmd.GenesisKeyGenDelegateCmdArgs { Cmd.verificationKeyPath = vkf , Cmd.signingKeyPath = skf @@ -71,7 +72,7 @@ runLegacyGenesisKeyGenUTxOCmd :: () -> SigningKeyFile Out -> ExceptT GenesisCmdError IO () runLegacyGenesisKeyGenUTxOCmd vk sk = - runGenesisKeyGenUTxOCmd + CreateTestnetData.runGenesisKeyGenUTxOCmd Cmd.GenesisKeyGenUTxOCmdArgs { Cmd.verificationKeyPath = vk , Cmd.signingKeyPath = sk diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs new file mode 100644 index 0000000000..b44eab2847 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs @@ -0,0 +1,54 @@ +module Test.Golden.CreateTestnetData where + +import Control.Monad (filterM, void) +import Control.Monad.IO.Class +import Data.List (intercalate, sort) +import System.Directory +import System.FilePath + +import Test.Cardano.CLI.Util (execCardanoCLI) + +import Hedgehog (Property) +import Hedgehog.Extras (moduleWorkspace, propertyOnce) +import qualified Hedgehog.Extras as H +import qualified Hedgehog.Extras.Test.Golden as H + +{- HLINT ignore "Use camelCase" -} + +-- | Given a root directory, returns files within this root (recursively) +tree :: FilePath -> IO [FilePath] +tree root = do + -- listDirectory returns a path relative to 'root'. We need to prepend + -- root to it for queries below. + content <- map (root ) <$> listDirectory root + files <- filterM doesFileExist content + subs <- filterM doesDirectoryExist content + subTrees <- mapM tree subs + return $ files ++ concat subTrees + +hprop_golden_create_testnet_data :: Property +hprop_golden_create_testnet_data = + propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do + + let outputDir = tempDir "out" + + void $ + execCardanoCLI + ["conway", "genesis", "create-testnet-data" + , "--genesis-keys", "2" + , "--utxo-keys", "3" + , "--out-dir", outputDir + , "--testnet-magic", "42" + , "--pools", "2" + ] + + generated <- liftIO $ tree outputDir + -- Sort output for stability, and make relative to avoid storing + -- a path that changes everytime (/tmp/nix-shell.[0-9]+/tmp-Test...) + let generated' = intercalate "\n" $ sort $ map (makeRelative outputDir) generated + -- On Windows, the path separator is backslash. Normalize it to slash, like on Unix + -- so that this test can run on all platforms. + generated'' = map (\c -> if c == '\\' then '/' else c) generated' + void $ H.note generated'' + + H.diffVsGoldenFile generated'' "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out" diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/create-testnet-data.out b/cardano-cli/test/cardano-cli-golden/files/golden/conway/create-testnet-data.out new file mode 100644 index 0000000000..fb6cffb133 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/create-testnet-data.out @@ -0,0 +1,47 @@ +delegate-keys/delegate1/kes.skey +delegate-keys/delegate1/kes.vkey +delegate-keys/delegate1/key.skey +delegate-keys/delegate1/key.vkey +delegate-keys/delegate1/opcert.cert +delegate-keys/delegate1/opcert.counter +delegate-keys/delegate1/vrf.skey +delegate-keys/delegate1/vrf.vkey +delegate-keys/delegate2/kes.skey +delegate-keys/delegate2/kes.vkey +delegate-keys/delegate2/key.skey +delegate-keys/delegate2/key.vkey +delegate-keys/delegate2/opcert.cert +delegate-keys/delegate2/opcert.counter +delegate-keys/delegate2/vrf.skey +delegate-keys/delegate2/vrf.vkey +genesis-keys/genesis1/key.skey +genesis-keys/genesis1/key.vkey +genesis-keys/genesis2/key.skey +genesis-keys/genesis2/key.vkey +genesis.json +pools-keys/pool1/cold.skey +pools-keys/pool1/cold.vkey +pools-keys/pool1/kes.skey +pools-keys/pool1/kes.vkey +pools-keys/pool1/opcert.cert +pools-keys/pool1/opcert.counter +pools-keys/pool1/staking-reward.skey +pools-keys/pool1/staking-reward.vkey +pools-keys/pool1/vrf.skey +pools-keys/pool1/vrf.vkey +pools-keys/pool2/cold.skey +pools-keys/pool2/cold.vkey +pools-keys/pool2/kes.skey +pools-keys/pool2/kes.vkey +pools-keys/pool2/opcert.cert +pools-keys/pool2/opcert.counter +pools-keys/pool2/staking-reward.skey +pools-keys/pool2/staking-reward.vkey +pools-keys/pool2/vrf.skey +pools-keys/pool2/vrf.vkey +utxo-keys/utxo1/utxo.skey +utxo-keys/utxo1/utxo.vkey +utxo-keys/utxo2/utxo.skey +utxo-keys/utxo2/utxo.vkey +utxo-keys/utxo3/utxo.skey +utxo-keys/utxo3/utxo.vkey \ No newline at end of file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli index d2030cd672..3c6e33fd82 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help.cli @@ -159,6 +159,7 @@ Usage: cardano-cli shelley genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -258,6 +259,22 @@ Usage: cardano-cli shelley genesis create-staked [--key-output-format STRING] Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. +Usage: cardano-cli shelley genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + Usage: cardano-cli shelley genesis hash --genesis FILE Compute the hash of a genesis file @@ -1300,6 +1317,7 @@ Usage: cardano-cli allegra genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -1399,6 +1417,22 @@ Usage: cardano-cli allegra genesis create-staked [--key-output-format STRING] Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. +Usage: cardano-cli allegra genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + Usage: cardano-cli allegra genesis hash --genesis FILE Compute the hash of a genesis file @@ -2441,6 +2475,7 @@ Usage: cardano-cli mary genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -2538,6 +2573,22 @@ Usage: cardano-cli mary genesis create-staked [--key-output-format STRING] Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. +Usage: cardano-cli mary genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + Usage: cardano-cli mary genesis hash --genesis FILE Compute the hash of a genesis file @@ -3563,6 +3614,7 @@ Usage: cardano-cli alonzo genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -3660,6 +3712,22 @@ Usage: cardano-cli alonzo genesis create-staked [--key-output-format STRING] Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. +Usage: cardano-cli alonzo genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + Usage: cardano-cli alonzo genesis hash --genesis FILE Compute the hash of a genesis file @@ -4708,6 +4776,7 @@ Usage: cardano-cli babbage genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -4807,6 +4876,22 @@ Usage: cardano-cli babbage genesis create-staked [--key-output-format STRING] Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. +Usage: cardano-cli babbage genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + Usage: cardano-cli babbage genesis hash --genesis FILE Compute the hash of a genesis file @@ -5875,6 +5960,7 @@ Usage: cardano-cli conway genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -5972,6 +6058,22 @@ Usage: cardano-cli conway genesis create-staked [--key-output-format STRING] Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. +Usage: cardano-cli conway genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + Usage: cardano-cli conway genesis hash --genesis FILE Compute the hash of a genesis file @@ -7361,6 +7463,7 @@ Usage: cardano-cli latest genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -7458,6 +7561,22 @@ Usage: cardano-cli latest genesis create-staked [--key-output-format STRING] Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. +Usage: cardano-cli latest genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + Usage: cardano-cli latest genesis hash --genesis FILE Compute the hash of a genesis file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/allegra_genesis.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/allegra_genesis.cli index 8b10843c12..26ad5f21ba 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/allegra_genesis.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/allegra_genesis.cli @@ -9,6 +9,7 @@ Usage: cardano-cli allegra genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -34,4 +35,5 @@ Available commands: and genesis/delegation/spending keys. create-staked Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. + create-testnet-data Create data to use for starting a testnet. hash Compute the hash of a genesis file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/allegra_genesis_create-testnet-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/allegra_genesis_create-testnet-data.cli new file mode 100644 index 0000000000..8220722f3b --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/allegra_genesis_create-testnet-data.cli @@ -0,0 +1,46 @@ +Usage: cardano-cli allegra genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + +Available options: + --spec-shelley FILE The shelley specification file to use as input. A + default one is generated if omitted. + --genesis-keys INT The number of genesis keys to make (default is 3). + --pools INT The number of stake pool credential sets to make + (default is 0). + --stake-delegators INT The number of stake delegator credential sets to make + (default is 0). + --stuffed-utxo INT The number of fake UTxO entries to generate (default + is 0). + --utxo-keys INT The number of UTxO keys to make (default is 0). + --supply LOVELACE The initial coin supply in Lovelace which will be + evenly distributed across initial, non-delegating + stake holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --supply-delegated LOVELACE + The initial coin supply in Lovelace which will be + evenly distributed across initial, delegating stake + holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --start-time UTC-TIME The genesis start time in YYYY-MM-DDThh:mm:ssZ + format. If unspecified, will be the current time +30 + seconds. + --out-dir DIR The directory where to generate the data. Created if + not existing. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/alonzo_genesis.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/alonzo_genesis.cli index a1d6c67f4e..ae53c4c925 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/alonzo_genesis.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/alonzo_genesis.cli @@ -9,6 +9,7 @@ Usage: cardano-cli alonzo genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -34,4 +35,5 @@ Available commands: and genesis/delegation/spending keys. create-staked Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. + create-testnet-data Create data to use for starting a testnet. hash Compute the hash of a genesis file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/alonzo_genesis_create-testnet-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/alonzo_genesis_create-testnet-data.cli new file mode 100644 index 0000000000..3d32eb1254 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/alonzo_genesis_create-testnet-data.cli @@ -0,0 +1,46 @@ +Usage: cardano-cli alonzo genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + +Available options: + --spec-shelley FILE The shelley specification file to use as input. A + default one is generated if omitted. + --genesis-keys INT The number of genesis keys to make (default is 3). + --pools INT The number of stake pool credential sets to make + (default is 0). + --stake-delegators INT The number of stake delegator credential sets to make + (default is 0). + --stuffed-utxo INT The number of fake UTxO entries to generate (default + is 0). + --utxo-keys INT The number of UTxO keys to make (default is 0). + --supply LOVELACE The initial coin supply in Lovelace which will be + evenly distributed across initial, non-delegating + stake holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --supply-delegated LOVELACE + The initial coin supply in Lovelace which will be + evenly distributed across initial, delegating stake + holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --start-time UTC-TIME The genesis start time in YYYY-MM-DDThh:mm:ssZ + format. If unspecified, will be the current time +30 + seconds. + --out-dir DIR The directory where to generate the data. Created if + not existing. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/babbage_genesis.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/babbage_genesis.cli index 66ff95e5a9..a209f1dacf 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/babbage_genesis.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/babbage_genesis.cli @@ -9,6 +9,7 @@ Usage: cardano-cli babbage genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -34,4 +35,5 @@ Available commands: and genesis/delegation/spending keys. create-staked Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. + create-testnet-data Create data to use for starting a testnet. hash Compute the hash of a genesis file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/babbage_genesis_create-testnet-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/babbage_genesis_create-testnet-data.cli new file mode 100644 index 0000000000..0d7b1c5a5b --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/babbage_genesis_create-testnet-data.cli @@ -0,0 +1,46 @@ +Usage: cardano-cli babbage genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + +Available options: + --spec-shelley FILE The shelley specification file to use as input. A + default one is generated if omitted. + --genesis-keys INT The number of genesis keys to make (default is 3). + --pools INT The number of stake pool credential sets to make + (default is 0). + --stake-delegators INT The number of stake delegator credential sets to make + (default is 0). + --stuffed-utxo INT The number of fake UTxO entries to generate (default + is 0). + --utxo-keys INT The number of UTxO keys to make (default is 0). + --supply LOVELACE The initial coin supply in Lovelace which will be + evenly distributed across initial, non-delegating + stake holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --supply-delegated LOVELACE + The initial coin supply in Lovelace which will be + evenly distributed across initial, delegating stake + holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --start-time UTC-TIME The genesis start time in YYYY-MM-DDThh:mm:ssZ + format. If unspecified, will be the current time +30 + seconds. + --out-dir DIR The directory where to generate the data. Created if + not existing. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_genesis.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_genesis.cli index 768e24f913..fca90a1832 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_genesis.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_genesis.cli @@ -9,6 +9,7 @@ Usage: cardano-cli conway genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -34,4 +35,5 @@ Available commands: and genesis/delegation/spending keys. create-staked Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. + create-testnet-data Create data to use for starting a testnet. hash Compute the hash of a genesis file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_genesis_create-testnet-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_genesis_create-testnet-data.cli new file mode 100644 index 0000000000..4fbca4822f --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/conway_genesis_create-testnet-data.cli @@ -0,0 +1,46 @@ +Usage: cardano-cli conway genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + +Available options: + --spec-shelley FILE The shelley specification file to use as input. A + default one is generated if omitted. + --genesis-keys INT The number of genesis keys to make (default is 3). + --pools INT The number of stake pool credential sets to make + (default is 0). + --stake-delegators INT The number of stake delegator credential sets to make + (default is 0). + --stuffed-utxo INT The number of fake UTxO entries to generate (default + is 0). + --utxo-keys INT The number of UTxO keys to make (default is 0). + --supply LOVELACE The initial coin supply in Lovelace which will be + evenly distributed across initial, non-delegating + stake holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --supply-delegated LOVELACE + The initial coin supply in Lovelace which will be + evenly distributed across initial, delegating stake + holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --start-time UTC-TIME The genesis start time in YYYY-MM-DDThh:mm:ssZ + format. If unspecified, will be the current time +30 + seconds. + --out-dir DIR The directory where to generate the data. Created if + not existing. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_genesis.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_genesis.cli index d877b256b0..00364d4775 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_genesis.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_genesis.cli @@ -9,6 +9,7 @@ Usage: cardano-cli latest genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -34,4 +35,5 @@ Available commands: and genesis/delegation/spending keys. create-staked Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. + create-testnet-data Create data to use for starting a testnet. hash Compute the hash of a genesis file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_genesis_create-testnet-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_genesis_create-testnet-data.cli new file mode 100644 index 0000000000..9ea434b9a8 --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/latest_genesis_create-testnet-data.cli @@ -0,0 +1,46 @@ +Usage: cardano-cli latest genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + +Available options: + --spec-shelley FILE The shelley specification file to use as input. A + default one is generated if omitted. + --genesis-keys INT The number of genesis keys to make (default is 3). + --pools INT The number of stake pool credential sets to make + (default is 0). + --stake-delegators INT The number of stake delegator credential sets to make + (default is 0). + --stuffed-utxo INT The number of fake UTxO entries to generate (default + is 0). + --utxo-keys INT The number of UTxO keys to make (default is 0). + --supply LOVELACE The initial coin supply in Lovelace which will be + evenly distributed across initial, non-delegating + stake holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --supply-delegated LOVELACE + The initial coin supply in Lovelace which will be + evenly distributed across initial, delegating stake + holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --start-time UTC-TIME The genesis start time in YYYY-MM-DDThh:mm:ssZ + format. If unspecified, will be the current time +30 + seconds. + --out-dir DIR The directory where to generate the data. Created if + not existing. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/mary_genesis.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/mary_genesis.cli index 95034b1ccf..a833fbfedf 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/mary_genesis.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/mary_genesis.cli @@ -9,6 +9,7 @@ Usage: cardano-cli mary genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -34,4 +35,5 @@ Available commands: and genesis/delegation/spending keys. create-staked Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. + create-testnet-data Create data to use for starting a testnet. hash Compute the hash of a genesis file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/mary_genesis_create-testnet-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/mary_genesis_create-testnet-data.cli new file mode 100644 index 0000000000..c755e806ee --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/mary_genesis_create-testnet-data.cli @@ -0,0 +1,46 @@ +Usage: cardano-cli mary genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + +Available options: + --spec-shelley FILE The shelley specification file to use as input. A + default one is generated if omitted. + --genesis-keys INT The number of genesis keys to make (default is 3). + --pools INT The number of stake pool credential sets to make + (default is 0). + --stake-delegators INT The number of stake delegator credential sets to make + (default is 0). + --stuffed-utxo INT The number of fake UTxO entries to generate (default + is 0). + --utxo-keys INT The number of UTxO keys to make (default is 0). + --supply LOVELACE The initial coin supply in Lovelace which will be + evenly distributed across initial, non-delegating + stake holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --supply-delegated LOVELACE + The initial coin supply in Lovelace which will be + evenly distributed across initial, delegating stake + holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --start-time UTC-TIME The genesis start time in YYYY-MM-DDThh:mm:ssZ + format. If unspecified, will be the current time +30 + seconds. + --out-dir DIR The directory where to generate the data. Created if + not existing. + -h,--help Show this help text diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/shelley_genesis.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/shelley_genesis.cli index 65ff660ac0..4ddff5f8c0 100644 --- a/cardano-cli/test/cardano-cli-golden/files/golden/help/shelley_genesis.cli +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/shelley_genesis.cli @@ -9,6 +9,7 @@ Usage: cardano-cli shelley genesis | create-cardano | create | create-staked + | create-testnet-data | hash ) @@ -34,4 +35,5 @@ Available commands: and genesis/delegation/spending keys. create-staked Create a staked Shelley genesis file from a genesis template and genesis/delegation/spending keys. + create-testnet-data Create data to use for starting a testnet. hash Compute the hash of a genesis file diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/help/shelley_genesis_create-testnet-data.cli b/cardano-cli/test/cardano-cli-golden/files/golden/help/shelley_genesis_create-testnet-data.cli new file mode 100644 index 0000000000..506a67e5dd --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/help/shelley_genesis_create-testnet-data.cli @@ -0,0 +1,46 @@ +Usage: cardano-cli shelley genesis create-testnet-data [--spec-shelley FILE] + [--genesis-keys INT] + [--pools INT] + [--stake-delegators INT] + [--stuffed-utxo INT] + [--utxo-keys INT] + [--supply LOVELACE] + [--supply-delegated LOVELACE] + ( --mainnet + | --testnet-magic NATURAL + ) + [--start-time UTC-TIME] + --out-dir DIR + + Create data to use for starting a testnet. + +Available options: + --spec-shelley FILE The shelley specification file to use as input. A + default one is generated if omitted. + --genesis-keys INT The number of genesis keys to make (default is 3). + --pools INT The number of stake pool credential sets to make + (default is 0). + --stake-delegators INT The number of stake delegator credential sets to make + (default is 0). + --stuffed-utxo INT The number of fake UTxO entries to generate (default + is 0). + --utxo-keys INT The number of UTxO keys to make (default is 0). + --supply LOVELACE The initial coin supply in Lovelace which will be + evenly distributed across initial, non-delegating + stake holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --supply-delegated LOVELACE + The initial coin supply in Lovelace which will be + evenly distributed across initial, delegating stake + holders. Defaults to 1 million Ada (i.e. 10^12 + Lovelace). + --mainnet Use the mainnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --testnet-magic NATURAL Specify a testnet magic id. This overrides the + CARDANO_NODE_NETWORK_ID environment variable + --start-time UTC-TIME The genesis start time in YYYY-MM-DDThh:mm:ssZ + format. If unspecified, will be the current time +30 + seconds. + --out-dir DIR The directory where to generate the data. Created if + not existing. + -h,--help Show this help text