Merge pull request #512 from input-output-hk/smelc/create-testnet-dat…

…a-write-stake-delegators-to-disk

create-testnet-data: Make --stake-delegators write credentials to disk. Keep current behavior with new --transient-stake-delegators.

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.
-  , numStakeDelegators :: !Word -- ^ The number of delegators to pools to create and write to disk.
+  , 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.

cardano-cli/src/Cardano/CLI/EraBased/Options/Genesis.hs

@@ -232,14 +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)."
-        , 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

cardano-cli/src/Cardano/CLI/EraBased/Run/CreateTestnetData.hs

@@ -31,6 +31,7 @@ import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Commands.Genesis as Cmd
 import qualified Cardano.CLI.EraBased.Commands.Node as Cmd
+import           Cardano.CLI.EraBased.Run.Address (runAddressKeyGenCmd)
 import qualified Cardano.CLI.EraBased.Run.Key as Key
 import           Cardano.CLI.EraBased.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd,
                    runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd)
@@ -41,6 +42,7 @@ import           Cardano.CLI.Types.Errors.GenesisCmdError
 import           Cardano.CLI.Types.Errors.NodeCmdError
 import           Cardano.CLI.Types.Errors.StakePoolCmdError
 import           Cardano.CLI.Types.Key
+import qualified Cardano.CLI.Types.Key as Keys
 import           Cardano.Crypto.Hash (HashAlgorithm)
 import qualified Cardano.Crypto.Hash as Hash
 import qualified Cardano.Crypto.Random as Crypto
@@ -55,7 +57,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)
+import           Control.Monad (forM, forM_, unless, void, zipWithM)
 import           Control.Monad.Except (MonadError (..), runExceptT)
 import           Control.Monad.IO.Class (MonadIO (..))
 import           Control.Monad.Trans.Except (ExceptT)
@@ -184,7 +186,7 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
    , specShelley
    , numGenesisKeys
    , numPools
-   , numStakeDelegators
+   , stakeDelegators
    , numStuffedUtxo
    , numUtxoKeys
    , supply
@@ -207,10 +209,12 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
       delegateKeys = mkPaths numGenesisKeys delegateDir "delegate" "key.vkey"
       -- {0 -> delegate-keys/delegate0/vrf.vkey, 1 -> delegate-keys/delegate1/vrf.vkey, ...}
       delegateVrfKeys = mkPaths numGenesisKeys delegateDir "delegate" "vrf.vkey"
+      -- {"stake-delegators/delegator1", "stake-delegators/delegator2", ...}
+      stakeDelegatorsDirs = [stakeDelegatorsDir </> "delegator" <> show i | i <- [1 .. numStakeDelegators]]
 
   forM_ [ 1 .. numGenesisKeys ] $ \index -> do
     createGenesisKeys (genesisDir </> ("genesis" <> show index))
-    createDelegateKeys keyOutputFormat (delegateDir </> ("delegate" <> show index))
+    createDelegateKeys desiredKeyOutputFormat (delegateDir </> ("delegate" <> show index))
 
   writeREADME genesisDir genesisREADME
   writeREADME delegateDir delegatesREADME
@@ -229,13 +233,19 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
   poolParams <- forM [ 1 .. numPools ] $ \index -> do
     let poolDir = poolsDir </> ("pool" <> show index)
 
-    createPoolCredentials keyOutputFormat poolDir
+    createPoolCredentials desiredKeyOutputFormat poolDir
     buildPoolParams networkId poolDir Nothing (fromMaybe mempty mayStakePoolRelays)
 
   writeREADME poolsDir poolsREADME
 
   -- Stake delegators
-  let (delegsPerPool, delegsRemaining) = divMod numStakeDelegators numPools
+  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
         then delegsPerPool
         else delegsPerPool + delegsRemaining
@@ -244,7 +254,16 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
   g <- Random.getStdGen
 
   -- Distribute M delegates across N pools:
