From f576658c115453f24681fe26464af3288dacfc4f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Tue, 12 Dec 2023 14:57:16 +0100 Subject: [PATCH] Apply review comments (1/n) (will ultimately be squashed) --- .../Cardano/CLI/EraBased/Commands/Genesis.hs | 2 +- .../Cardano/CLI/EraBased/Options/Genesis.hs | 30 ++++++++----------- .../CLI/EraBased/Run/CreateTestnetData.hs | 18 ++++++----- cardano-cli/src/Cardano/CLI/Types/Common.hs | 8 ++--- 4 files changed, 28 insertions(+), 30 deletions(-) diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs index 07c6270471..2f683db6cf 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Commands/Genesis.hs @@ -87,7 +87,7 @@ 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. - , stakeDelegators :: !(StakeDelegatorsKind, Word) -- ^ The number of delegators to pools to create. + , stakeDelegators :: !StakeDelegators -- ^ The number of delegators to pools to create. , 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. diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs index 9e68e0aecb..14fa1dddfe 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE TupleSections #-} module Cardano.CLI.EraBased.Options.Genesis ( pGenesisCmds @@ -205,7 +204,7 @@ pGenesisCreateTestNetData envCli = <$> (optional $ pSpecFile "shelley") <*> pNumGenesisKeys <*> pNumPools - <*> (fmap (OnDisk, ) pNumStakeDelegs <|> fmap (Transient,) pNumTransientStakeDelegs) + <*> pNumStakeDelegs <*> pNumStuffedUtxoCount <*> pNumUtxoKeys <*> pSupply @@ -233,22 +232,19 @@ pGenesisCreateTestNetData envCli = , Opt.help "The number of stake pool credential sets to make (default is 0)." , Opt.value 0 ] - pNumStakeDelegs :: Parser Word + pNumStakeDelegs :: Parser StakeDelegators 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). Credentials are written to disk." - , Opt.value 0 - ] - pNumTransientStakeDelegs :: Parser Word - pNumTransientStakeDelegs = - Opt.option Opt.auto $ mconcat - [ Opt.long "transient-stake-delegators" - , Opt.metavar "INT" - , Opt.help "The number of stake delegator credential sets to make (default is 0). The credentials are NOT written to disk." - , Opt.value 0 - ] + pNumOnDiskStakeDelegators <|> pNumTransientStakeDelegs + where + pNumOnDiskStakeDelegators = fmap OnDisk $ Opt.option Opt.auto $ mconcat $ + [ Opt.long "stake-delegators" + , Opt.help "The number of stake delegator credential sets to make (default is 0). Credentials are written to disk." + ] ++ common + pNumTransientStakeDelegs = fmap Transient $ Opt.option Opt.auto $ mconcat $ + [ Opt.long "transient-stake-delegators" + , Opt.help "The number of stake delegator credential sets to make (default is 0). The credentials are NOT written to disk." + ] ++ common + common = [Opt.metavar "INT", Opt.value 0] pNumStuffedUtxoCount :: Parser Word pNumStuffedUtxoCount = Opt.option Opt.auto $ mconcat diff --git a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs index 244abd66c6..3302028212 100644 --- a/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs +++ b/cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs @@ -186,7 +186,7 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs , specShelley , numGenesisKeys , numPools - , stakeDelegators = (stakeDelegatorsKind, numStakeDelegators) + , stakeDelegators , numStuffedUtxo , numUtxoKeys , supply @@ -239,10 +239,11 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs writeREADME poolsDir poolsREADME -- Stake delegators - forM_ [ 1 .. numStakeDelegators] $ \index -> do - case stakeDelegatorsKind of - OnDisk -> createStakeDelegatorCredentials (stakeDelegatorsDir "delegator" <> show index) - Transient -> pure () + case stakeDelegators of + OnDisk _ -> + forM_ [ 1 .. numStakeDelegators] $ \index -> do + createStakeDelegatorCredentials (stakeDelegatorsDir "delegator" <> show index) + Transient _ -> pure () let (delegsPerPool, delegsRemaining) = numStakeDelegators `divMod` numPools delegsForPool poolIx = if delegsRemaining /= 0 && poolIx == numPools @@ -254,15 +255,15 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs -- Distribute M delegates across N pools: delegations <- - case stakeDelegatorsKind of - OnDisk -> do + case stakeDelegators of + OnDisk _ -> do let delegates = concat $ repeat stakeDelegatorsDirs delegatesAndPools = zip delegates distribution -- We don't need to be attentive to laziness here, because anyway this -- doesn't scale really well (because we're generating legit credentials, -- as opposed to the Transient case). forM delegatesAndPools (uncurry $ computeDelegation networkId) - Transient -> + Transient _ -> liftIO $ Lazy.forStateM g distribution $ flip computeInsecureDelegation networkId genDlgs <- readGenDelegsMap genesisVKeysPaths delegateKeys delegateVrfKeys @@ -289,6 +290,7 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs utxoKeysDir = outputDir "utxo-keys" poolsDir = outputDir "pools-keys" stakeDelegatorsDir = outputDir "stake-delegators" + numStakeDelegators = case stakeDelegators of OnDisk n -> n; Transient n -> n mkDelegationMapEntry :: Delegation -> (Ledger.KeyHash Ledger.Staking StandardCrypto, Ledger.PoolParams StandardCrypto) mkDelegationMapEntry d = (dDelegStaking d, dPoolParams d) diff --git a/cardano-cli/src/Cardano/CLI/Types/Common.hs b/cardano-cli/src/Cardano/CLI/Types/Common.hs index 979966e263..6d0c14c2a1 100644 --- a/cardano-cli/src/Cardano/CLI/Types/Common.hs +++ b/cardano-cli/src/Cardano/CLI/Types/Common.hs @@ -55,7 +55,7 @@ module Cardano.CLI.Types.Common , SigningKeyFile , SlotsTillKesKeyExpiry (..) , SomeKeyFile(..) - , StakeDelegatorsKind(..) + , StakeDelegators(..) , StakePoolMetadataFile , TransferDirection(..) , TxBodyFile @@ -142,9 +142,9 @@ data VoteHashSource | VoteHashSourceHash (L.SafeHash Crypto.StandardCrypto L.AnchorData) deriving Show -data StakeDelegatorsKind = - OnDisk -- ^ Credentials are written to disk - | Transient -- ^ Credentials are not written to disk +data StakeDelegators = + OnDisk !Word -- ^ The number of credentials to write to disk + | Transient !Word -- ^ The number of credentials, that are not written to disk deriving Show -- | Specify whether to render the script cost as JSON