Skip to content
New issue

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

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

Already on GitHub? Sign in to your account

create-testnet-data: don't fail trying to create irrelevant READMEs #588

Merged
merged 4 commits into from
Jan 25, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions cardano-cli/cardano-cli.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
25 changes: 17 additions & 8 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -219,16 +219,17 @@ 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"
| index <- [ 1 .. numUtxoKeys ]]
forM_ [ 1 .. numUtxoKeys ] $ \index ->
createUtxoKeys $ utxoKeysDir </> ("utxo" <> show index)

writeREADME utxoKeysDir utxoKeysREADME
when (0 < numUtxoKeys) $ writeREADME utxoKeysDir utxoKeysREADME

let mayStakePoolRelays = Nothing -- TODO @smelc temporary?

Expand All @@ -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
Expand All @@ -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
Expand All @@ -259,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]]
Expand All @@ -270,6 +275,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
Expand Down
8 changes: 6 additions & 2 deletions cardano-cli/src/Cardano/CLI/EraBased/Run/Genesis.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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]]
Expand Down
29 changes: 29 additions & 0 deletions cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs
Original file line number Diff line number Diff line change
@@ -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.
Loading