-  delegations <- liftIO $ Lazy.forStateM g distribution $ flip computeInsecureDelegation networkId
+  delegations <-
+    case stakeDelegators of
+      OnDisk _ -> do
+        let delegates = concat $ repeat stakeDelegatorsDirs
+        -- 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).
+        zipWithM (computeDelegation networkId) delegates distribution
+      Transient _ ->
+        liftIO $ Lazy.forStateM g distribution $ flip computeInsecureDelegation networkId
 
   genDlgs <- readGenDelegsMap genesisVKeysPaths delegateKeys delegateVrfKeys
   nonDelegAddrs <- readInitialFundAddresses utxoKeys networkId
@@ -269,10 +288,15 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
     delegateDir = outputDir </> "delegate-keys"
     utxoKeysDir = outputDir </> "utxo-keys"
     poolsDir = outputDir </> "pools-keys"
-    keyOutputFormat = KeyOutputFormatTextEnvelope
+    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)
 
+-- | The output format used all along this file
+desiredKeyOutputFormat :: KeyOutputFormat
+desiredKeyOutputFormat = KeyOutputFormatTextEnvelope
+
 writeREADME :: ()
   => FilePath
   -> Text.Text
@@ -366,6 +390,19 @@ createGenesisKeys dir = do
     , signingKeyPath = File @(SigningKey ()) $ dir </> "key.skey"
     }
 
+createStakeDelegatorCredentials :: FilePath -> ExceptT GenesisCmdError IO ()
+createStakeDelegatorCredentials dir = do
+  liftIO $ createDirectoryIfMissing True dir
+  firstExceptT GenesisCmdAddressCmdError $
+    runAddressKeyGenCmd desiredKeyOutputFormat AddressKeyShelley paymentVK paymentSK
+  firstExceptT GenesisCmdStakeAddressCmdError $
+    runStakeAddressKeyGenCmd desiredKeyOutputFormat stakingVK stakingSK
+  where
+    paymentVK = File @(VerificationKey ()) $ dir </> "payment.vkey"
+    paymentSK = File @(SigningKey ()) $ dir </> "payment.skey"
+    stakingVK = File @(VerificationKey ()) $ dir </> "staking.vkey"
+    stakingSK = File @(SigningKey ()) $ dir </> "staking.skey"
+
 createUtxoKeys :: FilePath -> ExceptT GenesisCmdError IO ()
 createUtxoKeys dir = do
   liftIO $ createDirectoryIfMissing True dir
@@ -458,6 +495,27 @@ buildPoolParams nw dir index specifiedRelays = do
    poolVrfVKF = File $ dir </> "vrf" ++ strIndex ++ ".vkey"
    poolRewardVKF = File $ dir </> "staking-reward" ++ strIndex ++ ".vkey"
 
+computeDelegation
+  :: NetworkId
+  -> FilePath
+  -> Ledger.PoolParams StandardCrypto
+  -> ExceptT GenesisCmdError IO Delegation
+computeDelegation nw delegDir dPoolParams = do
+    payVK   <- readVKeyFromDisk AsPaymentKey payVKF
+    stakeVK <- readVKeyFromDisk AsStakeKey   stakeVKF
+    let paymentCredential = PaymentCredentialByKey $ verificationKeyHash payVK
+        stakeAddrRef = StakeAddressByValue $ StakeCredentialByKey $ verificationKeyHash stakeVK
+        dInitialUtxoAddr = makeShelleyAddressInEra ShelleyBasedEraShelley nw paymentCredential stakeAddrRef
+        dDelegStaking = Ledger.hashKey $ unStakeVerificationKey stakeVK
+
+    pure $ Delegation { dInitialUtxoAddr, dDelegStaking, dPoolParams }
+   where
+     payVKF = File @(VerificationKey ()) $ delegDir </> "payment.vkey"
+     stakeVKF = File @(VerificationKey ()) $ delegDir </> "staking.vkey"
+     readVKeyFromDisk role file =
+      firstExceptT GenesisCmdFileInputDecodeError $ newExceptT $
+        Keys.readVerificationKeyOrFile role (VerificationKeyFilePath file)
+
 -- | This function should only be used for testing purposes.
 -- Keys returned by this function are not cryptographically secure.
 computeInsecureDelegation

