fixup! create-testnet-data: add test demonstrating the bug that the t…

…otalSupply value from the template is ignored
IntersectMBO · Aug 26, 2024 · 099cb78 · 099cb78
1 parent 842bd05
commit 099cb78
Show file tree

Hide file tree

Showing 4 changed files with 117 additions and 21 deletions.
diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal
@@ -292,6 +292,7 @@ library cardano-cli-test-lib
     bytestring,
     cardano-api,
     cardano-cli,
+    containers,
     directory,
     exceptions,
     filepath,
@@ -302,6 +303,7 @@ library cardano-cli-test-lib
     process,
     text,
     transformers-base,
+    vector,
 
 test-suite cardano-cli-test
   import: project-config

diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/CreateTestnetData.hs
@@ -3,28 +3,25 @@
 
 module Test.Golden.CreateTestnetData where
 
-import           Cardano.Api
-import           Cardano.Api.Ledger (ConwayGenesis (..), StandardCrypto)
-import           Cardano.Api.Shelley (ShelleyGenesis (..))
-
+import Cardano.Api
+import Cardano.Api.Ledger (ConwayGenesis (..), StandardCrypto)
+import Cardano.Api.Shelley (ShelleyGenesis (..))
 import qualified Cardano.Ledger.Shelley.API as L
-
-import           Control.Monad
-import           Data.List (intercalate, sort)
+import Control.Monad
+import Data.List (intercalate, sort)
 import qualified Data.Sequence.Strict as Seq
-import           Data.Word (Word32)
-import           GHC.Exts (IsList (..))
-import           System.Directory
-import           System.Directory.Extra (listDirectories)
-import           System.FilePath
-
-import           Test.Cardano.CLI.Util (FileSem, bracketSem, execCardanoCLI, newFileSem)
-
-import           Hedgehog (Property)
+import Data.Word (Word32)
+import GHC.Exts (IsList (..))
+import Hedgehog (Property)
 import qualified Hedgehog as H
-import           Hedgehog.Extras (moduleWorkspace, propertyOnce)
+import Hedgehog.Extras (moduleWorkspace, propertyOnce)
 import qualified Hedgehog.Extras as H
 import qualified Hedgehog.Extras.Test.Golden as H
+import System.Directory
+import System.Directory.Extra (listDirectories)
+import System.FilePath
+import Test.Cardano.CLI.Aeson
+import Test.Cardano.CLI.Util (FileSem, bracketSem, execCardanoCLI, newFileSem)
 
 {- HLINT ignore "Redundant bracket" -}
 {- HLINT ignore "Use camelCase" -}
@@ -220,8 +217,14 @@ hprop_golden_create_testnet_data_total_supply_template =
         , outputDir
         ]
 
-    outputGenesis :: ShelleyGenesis StandardCrypto <-
-      H.readJsonFileOk $ outputDir </> "shelley-genesis.json"
+    let outputGenesisFp = outputDir </> "shelley-genesis.json"
+        redactedOutputGenesisFp = outputDir </> "shelley-genesis-redacted.json"
 
