Replace usages of assertFileOccurences by usage of new functions ✨ (4/n)

cardano-cli/cardano-cli.cabal

@@ -267,7 +267,8 @@ library cardano-cli-test-lib
   import:               project-config
   visibility:           public
   hs-source-dirs:       test/cardano-cli-test-lib
-  exposed-modules:      Test.Cardano.CLI.Util
+  exposed-modules:      Test.Cardano.CLI.Aeson
+                        Test.Cardano.CLI.Util
   build-depends:        aeson
                       , aeson-pretty
                       , bytestring

cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/KeyGen.hs

@@ -4,6 +4,7 @@ module Test.Golden.Shelley.Address.KeyGen where
 
 import           Control.Monad (void)
 
+import           Test.Cardano.CLI.Aeson
 import           Test.Cardano.CLI.Util
 
 import           Hedgehog (Property)
@@ -12,8 +13,8 @@ import qualified Hedgehog.Extras.Test.File as H
 
 {- HLINT ignore "Use camelCase" -}
 
-hprop_golden_shelleyAddressKeyGen :: Property
-hprop_golden_shelleyAddressKeyGen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
+hprop_golden_shelley_address_key_gen :: Property
+hprop_golden_shelley_address_key_gen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   addressVKeyFile <- noteTempFile tempDir "address.vkey"
   addressSKeyFile <- noteTempFile tempDir "address.skey"
 
@@ -23,14 +24,20 @@ hprop_golden_shelleyAddressKeyGen = propertyOnce . H.moduleWorkspace "tmp" $ \te
     , "--signing-key-file", addressSKeyFile
     ]
 
-  void $ H.readFile addressVKeyFile
-  void $ H.readFile addressSKeyFile
+  assertHasMappings [("type", "PaymentVerificationKeyShelley_ed25519"),
+                     ("description", "Payment Verification Key")]
+                                addressVKeyFile
+  assertHasKeys ["cborHex"]     addressVKeyFile
+  H.assertEndsWithSingleNewline addressVKeyFile
 
-  H.assertFileOccurences 1 "PaymentVerificationKeyShelley_ed25519" addressVKeyFile
-  H.assertFileOccurences 1 "PaymentSigningKeyShelley_ed25519" addressSKeyFile
+  assertHasMappings [("type", "PaymentSigningKeyShelley_ed25519"),
+                     ("description", "Payment Signing Key")]
+                                addressSKeyFile
+  assertHasKeys ["cborHex"]     addressSKeyFile
+  H.assertEndsWithSingleNewline addressSKeyFile
 
-hprop_golden_shelleyAddressExtendedKeyGen :: Property
-hprop_golden_shelleyAddressExtendedKeyGen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
+hprop_golden_shelley_address_extended_key_gen :: Property
+hprop_golden_shelley_address_extended_key_gen = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   addressVKeyFile <- noteTempFile tempDir "address.vkey"
   addressSKeyFile <- noteTempFile tempDir "address.skey"
 
@@ -41,8 +48,14 @@ hprop_golden_shelleyAddressExtendedKeyGen = propertyOnce . H.moduleWorkspace "tm
     , "--signing-key-file", addressSKeyFile
     ]
 
-  void $ H.readFile addressVKeyFile
-  void $ H.readFile addressSKeyFile
-
-  H.assertFileOccurences 1 "PaymentExtendedVerificationKeyShelley_ed25519_bip32" addressVKeyFile
-  H.assertFileOccurences 1 "PaymentExtendedSigningKeyShelley_ed25519_bip32" addressSKeyFile
+  assertHasMappings [("type", "PaymentExtendedVerificationKeyShelley_ed25519_bip32"),
+                     ("description", "Payment Verification Key")]
+                                addressVKeyFile
+  assertHasKeys ["cborHex"]     addressVKeyFile
+  H.assertEndsWithSingleNewline addressVKeyFile
+
+  assertHasMappings [("type", "PaymentExtendedSigningKeyShelley_ed25519_bip32"),
+                     ("description", "Payment Signing Key")]
+                                addressSKeyFile
+  assertHasKeys ["cborHex"]     addressSKeyFile
+  H.assertEndsWithSingleNewline addressSKeyFile

cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenDelegate.hs

@@ -4,6 +4,7 @@ module Test.Golden.Shelley.Genesis.KeyGenDelegate where
 
 import           Control.Monad (void)
 
+import           Test.Cardano.CLI.Aeson
 import           Test.Cardano.CLI.Util
 
 import           Hedgehog (Property)
@@ -12,8 +13,8 @@ import qualified Hedgehog.Extras.Test.File as H
 
 {- HLINT ignore "Use camelCase" -}
 
-hprop_golden_shelleyGenesisKeyGenDelegate :: Property
-hprop_golden_shelleyGenesisKeyGenDelegate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
+hprop_golden_shelley_genesis_key_gen_delegate :: Property
+hprop_golden_shelley_genesis_key_gen_delegate = propertyOnce . H.moduleWorkspace "tmp" $ \tempDir -> do
   verificationKeyFile <- noteTempFile tempDir "key-gen.vkey"
   signingKeyFile <- noteTempFile tempDir "key-gen.skey"
   operationalCertificateIssueCounterFile <- noteTempFile tempDir "op-cert.counter"
@@ -25,13 +26,20 @@ hprop_golden_shelleyGenesisKeyGenDelegate = propertyOnce . H.moduleWorkspace "tm
     , "--operational-certificate-issue-counter", operationalCertificateIssueCounterFile
     ]
 
-  H.assertFileOccurences 1 "GenesisDelegateVerificationKey_ed25519" verificationKeyFile
-  H.assertFileOccurences 1 "GenesisDelegateSigningKey_ed25519" signingKeyFile
-  H.assertFileOccurences 1 "NodeOperationalCertificateIssueCounter" operationalCertificateIssueCounterFile
-
-  H.assertFileOccurences 1 "Genesis delegate operator key" verificationKeyFile
-  H.assertFileOccurences 1 "Genesis delegate operator key" signingKeyFile
-
+  assertHasMappings [("type", "GenesisDelegateVerificationKey_ed25519"),
+                     ("description", "Genesis delegate operator key")]
+                                verificationKeyFile
+  assertHasKeys ["cborHex"]     verificationKeyFile
   H.assertEndsWithSingleNewline verificationKeyFile
+
+  assertHasMappings [("type", "GenesisDelegateSigningKey_ed25519"),
+                     ("description", "Genesis delegate operator key")]
+                                signingKeyFile
+  assertHasKeys ["cborHex"]     signingKeyFile
   H.assertEndsWithSingleNewline signingKeyFile
+
+  assertHasMappings [("type", "NodeOperationalCertificateIssueCounter"),
+                     ("description", "Next certificate issue number: 0")]
+                                operationalCertificateIssueCounterFile
+  assertHasKeys ["cborHex"]     operationalCertificateIssueCounterFile
   H.assertEndsWithSingleNewline operationalCertificateIssueCounterFile

cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Aeson.hs