cardano-cli/src/Cardano/CLI/Types/Common.hs

@@ -55,6 +55,7 @@ module Cardano.CLI.Types.Common
   , SigningKeyFile
   , SlotsTillKesKeyExpiry (..)
   , SomeKeyFile(..)
+  , StakeDelegators(..)
   , StakePoolMetadataFile
   , TransferDirection(..)
   , TxBodyFile
@@ -141,6 +142,11 @@ data VoteHashSource
   | VoteHashSourceHash (L.SafeHash Crypto.StandardCrypto L.AnchorData)
   deriving Show
 
+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
 -- in the cli's build command.
 data TxBuildOutputOptions = OutputScriptCostOnly (File () Out)

cardano-cli/src/Cardano/CLI/Types/Errors/GenesisCmdError.hs

@@ -39,6 +39,7 @@ data GenesisCmdError
   | GenesisCmdByronError !ByronGenesisError
   | GenesisCmdStakePoolRelayFileError !FilePath !IOException
   | GenesisCmdStakePoolRelayJsonDecodeError !FilePath !String
+  | GenesisCmdFileInputDecodeError !(FileError InputDecodeError)
   deriving Show
 
 instance Error GenesisCmdError where
@@ -95,3 +96,5 @@ instance Error GenesisCmdError where
     GenesisCmdStakePoolRelayJsonDecodeError fp e ->
       "Error occurred while decoding the stake pool relay specification file: " <> pretty fp <>
       " Error: " <> pretty e
+    GenesisCmdFileInputDecodeError ide ->
+      "Error occured while decoding a file: " <> pshow ide

cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs

@@ -40,6 +40,7 @@ hprop_golden_create_testnet_data =
          , "--out-dir", outputDir
          , "--testnet-magic", "42"
          , "--pools", "2"
+         , "--stake-delegators", "4"
         ]
 
     generated <- liftIO $ tree outputDir
@@ -52,3 +53,24 @@ hprop_golden_create_testnet_data =
     void $ H.note generated''
 
     H.diffVsGoldenFile generated'' "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
+
+hprop_golden_create_testnet_data_transient_stake_delegators :: Property
+hprop_golden_create_testnet_data_transient_stake_delegators =
+  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"
+         , "--stake-delegators", "4"
+        ]
+
+    -- We just test that the command doesn't crash when we execute a different path.
+    -- For the golden part of this test, we are anyway covered by 'hprop_golden_create_testnet_data'
+    -- that generates strictly more stuff.

cardano-cli/test/cardano-cli-golden/files/golden/conway/create-testnet-data.out

@@ -42,6 +42,22 @@ pools-keys/pool2/staking-reward.skey
 pools-keys/pool2/staking-reward.vkey
 pools-keys/pool2/vrf.skey
 pools-keys/pool2/vrf.vkey
+stake-delegators/delegator1/payment.skey
+stake-delegators/delegator1/payment.vkey
+stake-delegators/delegator1/staking.skey
+stake-delegators/delegator1/staking.vkey
+stake-delegators/delegator2/payment.skey
+stake-delegators/delegator2/payment.vkey
+stake-delegators/delegator2/staking.skey
+stake-delegators/delegator2/staking.vkey
+stake-delegators/delegator3/payment.skey
+stake-delegators/delegator3/payment.vkey
+stake-delegators/delegator3/staking.skey
+stake-delegators/delegator3/staking.vkey
+stake-delegators/delegator4/payment.skey
+stake-delegators/delegator4/payment.vkey
+stake-delegators/delegator4/staking.skey
+stake-delegators/delegator4/staking.vkey
 utxo-keys/README.md
 utxo-keys/utxo1/utxo.skey
 utxo-keys/utxo1/utxo.vkey

cardano-cli/test/cardano-cli-golden/files/golden/help.cli

