Merge pull request #575 from IntersectMBO/smelc/create-testnet-data-d…

…etails

create-testnet-data: various enhancements

cardano-cli/cardano-cli.cabal

@@ -343,6 +343,7 @@ test-suite cardano-cli-golden
                       , cborg
                       , containers
                       , directory
+                      , extra
                       , filepath
                       , hedgehog ^>= 1.3
                       , hedgehog-extras ^>= 0.6.0.0

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

@@ -30,10 +30,10 @@ import           Cardano.Api
 import           Cardano.Api.Shelley
 
 import           Cardano.CLI.EraBased.Commands.Genesis as Cmd
+import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as DRep
 import qualified Cardano.CLI.EraBased.Commands.Node as Cmd
 import           Cardano.CLI.EraBased.Run.Address (runAddressKeyGenCmd)
 import qualified Cardano.CLI.EraBased.Run.Governance.DRep as DRep
-import qualified Cardano.CLI.EraBased.Commands.Governance.DRep as DRep
 import qualified Cardano.CLI.EraBased.Run.Key as Key
 import           Cardano.CLI.EraBased.Run.Node (runNodeIssueOpCertCmd, runNodeKeyGenColdCmd,
                    runNodeKeyGenKesCmd, runNodeKeyGenVrfCmd)
@@ -243,13 +243,15 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
 
   -- DReps
   forM_ [ 1 .. numDrepKeys ] $ \index -> do
-    let drepDir = outputDir </> "drep-keys" </> "drep" <> show index
+    let drepDir = drepsDir </> "drep" <> show index
         vkeyFile = File @(VerificationKey ()) $ drepDir </> "drep.vkey"
         skeyFile = File @(SigningKey ()) $ drepDir </> "drep.skey"
         cmd = DRep.GovernanceDRepKeyGenCmdArgs ConwayEraOnwardsConway vkeyFile skeyFile
     liftIO $ createDirectoryIfMissing True drepDir
     firstExceptT GenesisCmdFileError $ DRep.runGovernanceDRepKeyGenCmd cmd
 
+  writeREADME drepsDir drepsREADME
+
   -- Stake delegators
   case stakeDelegators of
     OnDisk _ ->
@@ -298,6 +300,7 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
   where
     genesisDir = outputDir </> "genesis-keys"
     delegateDir = outputDir </> "delegate-keys"
+    drepsDir = outputDir </> "drep-keys"
     utxoKeysDir = outputDir </> "utxo-keys"
     poolsDir = outputDir </> "pools-keys"
     stakeDelegatorsDir = outputDir </> "stake-delegators"
@@ -330,6 +333,10 @@ delegatesREADME = Text.intercalate "\n"
   ["Keys generated by the --genesis-keys flag. These keys are used to mint blocks when not being completely decentralized",
    "(e.g. when stake pools are not the sole block producers). These keys are intended to run nodes."]
 
+drepsREADME :: Text.Text
+drepsREADME = Text.intercalate "\n"
+  ["Keys generated by the --drep-keys flag."]
+
 utxoKeysREADME :: Text.Text
 utxoKeysREADME = Text.intercalate "\n"
   ["Keys generated by the --utxo-keys flag. These keys receive a portion of the supply."]
@@ -566,14 +573,13 @@ updateCreateStakedOutputTemplate
     -> ShelleyGenesis StandardCrypto -- ^ Template from which to build a genesis
     -> ShelleyGenesis StandardCrypto -- ^ Updated genesis
 updateCreateStakedOutputTemplate
-  (SystemStart start)
+  (SystemStart sgSystemStart)
   genDelegMap mAmountNonDeleg nUtxoAddrsNonDeleg utxoAddrsNonDeleg pools stake
   amountDeleg
   nUtxoAddrsDeleg utxoAddrsDeleg stuffedUtxoAddrs
