Merge pull request #638 from IntersectMBO/smelc/fix-deleg-non-deleg-c…

…onfusion

create-testnet-data: fix computation of not-delegated amount

cardano-cli/cardano-cli.cabal

@@ -334,6 +334,7 @@ test-suite cardano-cli-golden
                       , cardano-cli
                       , cardano-cli:cardano-cli-test-lib
                       , cardano-crypto-wrapper
+                      , cardano-data >= 1.1
                       , cardano-ledger-byron
                       , cardano-ledger-shelley >=1.7.0.0
                       , cardano-strict-containers ^>= 0.1

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

@@ -606,9 +606,8 @@ updateOutputTemplate
     getCoinForDistribution :: Integer -> m Natural
     getCoinForDistribution inputCoin = do
       let value = inputCoin - subtrahendForTreasury
-      if value < 0
-         then throwError $ GenesisCmdNegativeInitialFunds value
-         else pure $ fromInteger value
+      when (value < 0) $ throwError $ GenesisCmdNegativeInitialFunds value
+      pure $ fromInteger value
 
     nUtxoAddrsNonDeleg  = length utxoAddrsNonDeleg
     maximumLovelaceSupply :: Word64
@@ -622,7 +621,8 @@ updateOutputTemplate
     totalSupply = fromIntegral $ maybe maximumLovelaceSupply unLovelace mTotalSupply
 
     delegCoinRaw, nonDelegCoinRaw :: Integer
-    delegCoinRaw = case mDelegatedSupply of Nothing -> 0; Just (Lovelace amountDeleg) -> totalSupply - amountDeleg
+    delegCoinRaw = maybe 0 unLovelace mDelegatedSupply
+    -- Since the user can specify total supply and delegated amount, the non-delegated amount is:
     nonDelegCoinRaw = totalSupply - delegCoinRaw
 
     distribute :: Natural -> Int -> [AddressInEra ShelleyEra] -> [(AddressInEra ShelleyEra, Lovelace)]

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

@@ -8,9 +8,8 @@ import qualified Cardano.Ledger.Shelley.API as L
 
 import           Control.Monad
 import           Control.Monad.IO.Class
-import qualified Data.Aeson as Aeson
-import qualified Data.ByteString.Lazy as LBS
 import           Data.List (intercalate, sort)
+import qualified Data.ListMap as ListMap
 import qualified Data.Sequence.Strict as Seq
 import           Data.Word (Word32)
 import           System.Directory
@@ -25,7 +24,9 @@ import           Hedgehog.Extras (moduleWorkspace, propertyOnce)
 import qualified Hedgehog.Extras as H
 import qualified Hedgehog.Extras.Test.Golden as H
 
+{- HLINT ignore "Redundant bracket" -}
 {- HLINT ignore "Use camelCase" -}
+{- HLINT ignore "Use head" -}
 
 networkMagic :: Word32
 networkMagic = 623
@@ -110,8 +111,7 @@ golden_create_testnet_data mShelleyTemplate =
     bracketSem createTestnetDataOutSem $
       H.diffVsGoldenFile generated''
 
-    bs <- liftIO $ LBS.readFile $ outputDir </> "genesis.json"
-    genesis :: ShelleyGenesis StandardCrypto <- Aeson.throwDecode bs
+    genesis :: ShelleyGenesis StandardCrypto <- H.readJsonFileOk $ outputDir </> "genesis.json"
 
     sgNetworkMagic genesis H.=== networkMagic
     length (L.sgsPools $ sgStaking genesis) H.=== numPools
@@ -139,3 +139,39 @@ hprop_golden_create_testnet_data_transient_stake_delegators =
     -- 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.
+
+-- Execute this test with:
+-- @cabal test cardano-cli-golden --test-options '-p "/golden create testnet data deleg non deleg/"'@
+hprop_golden_create_testnet_data_deleg_non_deleg :: Property
+hprop_golden_create_testnet_data_deleg_non_deleg =
+  propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do
+
+    let outputDir = tempDir </> "out"
+        totalSupply :: Int = 2000000000000 -- 2*10^12
+        delegatedSupply :: Int = 500000000000 -- 5*10^11, i.e. totalSupply / 4
+
+    void $ execCardanoCLI
+      [ "conway", "genesis", "create-testnet-data"
+      , "--utxo-keys", "1"
+      , "--total-supply", show totalSupply
+      , "--delegated-supply", show delegatedSupply
+      , "--out-dir", outputDir]
+
+    genesis :: ShelleyGenesis StandardCrypto <- H.readJsonFileOk $ outputDir </> "genesis.json"
+
+    -- Because we don't test this elsewhere in this file:
+    (L.sgMaxLovelaceSupply genesis) H.=== (fromIntegral totalSupply)
+
+    let initialFunds = ListMap.toList $ L.sgInitialFunds genesis
+
+    (length initialFunds) H.=== 1
+    let L.Coin onlyHolderCoin = snd $ initialFunds !! 0
+
+    -- The check below may seem weird, but we cannot do a very precise check
+    -- on balances, because of the treasury "stealing" some of the money.
+    -- Nevertheless, this check catches a confusion between delegated and
+    -- non-delegated coins, by virtue of --delegated-supply being a fourth
+    -- of --total-supply above.
+    -- https://github.com/IntersectMBO/cardano-cli/issues/631
+
+    H.assertWith (fromIntegral onlyHolderCoin) (\ohc -> ohc > totalSupply `div` 2)

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

@@ -39,14 +39,17 @@ hprop_create_testnet_data_minimal =
       ]
     success
 
+-- Execute this test with:
+-- @cabal test cardano-cli-test --test-options '-p "/create testnet data create nonegative supply/"'@
 hprop_create_testnet_data_create_nonegative_supply :: Property
 hprop_create_testnet_data_create_nonegative_supply = do
   -- FIXME rewrite this as a property test
   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, 1_000_000_000, ExitSuccess)
+        , (1_000_000_000, 1_100_000_001, ExitFailure 1)
         , (1_000_000_000, 2_000_000_000, ExitFailure 1)
         ] :: [(Int, Int, ExitCode)]