-    -- Because we don't test this elsewhere in this file:
-    (L.sgMaxLovelaceSupply outputGenesis) H.=== tweakedValue
+    redactJsonFieldsInFile
+      (fromList $ zip ["genDelegs", "systemStart"] (repeat "<redacted>"))
+      outputGenesisFp
+      redactedOutputGenesisFp
+
+    H.diffFileVsGoldenFile
+      redactedOutputGenesisFp
+      "test/cardano-cli-golden/files/golden/conway/custom-lovelace-supply-shelley-genesis.json"
diff --git a/...i/test/cardano-cli-golden/files/golden/conway/custom-lovelace-supply-shelley-genesis.json b/...i/test/cardano-cli-golden/files/golden/conway/custom-lovelace-supply-shelley-genesis.json
@@ -0,0 +1,43 @@
+{
+    "activeSlotsCoeff": 0.99,
+    "epochLength": 21600,
+    "genDelegs": "<redacted>",
+    "initialFunds": {},
+    "maxKESEvolutions": 1080000,
+    "maxLovelaceSupply": 3123456000000,
+    "networkId": "Testnet",
+    "networkMagic": 403,
+    "protocolParams": {
+        "a0": 0,
+        "decentralisationParam": 0.99,
+        "eMax": 0,
+        "extraEntropy": {
+            "tag": "NeutralNonce"
+        },
+        "keyDeposit": 0,
+        "maxBlockBodySize": 2097152,
+        "maxBlockHeaderSize": 8192,
+        "maxTxSize": 2048,
+        "minFeeA": 0,
+        "minFeeB": 0,
+        "minPoolCost": 100,
+        "minUTxOValue": 1,
+        "nOpt": 100,
+        "poolDeposit": 0,
+        "protocolVersion": {
+            "major": 0,
+            "minor": 0
+        },
+        "rho": 0,
+        "tau": 0
+    },
+    "securityParam": 2160,
+    "slotLength": 20,
+    "slotsPerKESPeriod": 216000,
+    "staking": {
+        "pools": {},
+        "stake": {}
+    },
+    "systemStart": "<redacted>",
+    "updateQuorum": 12
+}
diff --git a/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Aeson.hs b/cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Aeson.hs
@@ -4,17 +4,22 @@ module Test.Cardano.CLI.Aeson
   ( assertEqualModuloDesc
   , assertHasKeys
   , assertHasMappings
+  , redactJsonFieldsInFile
   )
 where
 
 import           Control.Monad (forM_)
 import           Control.Monad.IO.Class
 import           Data.Aeson hiding (pairs)
+import           Data.Aeson.Encode.Pretty (encodePretty)
+import           Data.Aeson.Key
 import qualified Data.Aeson.Key as Aeson
 import qualified Data.Aeson.KeyMap as Aeson.KeyMap
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.Map as Map
 import           Data.Text (Text)
 import qualified Data.Text as T
+import qualified Data.Vector as Vector
 import           GHC.Stack (HasCallStack)
 import qualified GHC.Stack as GHC
 
@@ -176,3 +181,46 @@ removeDescription v =
   failWrongType got = do
     H.note_ $ "Expected object but got: " <> got
     H.failure
+
+-- | @redactJsonStringFieldInFile [(k0, v0), (k1, v1), ..] sourceFilePath targetFilePath@ reads the JSON at @sourceFilePath@, and then
+-- replaces the value associated to @k0@ by @v0@, replaces the value associated to @k1@ by @v1@, etc.
+-- Then the obtained JSON is written to @targetFilePath@. This replacement is done recursively
+-- so @k0@, @k1@, etc. can appear at any depth within the JSON.
+redactJsonFieldsInFile
+  :: ()
+  => MonadTest m
+  => MonadIO m
+  => HasCallStack
+  => Map.Map Text Text
+  -- ^ Map from key name, to the new (String) value to attach to this key
+  -> FilePath
+  -> FilePath
+  -> m ()
+redactJsonFieldsInFile changes sourceFilePath targetFilePath = GHC.withFrozenCallStack $ do
+  contents <- H.evalIO $ LBS.readFile sourceFilePath
+  case eitherDecode contents :: Either String Value of
+    Left err -> do
+      H.note_ $ "Failed to decode JSON: " <> err
+      H.success
+    Right json -> do
+      let redactedJson = redactJsonFields changes json
+      H.evalIO $ LBS.writeFile targetFilePath $ encodePretty redactedJson
+
+redactJsonFields :: () => Map.Map Text Text -> Value -> Value
+redactJsonFields changes v =
+  case v of
+    Object obj ->
+      let obj' =
+            Aeson.KeyMap.mapWithKey
+              ( \k v' ->
+                  case Map.lookup (toText k) changes of
+                    Just replacement -> String replacement
+                    Nothing -> recurse v'
+              )
+              obj
+       in Object obj'
+    Array vector ->
+      Array $ Vector.map recurse vector
+    _ -> v
+ where
+  recurse = redactJsonFields changes