@@ -0,0 +1,120 @@
+module Test.Cardano.CLI.Aeson (
+    assertHasKeys,
+    assertHasMappings,
+  ) where
+
+import           Control.Monad (forM_)
+import           Control.Monad.IO.Class
+import           Data.Aeson hiding (pairs)
+import qualified Data.Aeson.Key as Aeson
+import qualified Data.Aeson.KeyMap as Aeson.KeyMap
+import qualified Data.ByteString.Lazy as LBS
+import           Data.Text (Text)
+import qualified Data.Text as T
+import           GHC.Stack (HasCallStack)
+import qualified GHC.Stack as GHC
+
+import           Hedgehog
+import qualified Hedgehog as H
+import qualified Hedgehog.Extras as H
+
+{- HLINT ignore "Use uncurry" -}
+
+-- | @assertHasKeys keys path@ succeeds if @path@ is a file containing a JSON object
+-- whose keys is a superset of @keys@.
+--
+-- For example. if @path@ contains @"{ "a":0, "b":1.0, "c": "foo"}"@,
+-- @hasKeys ["b", "a"] path@ succeeds.
+assertHasKeys :: ()
+  => HasCallStack
+  => MonadTest m
+  => MonadIO m
+  => [Text]
+  -> FilePath
+  -> m ()
+assertHasKeys keys jsonFile = GHC.withFrozenCallStack $ do
+  content <- liftIO $ LBS.readFile jsonFile
+  case decode content of
+    Nothing -> do
+      H.note_ $ "Cannot read JSON file: " <> jsonFile
+      H.failure
+    Just obj -> do
+      forM_ keys $ \key -> assertHasKey jsonFile obj key
+
+-- | @assertHasKey file obj key@ checks that @obj@ has @key@ as a top-level key.
+-- @file@ is only used for logging in case of failure: it is assumed to be
+-- the path from which @obj@ was loaded.
+--
+-- Having this functions allows for good feedback in case of a test failure.
+assertHasKey :: ()
+  => HasCallStack
+  => MonadTest m
+  => FilePath
+  -> Object
+  -> Text
+  -> m ()
+assertHasKey file obj key = GHC.withFrozenCallStack $ do
+  case Aeson.KeyMap.lookup (Aeson.fromText key) obj of
+    Nothing -> do
+      H.note_ $ "JSON file at " <> file <> " is missing key: \"" <> T.unpack key <> "\""
+      H.failure
+    Just _ -> H.success
+
+-- | @assertHasMappings pairs path@ succeeds if @path@ is a file containing a JSON object
+-- whose mappings is a superset of @pairs@.
+--
+-- For example, if @path@ contains @"{ "a":"bar", "b":"buzz", "c":"foo"}"@,
+-- @assertHasMappings "[("b", "buzz"), ("a", "bar")] path@ succeeds.
+assertHasMappings :: ()
+  => HasCallStack
+  => MonadTest m
+  => MonadIO m
+  => [(Text, Text)]
+  -> FilePath
+  -> m ()
+assertHasMappings pairs jsonFile = GHC.withFrozenCallStack $ do
+  content <- liftIO $ LBS.readFile jsonFile
+  case decode content of
+    Nothing -> do
+      H.note_ $ "Cannot read JSON file: " <> jsonFile
+      H.failure
+    Just obj -> do
+      forM_ pairs $ \(key, value) -> assertHasMapping jsonFile obj key value
+
+-- | @assertHasMapping file obj key value@ checks that @obj@ has the @key->value@
+-- at its top-level. @file@ is only used for logging in case of failure: it is assumed to be
+-- the path from which @obj@ was loaded.
+--
+-- Having this functions allows for good feedback in case of a test failure.
+assertHasMapping :: ()
+  => HasCallStack
+  => MonadTest m
+  => FilePath
+  -> Object
+  -> Text
+  -> Text
+  -> m ()
+assertHasMapping file obj key value = GHC.withFrozenCallStack $ do
+  case Aeson.KeyMap.lookup (Aeson.fromText key) obj of
+    Nothing -> do
+      H.note_ $ "JSON file at " <> file <> " is missing key: \"" <> T.unpack key <> "\""
+      H.failure
+    Just inThere ->
+      case inThere of
+        String textInThere | value == textInThere -> H.success
+        String textInThere -> do
+            H.note_ $ "JSON file at " <> file <> " has the mapping \"" <> T.unpack key <> "\"->\"" <> T.unpack textInThere <> "\""
+            H.note_ $ "whereas it was expected to be \"" <> T.unpack key <> "\"->\"" <> T.unpack value <> "\""
+            H.failure
+        Object _ -> failWrongType "object"
+        Array _  -> failWrongType "array"
+        Number _ -> failWrongType "number"
+        Bool _   -> failWrongType "bool"
+        Null     -> failWrongType "null"
+   where
+     failWrongType got = do
+       H.note_ $ "JSON file at " <> file <> " has wrong type for key: \"" <> T.unpack key <> "\""
+       H.note_ $ "Expected string but got: " <> got
+       H.failure
+
+