-  template = do
-    let pparamsFromTemplate = sgProtocolParams template
-        shelleyGenesis = template
-          { sgSystemStart = start
+  template@ShelleyGenesis{ sgProtocolParams } =
+    template
+          { sgSystemStart
           , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin
           , sgGenDelegs = shelleyDelKeys
           , sgInitialFunds = ListMap.fromList
@@ -590,16 +596,16 @@ updateCreateStakedOutputTemplate
               { sgsPools = ListMap pools
               , sgsStake = ListMap stake
               }
-          , sgProtocolParams = pparamsFromTemplate
+          , sgProtocolParams
           }
-    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
+    -- if --supply is not specified, non delegated supply comes from the template passed to this function:
     nonDelegCoin = fromIntegral (maybe maximumLovelaceSupply unLovelace mAmountNonDeleg)
     delegCoin = maybe 0 fromIntegral amountDeleg
 
@@ -610,7 +616,7 @@ updateCreateStakedOutputTemplate
 
     mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
     mkStuffedUtxo xs = (, Lovelace minUtxoVal) <$> xs
-      where Coin minUtxoVal = sgProtocolParams template ^. ppMinUTxOValueL
+      where Coin minUtxoVal = sgProtocolParams ^. ppMinUTxOValueL
 
     shelleyDelKeys = Map.fromList
       [ (gh, Ledger.GenDelegPair gdh h)

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

@@ -1,31 +1,54 @@
+{-# LANGUAGE ScopedTypeVariables #-}
 module Test.Golden.CreateTestnetData where
 
+import           Cardano.Api.Ledger (StandardCrypto)
+import           Cardano.Api.Shelley (ShelleyGenesis (..))
+
+import           Cardano.Ledger.Shelley.API (ShelleyGenesisStaking (..))
+
 import           Control.Monad (filterM, void)
 import           Control.Monad.IO.Class
+import qualified Data.Aeson as Aeson
+import qualified Data.ByteString.Lazy as LBS
 import           Data.List (intercalate, sort)
+import           Data.Word (Word32)
 import           System.Directory
+import           System.Directory.Extra (listDirectories)
 import           System.FilePath
 
 import           Test.Cardano.CLI.Util (execCardanoCLI)
 
 import           Hedgehog (Property)
+import qualified Hedgehog as H
 import           Hedgehog.Extras (moduleWorkspace, propertyOnce)
 import qualified Hedgehog.Extras as H
 import qualified Hedgehog.Extras.Test.Golden as H
 
 {- HLINT ignore "Use camelCase" -}
 
+networkMagic :: Word32
+networkMagic = 42
+
+numDReps :: Int
+numDReps = 5
+
+numPools :: Int
+numPools = 2
+
+numUtxoKeys :: Int
+numUtxoKeys = 3
+
 -- | A function to create the arguments, so that they are shared
 -- between the two tests, except for the possibly transient ones.
 mkArguments :: String -> [String]
 mkArguments outputDir =
   ["conway",  "genesis", "create-testnet-data"
    , "--genesis-keys", "2"
-   , "--utxo-keys", "3"
+   , "--utxo-keys", show numUtxoKeys
    , "--out-dir", outputDir
-   , "--testnet-magic", "42"
-   , "--pools", "2"
-   , "--drep-keys", "5"
+   , "--testnet-magic", show networkMagic
+   , "--pools", show numPools
+   , "--drep-keys", show numDReps
   ]
 
 -- | Given a root directory, returns files within this root (recursively)
@@ -61,6 +84,18 @@ hprop_golden_create_testnet_data =
 
     H.diffVsGoldenFile generated'' "test/cardano-cli-golden/files/golden/conway/create-testnet-data.out"
 
+    bs <- liftIO $ LBS.readFile $ outputDir </> "genesis.json"
+    genesis :: ShelleyGenesis StandardCrypto <- Aeson.throwDecode bs
+
+    H.assert (sgNetworkMagic genesis == networkMagic)
+    H.assert ((length . sgsPools . sgStaking $ genesis) == numPools)
+
+    actualNumDReps <- liftIO $ listDirectories $ outputDir </> "drep-keys"
+    H.assert $ length actualNumDReps == numDReps
+
+    actualNumUtxoKeys <- liftIO $ listDirectories $ outputDir </> "utxo-keys"
+    H.assert $ length actualNumUtxoKeys == numUtxoKeys
+
 -- | This test tests the transient case, i.e. it writes strictly
 -- less things to disk than 'hprop_golden_create_testnet_data'. Execute this test with:
 -- @cabal test cardano-cli-golden --test-options '-p "/golden create testnet data transient stake delegators/'@

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

@@ -15,6 +15,7 @@ delegate-keys/delegate2/opcert.cert
 delegate-keys/delegate2/opcert.counter
 delegate-keys/delegate2/vrf.skey
 delegate-keys/delegate2/vrf.vkey
+drep-keys/README.md
 drep-keys/drep1/drep.skey
 drep-keys/drep1/drep.vkey
 drep-keys/drep2/drep.skey
@@ -74,4 +75,4 @@ 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
+utxo-keys/utxo3/utxo.vkey