From 43e73c9bd23266a19500636fc4a305044771bf48 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 24 Jan 2024 14:42:24 +0100 Subject: [PATCH 1/4] create-testnet-data: condition creation of READMEs --- .../Cardano/CLI/EraBased/Run/CreateTestnetData.hs | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs index e6b7e6a9c8..19664604d6 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs @@ -59,7 +59,7 @@ 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, zipWithM) +import Control.Monad (forM, forM_, unless, void, when, zipWithM) import Control.Monad.Except (MonadError (..), runExceptT) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Except (ExceptT) @@ -219,8 +219,9 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs createGenesisKeys (genesisDir ("genesis" <> show index)) createDelegateKeys desiredKeyOutputFormat (delegateDir ("delegate" <> show index)) - writeREADME genesisDir genesisREADME - writeREADME delegateDir delegatesREADME + when (0 < numGenesisKeys) $ do + writeREADME genesisDir genesisREADME + writeREADME delegateDir delegatesREADME -- UTxO keys let utxoKeys = [utxoKeysDir ("utxo" <> show index) "utxo.vkey" @@ -228,7 +229,7 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs forM_ [ 1 .. numUtxoKeys ] $ \index -> createUtxoKeys $ utxoKeysDir ("utxo" <> show index) - writeREADME utxoKeysDir utxoKeysREADME + when (0 < numUtxoKeys) $ writeREADME utxoKeysDir utxoKeysREADME let mayStakePoolRelays = Nothing -- TODO @smelc temporary? @@ -239,7 +240,7 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs createPoolCredentials desiredKeyOutputFormat poolDir buildPoolParams networkId poolDir Nothing (fromMaybe mempty mayStakePoolRelays) - writeREADME poolsDir poolsREADME + when (0 < numPools) $ writeREADME poolsDir poolsREADME -- DReps forM_ [ 1 .. numDrepKeys ] $ \index -> do @@ -250,7 +251,7 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs liftIO $ createDirectoryIfMissing True drepDir firstExceptT GenesisCmdFileError $ DRep.runGovernanceDRepKeyGenCmd cmd - writeREADME drepsDir drepsREADME + when (0 < numDrepKeys) $ writeREADME drepsDir drepsREADME -- Stake delegators case stakeDelegators of From f531f8d0b44e3dd0f5d68d5bffb9f701ca4b5679 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 24 Jan 2024 14:42:40 +0100 Subject: [PATCH 2/4] create-testnet-data: test minimal example --- cardano-cli/cardano-cli.cabal | 1 + .../Test/Cli/CreateTestnetData.hs | 29 +++++++++++++++++++ 2 files changed, 30 insertions(+) create mode 100644 cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 962f7a88ff..f3bdaca467 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/cardano-cli/cardano-cli.cabal @@ -307,6 +307,7 @@ test-suite cardano-cli-test other-modules: Test.Cli.AddCostModels Test.Cli.CliIntermediateFormat + Test.Cli.CreateTestnetData Test.Cli.FilePermissions Test.Cli.Governance.Hash Test.Cli.ITN diff --git a/cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs b/cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs new file mode 100644 index 0000000000..0259d043ec --- /dev/null +++ b/cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs @@ -0,0 +1,29 @@ +module Test.Cli.CreateTestnetData where + + + +import System.FilePath + +import Test.Cardano.CLI.Util (execCardanoCLI) + +import Hedgehog (Property) +import Hedgehog.Extras (moduleWorkspace, propertyOnce) +import qualified Hedgehog.Extras as H + +-- | Test case for https://github.com/IntersectMBO/cardano-cli/issues/587 +-- Execute this test with: +-- @cabal test cardano-cli-test --test-options '-p "/create testnet data minimal/"'@ +hprop_create_testnet_data_minimal :: Property +hprop_create_testnet_data_minimal = + propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do + + let outputDir = tempDir "out" + + H.noteM_ $ execCardanoCLI + ["conway", "genesis", "create-testnet-data" + , "--testnet-magic", "42" + , "--out-dir", outputDir + ] + + -- We test that the command doesn't crash, because otherwise + -- execCardanoCLI would fail. \ No newline at end of file From e8fe394e6ec47a7bbcccb5d00f9e11e69d68f8bb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 24 Jan 2024 15:14:35 +0100 Subject: [PATCH 3/4] create-testnet-data: avoid infinite loop when no stake delegators are specified --- cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs index 19664604d6..c6d4e99ede 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs @@ -271,6 +271,10 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs -- Distribute M delegates across N pools: delegations <- case stakeDelegators of + OnDisk 0 -> + -- Required because the most general case below loops in this case + -- (try @zipWith _ (concat $ repeat []) _@ in a REPL) + pure [] OnDisk _ -> do let delegates = concat $ repeat stakeDelegatorsDirs -- We don't need to be attentive to laziness here, because anyway this From e83e4ec9d61d95e4c4e66a9c8f4187f8ef67da45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 24 Jan 2024 15:17:44 +0100 Subject: [PATCH 4/4] create-testnet-data/create-staked: don't stay close to a division by zero --- .../src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs | 8 ++++++-- cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs | 8 ++++++-- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs index c6d4e99ede..03ab48618d 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs @@ -260,8 +260,12 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs createStakeDelegatorCredentials (stakeDelegatorsDir "delegator" <> show index) Transient _ -> pure () - let (delegsPerPool, delegsRemaining) = numStakeDelegators `divMod` numPools - delegsForPool poolIx = if delegsRemaining /= 0 && poolIx == numPools + let (delegsPerPool, delegsRemaining) = + if numPools == 0 + then (0, 0) + else numStakeDelegators `divMod` numPools + delegsForPool poolIx = + if delegsRemaining /= 0 && poolIx == numPools then delegsPerPool else delegsPerPool + delegsRemaining distribution = [pool | (pool, poolIx) <- zip poolParams [1 ..], _ <- [1 .. delegsForPool poolIx]] diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs index 9fa666a07c..94fae1370c 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs @@ -596,8 +596,12 @@ runGenesisCreateStakedCmd forM_ (zip [ 1 .. numBulkPoolCredFiles ] bulkSlices) $ uncurry (writeBulkPoolCredentials pooldir) - let (delegsPerPool, delegsRemaining) = divMod numStakeDelegators numPools - delegsForPool poolIx = if delegsRemaining /= 0 && poolIx == numPools + let (delegsPerPool, delegsRemaining) = + if numPools == 0 + then (0, 0) + else numStakeDelegators `divMod` numPools + delegsForPool poolIx = + if delegsRemaining /= 0 && poolIx == numPools then delegsPerPool else delegsPerPool + delegsRemaining distribution = [pool | (pool, poolIx) <- zip poolParams [1 ..], _ <- [1 .. delegsForPool poolIx]]