Merge pull request #581 from IntersectMBO/smelc/create-testnet-data-r…

…ework-supply-arguments

create-testnet-data: better UX for supply arguments

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

@@ -91,8 +91,8 @@ data GenesisCreateTestNetDataCmdArgs = GenesisCreateTestNetDataCmdArgs
   , numDrepKeys :: !Word -- ^ The number of DRep keys to create. Right now they receive neither delegation nor are registrated. This will come later.
   , 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.
-  , supplyDelegated :: !(Maybe Lovelace) -- ^ The number of Lovelace to distribute over delegating stake holders.
+  , totalSupply :: !(Maybe Lovelace) -- ^ The total number of Lovelace
+  , delegatedSupply :: !(Maybe Lovelace) -- ^ The number of Lovelace being delegated
   , networkId :: !NetworkId -- ^ The network ID to use.
   , systemStart :: !(Maybe SystemStart) -- ^ The genesis start time.
   , outputDir :: !FilePath -- ^ Directory where to write credentials and files.

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

@@ -1,6 +1,7 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs #-}
+{-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Cardano.CLI.EraBased.Options.Genesis
@@ -273,18 +274,22 @@ pGenesisCreateTestNetData envCli =
     pSupply :: Parser (Maybe Lovelace)
     pSupply =
       Opt.optional $ fmap Lovelace $ Opt.option Opt.auto $ mconcat
-        [ Opt.long "supply"
+        [ Opt.long "total-supply"
         , Opt.metavar "LOVELACE"
-        , Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial, non-delegating stake holders. Defaults to 1 million Ada (i.e. 10^12 Lovelace)."
-        , Opt.value 1000000000000
+        , Opt.help $ mconcat [ "The maximum possible amount of Lovelace, which is evenly distributed across stake holders. Defaults to 1 million Ada (i.e. 10^12 Lovelace)."
+                             , " If --delegated-supply is specified, a part of this amount will be delegated."
+                             ]
+        , Opt.value 1_000_000_000_000
         ]
     pSupplyDelegated :: Parser (Maybe Lovelace)
     pSupplyDelegated =
       Opt.optional $ fmap Lovelace $ Opt.option Opt.auto $ mconcat
-        [ Opt.long "supply-delegated"
+        [ Opt.long "delegated-supply"
         , Opt.metavar "LOVELACE"
-        , Opt.help "The initial coin supply in Lovelace which will be evenly distributed across initial, delegating stake holders. Defaults to 1 million Ada (i.e. 10^12 Lovelace)."
-        , Opt.value 1000000000000
+        , Opt.help $ mconcat [ "The amount of the total supply which is evenly delegated. Defaults to 500 000 Ada (i.e. (10^12) / 2 Lovelace)."
+                             , " Cannot be more than the amount specified with --total-supply."
+                             ]
+        , Opt.value 500_000_000_000
         ]
     pOutputDir = Opt.strOption $ mconcat
       [ Opt.long "out-dir"
@@ -401,7 +406,7 @@ pSlotLength =
     [ Opt.long "slot-length"
     , Opt.metavar "INT"
     , Opt.help "slot length (ms) parameter for genesis file [default is 1000]."
-    , Opt.value 1000
+    , Opt.value 1_000
     ]
 
 

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

@@ -23,7 +23,6 @@ module Cardano.CLI.EraBased.Run.CreateTestnetData
     , runGenesisKeyGenDelegateCmd
     , runGenesisCreateTestNetDataCmd
     , runGenesisKeyGenDelegateVRF
-    , updateCreateStakedOutputTemplate
   ) where
 
 import           Cardano.Api
@@ -192,8 +191,8 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
    , numDrepKeys
    , numStuffedUtxo
    , numUtxoKeys
-   , supply
-   , supplyDelegated
+   , totalSupply
+   , delegatedSupply
    , systemStart
    , outputDir }
    = do
@@ -299,10 +298,9 @@ runGenesisCreateTestNetDataCmd Cmd.GenesisCreateTestNetDataCmdArgs
       stakePools = [ (Ledger.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ]
       delegAddrs = dInitialUtxoAddr <$> delegations
       !shelleyGenesis' =
-        updateCreateStakedOutputTemplate
-          -- Shelley genesis parameters
-          start genDlgs supply (length nonDelegAddrs) nonDelegAddrs stakePools stake
-          supplyDelegated (length delegations) delegAddrs stuffedUtxoAddrs shelleyGenesis
+        updateOutputTemplate
+          start genDlgs totalSupply nonDelegAddrs stakePools stake
+          delegatedSupply (length delegations) delegAddrs stuffedUtxoAddrs shelleyGenesis
 
   -- Write genesis.json file to output
   liftIO $ LBS.writeFile (outputDir </> "genesis.json") $ Aeson.encode shelleyGenesis'
@@ -567,11 +565,10 @@ computeInsecureDelegation g0 nw pool = do
     pure (g2, delegation)
 
 
-updateCreateStakedOutputTemplate
+updateOutputTemplate
     :: SystemStart -- ^ System start time
     -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based)
-    -> Maybe Lovelace -- ^ Amount of lovelace not delegated
-    -> Int -- ^ Number of UTxO addresses that are delegating
+    -> Maybe Lovelace -- ^ Total amount of lovelace
     -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating
     -> [(Ledger.KeyHash 'Ledger.StakePool StandardCrypto, Ledger.PoolParams StandardCrypto)] -- ^ Pool map
     -> [(Ledger.KeyHash 'Ledger.Staking StandardCrypto, Ledger.KeyHash 'Ledger.StakePool StandardCrypto)] -- ^ Delegaton map
@@ -581,15 +578,15 @@ updateCreateStakedOutputTemplate
     -> [AddressInEra ShelleyEra] -- ^ Stuffed UTxO addresses
     -> ShelleyGenesis StandardCrypto -- ^ Template from which to build a genesis
     -> ShelleyGenesis StandardCrypto -- ^ Updated genesis
-updateCreateStakedOutputTemplate
+updateOutputTemplate
   (SystemStart sgSystemStart)
-  genDelegMap mAmountNonDeleg nUtxoAddrsNonDeleg utxoAddrsNonDeleg pools stake
-  amountDeleg
+  genDelegMap mTotalSupply utxoAddrsNonDeleg pools stake
+  mDelegatedSupply
   nUtxoAddrsDeleg utxoAddrsDeleg stuffedUtxoAddrs
   template@ShelleyGenesis{ sgProtocolParams } =
     template
           { sgSystemStart
-          , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin
+          , sgMaxLovelaceSupply = totalSupply
           , sgGenDelegs = shelleyDelKeys
           , sgInitialFunds = ListMap.fromList
                               [ (toShelleyAddr addr, toShelleyLovelace v)
@@ -608,15 +605,18 @@ updateCreateStakedOutputTemplate
           , sgProtocolParams
           }
   where
+    nUtxoAddrsNonDeleg  = length utxoAddrsNonDeleg
     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
+    totalSupply :: Word64
+    -- if --total-supply is not specified, supply comes from the template passed to this function:
+    totalSupply = maybe maximumLovelaceSupply unLovelace mTotalSupply
+    delegCoin, nonDelegCoin :: Integer
+    delegCoin = case mDelegatedSupply of Nothing -> 0; Just amountDeleg -> fromIntegral totalSupply - unLovelace amountDeleg
+    nonDelegCoin = fromIntegral totalSupply - delegCoin
 
     distribute :: Integer -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
     distribute funds nAddrs addrs = zip addrs (fmap Lovelace (coinPerAddr + remainder:repeat coinPerAddr))

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

@@ -106,6 +106,7 @@ import           Data.Functor (void)
 import           Data.Functor.Identity (Identity)
 import qualified Data.List as List
 import qualified Data.List.Split as List
+import           Data.ListMap (ListMap (..))
 import qualified Data.ListMap as ListMap
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -624,7 +625,7 @@ runGenesisCreateStakedCmd
       stakePools = [ (Ledger.ppId poolParams', poolParams') | poolParams' <- snd . mkDelegationMapEntry <$> delegations ]
       delegAddrs = dInitialUtxoAddr <$> delegations
       !shelleyGenesis =
-        TN.updateCreateStakedOutputTemplate
+        updateOutputTemplate
           -- Shelley genesis parameters
           start genDlgs mNonDelegatedSupply (length nonDelegAddrs) nonDelegAddrs stakePools stake
           (Just delegatedSupply) numDelegations delegAddrs stuffedUtxoAddrs template
@@ -660,6 +661,75 @@ runGenesisCreateStakedCmd
 
 -- -------------------------------------------------------------------------------------------------
 
+updateOutputTemplate
+    :: SystemStart -- ^ System start time
+    -> Map (Hash GenesisKey) (Hash GenesisDelegateKey, Hash VrfKey) -- ^ Genesis delegation (not stake-based)
+    -> Maybe Lovelace -- ^ Amount of lovelace not delegated
+    -> Int -- ^ Number of UTxO addresses that are delegating
+    -> [AddressInEra ShelleyEra] -- ^ UTxO addresses that are not delegating
+    -> [(Ledger.KeyHash 'Ledger.StakePool StandardCrypto, Ledger.PoolParams StandardCrypto)] -- ^ Pool map
+    -> [(Ledger.KeyHash 'Ledger.Staking StandardCrypto, Ledger.KeyHash 'Ledger.StakePool StandardCrypto)] -- ^ Delegaton map
+    -> Maybe Lovelace -- ^ Amount of lovelace to delegate
+    -> Int -- ^ Number of UTxO address for delegation
+    -> [AddressInEra ShelleyEra] -- ^ UTxO address for delegation
+    -> [AddressInEra ShelleyEra] -- ^ Stuffed UTxO addresses
+    -> ShelleyGenesis StandardCrypto -- ^ Template from which to build a genesis
+    -> ShelleyGenesis StandardCrypto -- ^ Updated genesis
+updateOutputTemplate
+  (SystemStart sgSystemStart)
+  genDelegMap mAmountNonDeleg nUtxoAddrsNonDeleg utxoAddrsNonDeleg pools stake
+  amountDeleg
+  nUtxoAddrsDeleg utxoAddrsDeleg stuffedUtxoAddrs
+  template@ShelleyGenesis{ sgProtocolParams } =
+    template
+          { sgSystemStart
+          , sgMaxLovelaceSupply = fromIntegral $ nonDelegCoin + delegCoin
+          , sgGenDelegs = shelleyDelKeys
+          , sgInitialFunds = ListMap.fromList
+                              [ (toShelleyAddr addr, toShelleyLovelace v)
+                              | (addr, v) <-
+                                distribute (nonDelegCoin - subtractForTreasury) nUtxoAddrsNonDeleg  utxoAddrsNonDeleg
+                                ++
+                                distribute (delegCoin - subtractForTreasury)    nUtxoAddrsDeleg     utxoAddrsDeleg
+                                ++
+                                mkStuffedUtxo stuffedUtxoAddrs
+                                ]
+          , sgStaking =
+            ShelleyGenesisStaking
+              { sgsPools = ListMap pools
+              , sgsStake = ListMap stake
+              }
+          , sgProtocolParams
+          }
+  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
+
+    distribute :: Integer -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
+    distribute funds nAddrs addrs = zip addrs (fmap Lovelace (coinPerAddr + remainder:repeat coinPerAddr))
+      where coinPerAddr, remainder :: Integer
+            (coinPerAddr, remainder) = funds `divMod` fromIntegral nAddrs
+
+    mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
+    mkStuffedUtxo xs = (, Lovelace minUtxoVal) <$> xs
+      where Coin minUtxoVal = sgProtocolParams ^. ppMinUTxOValueL
+
+    shelleyDelKeys = Map.fromList
+      [ (gh, Ledger.GenDelegPair gdh h)
+      | (GenesisKeyHash gh,
+          (GenesisDelegateKeyHash gdh, VrfKeyHash h)) <- Map.toList genDelegMap
+      ]
+
+    unLovelace :: Integral a => Lovelace -> a
+    unLovelace (Lovelace coin) = fromIntegral coin
+
 createDelegateKeys :: KeyOutputFormat -> FilePath -> Word -> ExceptT GenesisCmdError IO ()
 createDelegateKeys fmt dir index = do
   liftIO $ createDirectoryIfMissing False dir

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

@@ -268,8 +268,8 @@ Usage: cardano-cli shelley genesis create-testnet-data [--spec-shelley FILE]
                                                          [--drep-keys INT]
                                                          [--stuffed-utxo INT]
                                                          [--utxo-keys INT]
-                                                         [--supply LOVELACE]
-                                                         [--supply-delegated LOVELACE]
+                                                         [--total-supply LOVELACE]
+                                                         [--delegated-supply LOVELACE]
                                                          ( --mainnet
                                                          | --testnet-magic NATURAL
                                                          )
@@ -1427,8 +1427,8 @@ Usage: cardano-cli allegra genesis create-testnet-data [--spec-shelley FILE]
                                                          [--drep-keys INT]
                                                          [--stuffed-utxo INT]
                                                          [--utxo-keys INT]
-                                                         [--supply LOVELACE]
-                                                         [--supply-delegated LOVELACE]
+                                                         [--total-supply LOVELACE]
+                                                         [--delegated-supply LOVELACE]
                                                          ( --mainnet
                                                          | --testnet-magic NATURAL
                                                          )
@@ -2584,8 +2584,8 @@ Usage: cardano-cli mary genesis create-testnet-data [--spec-shelley FILE]
                                                       [--drep-keys INT]
                                                       [--stuffed-utxo INT]
                                                       [--utxo-keys INT]
-                                                      [--supply LOVELACE]
-                                                      [--supply-delegated LOVELACE]
+                                                      [--total-supply LOVELACE]
+                                                      [--delegated-supply LOVELACE]
                                                       ( --mainnet
                                                       | --testnet-magic NATURAL
                                                       )
@@ -3725,8 +3725,8 @@ Usage: cardano-cli alonzo genesis create-testnet-data [--spec-shelley FILE]
                                                         [--drep-keys INT]
                                                         [--stuffed-utxo INT]
                                                         [--utxo-keys INT]
-                                                        [--supply LOVELACE]
-                                                        [--supply-delegated LOVELACE]
+                                                        [--total-supply LOVELACE]
+                                                        [--delegated-supply LOVELACE]
                                                         ( --mainnet
                                                         | --testnet-magic NATURAL
                                                         )
@@ -4890,8 +4890,8 @@ Usage: cardano-cli babbage genesis create-testnet-data [--spec-shelley FILE]
                                                          [--drep-keys INT]
                                                          [--stuffed-utxo INT]
                                                          [--utxo-keys INT]
-                                                         [--supply LOVELACE]
-                                                         [--supply-delegated LOVELACE]
+                                                         [--total-supply LOVELACE]
+                                                         [--delegated-supply LOVELACE]
                                                          ( --mainnet
                                                          | --testnet-magic NATURAL
                                                          )
@@ -6073,8 +6073,8 @@ Usage: cardano-cli conway genesis create-testnet-data [--spec-shelley FILE]
                                                         [--drep-keys INT]
                                                         [--stuffed-utxo INT]
                                                         [--utxo-keys INT]
-                                                        [--supply LOVELACE]
-                                                        [--supply-delegated LOVELACE]
+                                                        [--total-supply LOVELACE]
+                                                        [--delegated-supply LOVELACE]
                                                         ( --mainnet
                                                         | --testnet-magic NATURAL
                                                         )
@@ -7599,8 +7599,8 @@ Usage: cardano-cli latest genesis create-testnet-data [--spec-shelley FILE]
                                                         [--drep-keys INT]
                                                         [--stuffed-utxo INT]
                                                         [--utxo-keys INT]
-                                                        [--supply LOVELACE]
-                                                        [--supply-delegated LOVELACE]
+                                                        [--total-supply LOVELACE]
+                                                        [--delegated-supply LOVELACE]
                                                         ( --mainnet
                                                         | --testnet-magic NATURAL
                                                         )