Add reporting of the underflow amount in the error message

.github/workflows/haskell.yml

@@ -24,7 +24,7 @@ jobs:
 
     env:
       # Modify this value to "invalidate" the cabal cache.
-      CABAL_CACHE_VERSION: "2024-02-06-1"
+      CABAL_CACHE_VERSION: "2024-02-12"
 
     concurrency:
       group: >

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

@@ -82,6 +82,7 @@ import qualified Data.Text as Text
 import           Data.Time (NominalDiffTime, UTCTime, addUTCTime, getCurrentTime)
 import           Data.Word (Word64)
 import           GHC.Generics (Generic)
+import           GHC.Num (Natural)
 import           Lens.Micro ((^.))
 import           System.Directory (createDirectoryIfMissing)
 import           System.FilePath ((</>))
@@ -591,17 +592,17 @@ updateOutputTemplate
   mDelegatedSupply
   nUtxoAddrsDeleg utxoAddrsDeleg stuffedUtxoAddrs
   template@ShelleyGenesis{ sgProtocolParams } = do
-    nonDelegatedFunds <- distribute (nonDelegCoin - subtractForTreasury) nUtxoAddrsNonDeleg utxoAddrsNonDeleg
-    delegatedFunds <- distribute (delegCoin - subtractForTreasury) nUtxoAddrsDeleg utxoAddrsDeleg
+    nonDelegCoin <- getCoinForDistribution nonDelegCoinRaw
+    delegCoin <- getCoinForDistribution delegCoinRaw
     pure template
           { sgSystemStart
           , sgMaxLovelaceSupply = totalSupply
           , sgGenDelegs = shelleyDelKeys
           , sgInitialFunds = ListMap.fromList
                               [ (toShelleyAddr addr, toShelleyLovelace v)
                               | (addr, v) <-
-                                nonDelegatedFunds
-                                ++ delegatedFunds
+                                distribute nonDelegCoin nUtxoAddrsNonDeleg utxoAddrsNonDeleg
+                                ++ distribute delegCoin nUtxoAddrsDeleg utxoAddrsDeleg
                                 ++ mkStuffedUtxo stuffedUtxoAddrs
                               ]
           , sgStaking =
@@ -612,24 +613,32 @@ updateOutputTemplate
           , sgProtocolParams
           }
   where
+    getCoinForDistribution :: Integer -> m Natural
+    getCoinForDistribution inputCoin = do
+      let value = inputCoin - subtrahendForTreasury
+      if value < 0
+         then throwError $ GenesisCmdNegativeInitialFunds value
+         else pure $ fromInteger value
+
     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
-    totalSupply :: Word64
+    subtrahendForTreasury :: Integer
+    subtrahendForTreasury = nonDelegCoinRaw `quot` 10
+
+    totalSupply :: Integral a => a
     -- 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] -> m [(AddressInEra ShelleyEra, Lovelace)]
-    distribute funds nAddrs addrs
-      | funds < 0 = throwError GenesisCmdNegativeInitialFunds
-      | otherwise = pure . zip addrs $ Lovelace <$> (coinPerAddr + remainder:repeat coinPerAddr)
-      where coinPerAddr, remainder :: Integer
+    totalSupply = fromIntegral $ maybe maximumLovelaceSupply unLovelace mTotalSupply
+
+    delegCoinRaw, nonDelegCoinRaw :: Integer
+    delegCoinRaw = case mDelegatedSupply of Nothing -> 0; Just (Lovelace amountDeleg) -> totalSupply - amountDeleg
+    nonDelegCoinRaw = totalSupply - delegCoinRaw
+
+    distribute :: Natural -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]
+    distribute funds nAddrs addrs =
+      zip addrs $ Lovelace . toInteger <$> (coinPerAddr + remainder:repeat coinPerAddr)
+      where coinPerAddr, remainder :: Natural
             (coinPerAddr, remainder) = funds `divMod` fromIntegral nAddrs
 
     mkStuffedUtxo :: [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]

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

@@ -39,7 +39,7 @@ data GenesisCmdError
   | GenesisCmdStakePoolRelayFileError !FilePath !IOException
   | GenesisCmdStakePoolRelayJsonDecodeError !FilePath !String
   | GenesisCmdFileInputDecodeError !(FileError InputDecodeError)
-  | GenesisCmdNegativeInitialFunds
+  | GenesisCmdNegativeInitialFunds !Integer -- ^ total supply underflow
   deriving Show
 
 instance Error GenesisCmdError where
@@ -98,5 +98,5 @@ instance Error GenesisCmdError where
       " Error: " <> pretty e
     GenesisCmdFileInputDecodeError ide ->
       "Error occured while decoding a file: " <> pshow ide
-    GenesisCmdNegativeInitialFunds ->
-      "Provided delegated supply value results in negative initial funds. Decrease delegated amount."
+    GenesisCmdNegativeInitialFunds underflow ->
+      "Provided delegated supply value results in negative initial funds. Decrease delegated amount by " <> pretty ((-1) * underflow) <> " or increase total supply by it."

cardano-cli/test/cardano-cli-test/Test/Cli/CreateTestnetData.hs

@@ -50,6 +50,7 @@ hprop_create_testnet_data_create_nonegative_supply = do
   let supplyValues =
         [ -- (total supply, delegated supply, exit code)
           (2_000_000_000, 1_000_000_000, ExitSuccess)
+        , (1_100_000_000, 1_000_000_000, ExitSuccess)
         , (1_000_000_000, 1_000_000_000, ExitFailure 1)
         , (1_000_000_000, 2_000_000_000, ExitFailure 1)
         ] :: [(Int, Int, ExitCode)]
@@ -58,7 +59,7 @@ hprop_create_testnet_data_create_nonegative_supply = do
     moduleWorkspace "tmp" $ \tempDir -> do
       let outputDir = tempDir </> "out"
 
-      (exitCode, stdout, stderr) <- H.noteShowM $ execDetailCardanoCLI
+      (exitCode, _, _) <- H.noteShowM $ execDetailCardanoCLI
         ["conway",  "genesis", "create-testnet-data"
         , "--testnet-magic", "42"
         , "--pools", "3"
@@ -70,8 +71,7 @@ hprop_create_testnet_data_create_nonegative_supply = do
         , "--out-dir", outputDir
         ]
 
-      H.note_ $ "Expected exit code: " <> show expectedExitCode <> ", received: " <> show exitCode
-      H.note_ $ unlines ["stdout:", stdout, "stderr:", stderr]
+      H.note_ "check that exit code is equal to the expected one"
       exitCode === expectedExitCode
 
       when (exitCode == ExitSuccess) $ do
@@ -84,6 +84,11 @@ hprop_create_testnet_data_create_nonegative_supply = do
         H.note_ "check that all initial funds are positive"
         H.assertWith initialFunds $ all (>= 0) . M.elems
 
+        H.note_ "check that initial funds are not bigger than max lovelace supply"
+        H.assertWith initialFunds $ \initialFunds' -> do
+          let totalDistributed = sum . M.elems $ initialFunds'
+          totalDistributed <= maxLovelaceSupply
+
 data TestGenesis = TestGenesis
   { maxLovelaceSupply :: Int
   , initialFunds :: Map Text Int