@@ -262,7 +262,9 @@ Usage: cardano-cli shelley genesis create-staked [--key-output-format STRING]
 Usage: cardano-cli shelley genesis create-testnet-data [--spec-shelley FILE]
                                                          [--genesis-keys INT]
                                                          [--pools INT]
-                                                         [--stake-delegators INT]
+                                                         [ --stake-delegators INT
+                                                         | --transient-stake-delegators INT
+                                                         ]
                                                          [--stuffed-utxo INT]
                                                          [--utxo-keys INT]
                                                          [--supply LOVELACE]
@@ -1423,7 +1425,9 @@ Usage: cardano-cli allegra genesis create-staked [--key-output-format STRING]
 Usage: cardano-cli allegra genesis create-testnet-data [--spec-shelley FILE]
                                                          [--genesis-keys INT]
                                                          [--pools INT]
-                                                         [--stake-delegators INT]
+                                                         [ --stake-delegators INT
+                                                         | --transient-stake-delegators INT
+                                                         ]
                                                          [--stuffed-utxo INT]
                                                          [--utxo-keys INT]
                                                          [--supply LOVELACE]
@@ -2582,7 +2586,9 @@ Usage: cardano-cli mary genesis create-staked [--key-output-format STRING]
 Usage: cardano-cli mary genesis create-testnet-data [--spec-shelley FILE]
                                                       [--genesis-keys INT]
                                                       [--pools INT]
-                                                      [--stake-delegators INT]
+                                                      [ --stake-delegators INT
+                                                      | --transient-stake-delegators INT
+                                                      ]
                                                       [--stuffed-utxo INT]
                                                       [--utxo-keys INT]
                                                       [--supply LOVELACE]
@@ -3724,7 +3730,9 @@ Usage: cardano-cli alonzo genesis create-staked [--key-output-format STRING]
 Usage: cardano-cli alonzo genesis create-testnet-data [--spec-shelley FILE]
                                                         [--genesis-keys INT]
                                                         [--pools INT]
-                                                        [--stake-delegators INT]
+                                                        [ --stake-delegators INT
+                                                        | --transient-stake-delegators INT
+                                                        ]
                                                         [--stuffed-utxo INT]
                                                         [--utxo-keys INT]
                                                         [--supply LOVELACE]
@@ -4891,7 +4899,9 @@ Usage: cardano-cli babbage genesis create-staked [--key-output-format STRING]
 Usage: cardano-cli babbage genesis create-testnet-data [--spec-shelley FILE]
                                                          [--genesis-keys INT]
                                                          [--pools INT]
-                                                         [--stake-delegators INT]
+                                                         [ --stake-delegators INT
+                                                         | --transient-stake-delegators INT
+                                                         ]
                                                          [--stuffed-utxo INT]
                                                          [--utxo-keys INT]
                                                          [--supply LOVELACE]
@@ -6076,7 +6086,9 @@ Usage: cardano-cli conway genesis create-staked [--key-output-format STRING]
 Usage: cardano-cli conway genesis create-testnet-data [--spec-shelley FILE]
                                                         [--genesis-keys INT]
                                                         [--pools INT]
-                                                        [--stake-delegators INT]
+                                                        [ --stake-delegators INT
+                                                        | --transient-stake-delegators INT
+                                                        ]
                                                         [--stuffed-utxo INT]
                                                         [--utxo-keys INT]
                                                         [--supply LOVELACE]
@@ -7583,7 +7595,9 @@ Usage: cardano-cli latest genesis create-staked [--key-output-format STRING]
 Usage: cardano-cli latest genesis create-testnet-data [--spec-shelley FILE]
                                                         [--genesis-keys INT]
                                                         [--pools INT]
-                                                        [--stake-delegators INT]
+                                                        [ --stake-delegators INT
+                                                        | --transient-stake-delegators INT
+                                                        ]
                                                         [--stuffed-utxo INT]
                                                         [--utxo-keys INT]
                                                         [--supply LOVELACE]