From be565afc6450441414e117bed8c6f6de876d310c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 8 Nov 2023 14:40:28 +0100 Subject: [PATCH 1/3] cardano-cli-test-lib: Add functions to test content of JSON files --- cardano-cli/cardano-cli.cabal | 3 +- .../Test/Cardano/CLI/Aeson.hs | 120 ++++++++++++++++++ 2 files changed, 122 insertions(+), 1 deletion(-) create mode 100644 cardano-cli/test/cardano-cli-test-lib/Test/Cardano/CLI/Aeson.hs diff --git a/cardano-cli/cardano-cli.cabal b/cardano-cli/cardano-cli.cabal index a662e3e964..e2f1be004f 100644 --- a/cardano-cli/cardano-cli.cabal +++ b/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 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 new file mode 100644 index 0000000000..d9327eb8ae --- /dev/null +++ b/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 + + From a661b9aadc2f1708649624cdb2127159d15187ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 8 Nov 2023 15:33:03 +0100 Subject: [PATCH 2/3] Shelley/Genesis: harden an existing test --- .../Golden/Shelley/Genesis/KeyGenDelegate.hs | 26 ++++++++++++------- 1 file changed, 17 insertions(+), 9 deletions(-) diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenDelegate.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenDelegate.hs index 1f5dc8e42a..e0b6f8d386 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Genesis/KeyGenDelegate.hs +++ b/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 From 33f723812d46ba2e2581cac8ba6bfce76537c4f0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Cl=C3=A9ment=20Hurlin?= Date: Wed, 8 Nov 2023 15:50:05 +0100 Subject: [PATCH 3/3] Shelley/Address: harden an existing test --- .../Test/Golden/Shelley/Address/KeyGen.hs | 39 ++++++++++++------- 1 file changed, 26 insertions(+), 13 deletions(-) diff --git a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/KeyGen.hs b/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/KeyGen.hs index 24c036adb5..99c67aeec3 100644 --- a/cardano-cli/test/cardano-cli-golden/Test/Golden/Shelley/Address/KeyGen.hs +++ b/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