diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index 71f6aa0dfa..b56c26023e 100644 --- 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 index 71af70c612..2a54e6a458 100644 --- 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 "")) + outputGenesisFp + redactedOutputGenesisFp + + H.diffFileVsGoldenFile + redactedOutputGenesisFp + "test/cardano-cli-golden/files/golden/conway/custom-lovelace-supply-shelley-genesis.json" diff --git a/cardano-cli/test/cardano-cli-golden/files/golden/conway/custom-lovelace-supply-shelley-genesis.json b/cardano-cli/test/cardano-cli-golden/files/golden/conway/custom-lovelace-supply-shelley-genesis.json new file mode 100644 index 0000000000..4a80e5579c --- /dev/null +++ b/cardano-cli/test/cardano-cli-golden/files/golden/conway/custom-lovelace-supply-shelley-genesis.json @@ -0,0 +1,43 @@ +{ + "activeSlotsCoeff": 0.99, + "epochLength": 21600, + "genDelegs": "", + "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": "", + "updateQuorum": 12 +} \ No newline at end of file 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 index a19e7530fb..45cd5e66d3 100644 --- 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