create-testnet-data: add positive test of generation of genesis hashs…

… and paths

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

@@ -1,13 +1,19 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
 module Test.Cli.CreateTestnetData where
 
 import           Control.Monad (forM_, void)
-import           Data.Aeson (FromJSON, ToJSON)
+import           Control.Monad.IO.Class (liftIO)
+import qualified Data.Aeson as Aeson
+import qualified Data.Aeson.Encode.Pretty as Aeson
+import qualified Data.Aeson.Key as Aeson
+import qualified Data.Aeson.KeyMap as Aeson
+import qualified Data.ByteString.Lazy as LBS
 import           Data.List (isInfixOf)
 import           Data.Map.Strict (Map)
 import qualified Data.Map.Strict as M
@@ -118,7 +124,7 @@ data TestGenesis = TestGenesis
   { maxLovelaceSupply :: Int
   , initialFunds :: Map Text Int
   }
-  deriving (Show, Generic, ToJSON, FromJSON)
+  deriving (Show, Generic, Aeson.ToJSON, Aeson.FromJSON)
 
 -- | This test tests the transient case, i.e. it writes strictly
 -- less things to disk than 'hprop_golden_create_testnet_data'. Execute this test with:
@@ -181,3 +187,74 @@ hprop_create_testnet_wrong_genesis_hash =
 
     exitCode === ExitFailure 1
     H.assertWith stderr ("Hash associated to key \"ConwayGenesisHash\" in file" `isInfixOf`)
+
+-- Execute this test with:
+-- @cabal test cardano-cli-test --test-options '-p "/create testnet creates correct hashes and paths/"'@
+hprop_create_testnet_creates_correct_hashes_and_paths :: Property
+hprop_create_testnet_creates_correct_hashes_and_paths =
+  propertyOnce $ moduleWorkspace "tmp" $ \tempDir -> do
+    let outputDir = tempDir </> "out"
+        outputDir2 = tempDir </> "out2"
+        configFile = "test/cardano-cli-test/files/input/conway/create-testnet-data/node-config.json"
+        smallerConfigFile = tempDir </> "smaller-config.json"
+        eras = ["Alonzo", "Conway", "Shelley"]
+        keys = concat [[era <> "GenesisHash", era <> "GenesisFile"] | era <- eras]
+
+    -- Copy and modify the node-config.json file
+    originalConfig <- H.readJsonFileOk configFile
+    let modifiedConfig = removeKeys keys originalConfig
+    liftIO $ LBS.writeFile smallerConfigFile $ Aeson.encodePretty modifiedConfig
+
+    -- Execute create-testnet-data with the small configuration. This will make create-testnet-data
+    -- augment the configuration file with the hashes and paths.
+    H.noteShowM_ $
+      execCardanoCLI
+        [ "conway"
+        , "genesis"
+        , "create-testnet-data"
+        , "--testnet-magic"
+        , "42"
+        , "--node-configuration"
+        , smallerConfigFile
+        , "--out-dir"
+        , outputDir
+        ]
+
+    let augmentedConfigPath = outputDir </> "configuration.json"
+    augmentedConfig :: Aeson.Value <- H.readJsonFileOk augmentedConfigPath
+    H.assertWith augmentedConfig $ \config -> all (hasKey config) keys
+
+    -- Execute creates-testnet-data again with the augmented configuration file
+    -- It should not fail, meaning the hashes and paths generated by the previous call are correct.
+    -- But we need to remove the ShelleyGenesisHash key first, because the content of shelley genesis file
+    -- is not static; because it contains hashes of delegated keys.
+
+    let shelleyLessAugmentedConfigPath = outputDir </> "configuration.json"
+    liftIO $
+      LBS.writeFile shelleyLessAugmentedConfigPath $
+        Aeson.encodePretty $
+          removeKeys ["ShelleyGenesisHash"] augmentedConfig
+
+    H.noteShowM_ $
+      execCardanoCLI
+        [ "conway"
+        , "genesis"
+        , "create-testnet-data"
+        , "--testnet-magic"
+        , "42"
+        , "--node-configuration"
+        , shelleyLessAugmentedConfigPath
+        , "--out-dir"
+        , outputDir2
+        ]
+ where
+  removeKeys :: [Text] -> Aeson.Value -> Aeson.Value
+  removeKeys keys =
+    \case
+      Aeson.Object obj -> Aeson.Object $ foldr (\k -> Aeson.delete (Aeson.fromText k)) obj keys
+      _ -> error "Invalid JSON content: expected an Object"
+  hasKey :: Aeson.Value -> Text -> Bool
+  hasKey v key =
+    case v of
+      Aeson.Object obj -> Aeson.member (Aeson.fromText key) obj
+      _ -> False