Separate conformance and completeness properties for API

The completeness property is very dependent on some specific structure
of the specification YAML and not suited for all types which are
specified in different places in the Yaml

hydra-node/test/Hydra/APISpec.hs

@@ -6,23 +6,31 @@ module Hydra.APISpec where
 import Hydra.Prelude
 
 import Hydra.ClientInput (ClientInput)
-import Hydra.JSONSchema (prop_validateToJSON, withJsonSpecifications)
+import Hydra.JSONSchema (prop_specIsComplete, prop_validateToJSON, withJsonSpecifications)
 import Hydra.Ledger (Utxo)
 import Hydra.Ledger.Cardano (CardanoTx)
 import Hydra.ServerOutput (ServerOutput)
 import System.FilePath ((</>))
 import Test.Hspec (Spec, aroundAll, context, parallel, specify)
-import Test.QuickCheck (property)
+import Test.QuickCheck.Property (conjoin, withMaxSuccess)
 
 spec :: Spec
 spec = parallel $ do
   context "validates JSON representations against API specification" $ do
     aroundAll (withJsonSpecifications "api.yaml") $ do
       specify "ClientInput" $ \(specs, tmp) ->
-        property $ prop_validateToJSON @(ClientInput CardanoTx) specs "inputs" (tmp </> "ClientInput")
+        withMaxSuccess 1 $
+          conjoin
+            [ prop_validateToJSON @(ClientInput CardanoTx) specs (tmp </> "ClientInput")
+            , prop_specIsComplete @(ClientInput CardanoTx) specs "inputs"
+            ]
       specify "ServerOutput" $ \(specs, tmp) ->
-        property $ prop_validateToJSON @(ServerOutput CardanoTx) specs "outputs" (tmp </> "ServerOutput")
+        withMaxSuccess 1 $
+          conjoin
+            [ prop_validateToJSON @(ServerOutput CardanoTx) specs (tmp </> "ServerOutput")
+            , prop_specIsComplete @(ServerOutput CardanoTx) specs "outputs"
+            ]
       specify "Utxo" $ \(specs, tmp) ->
-        property $ prop_validateToJSON @(Utxo CardanoTx) specs "utxo" (tmp </> "Utxo")
+        withMaxSuccess 1 $ prop_validateToJSON @(Utxo CardanoTx) specs (tmp </> "Utxo")
       specify "CardanoTx" $ \(specs, tmp) ->
-        property $ prop_validateToJSON @CardanoTx specs "txs" (tmp </> "CardanoTx")
+        withMaxSuccess 1 $prop_validateToJSON @CardanoTx specs (tmp </> "CardanoTx")

hydra-node/test/Hydra/JSONSchema.hs

@@ -1,6 +1,8 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-unused-imports #-}
+{-# OPTIONS_GHC -Wno-unused-local-binds #-}
 
 module Hydra.JSONSchema where
 
@@ -25,44 +27,55 @@ import qualified Prelude
 
 -- | Generate arbitrary serializable (JSON) value, and check their validity
 -- against a known JSON schema.
+-- This property ensures that JSON instances we produce abide by
+-- the specification. Note this, because this uses an external tool each
+-- property iteration is pretty slow. So instead, we run the property only
+-- once, but on a list of 100 elements all arbitrarily generated.
 prop_validateToJSON ::
   forall a.
   (ToJSON a, Arbitrary a, Show a) =>
   FilePath ->
-  Text ->
   FilePath ->
   Property
-prop_validateToJSON specFile namespace inputFile =
-  withMaxSuccess 1 $
-    conjoin
-      -- This first sub-property ensures that JSON instances we produce abide by
-      -- the specification. Note this, because this uses an external tool each
-      -- property iteration is pretty slow. So instead, we run the property only
-      -- once, but on a list of 100 elements all arbitrarily generated.
-      [ forAllShrink (vectorOf 100 arbitrary) shrink $ \(a :: [a]) ->
-          monadicIO $
-            do
-              run ensureSystemRequirements
-              let obj = Aeson.encode a
-              (exitCode, _out, err) <- run $ do
-                writeFileLBS inputFile obj
-                readProcessWithExitCode "jsonschema" ["-i", inputFile, specFile] mempty
-              monitor $ counterexample err
-              monitor $ counterexample (decodeUtf8 obj)
-              assert (exitCode == ExitSuccess)
-      , -- This second sub-property ensures that any key found in the
-        -- specification corresponds to a constructor in the corresponding
-        -- data-type. This in order the document in sync and make sure we don't
-        -- left behind constructors which no longer exists.
-        forAllBlind (vectorOf 1000 arbitrary) $
-          \(a :: [a]) -> monadicIO $ do
-            specs <- run $ Aeson.decodeFileStrict specFile
-            let unknownConstructors = Map.keys $ Map.filter (== 0) $ classify specs a
-            unless (null unknownConstructors) $ do
-              let commaSeparated = intercalate ", " (toString <$> unknownConstructors)
-              monitor $ counterexample $ "Unimplemented constructors present in specification: " <> commaSeparated
-              assert False
-      ]
+prop_validateToJSON specFile inputFile =
+  forAllShrink (vectorOf 100 arbitrary) shrink $ \(a :: [a]) ->
+    monadicIO $
+      do
+        run ensureSystemRequirements
+        let obj = Aeson.encode a
+        (exitCode, _out, err) <- run $ do
+          writeFileLBS inputFile obj
+          readProcessWithExitCode "jsonschema" ["-i", inputFile, specFile] mempty
+        monitor $ counterexample err
+        monitor $ counterexample (decodeUtf8 obj)
+        assert (exitCode == ExitSuccess)
+
+-- | Check specification is complete wr.t. to generated data
+-- This second sub-property ensures that any key found in the
+-- specification corresponds to a constructor in the corresponding
+-- data-type. This in order the document in sync and make sure we don't
+-- left behind constructors which no longer exists.
+prop_specIsComplete ::
+  forall a.
+  (Arbitrary a, Show a) =>
+  FilePath ->
+  Text ->
+  Property
+prop_specIsComplete specFile namespace =
+  forAllBlind (vectorOf 1000 arbitrary) $ \(a :: [a]) ->
+    monadicIO $ do
+      specs <- run $ Aeson.decodeFileStrict specFile
+      let knownKeys = classify specs a
+      let unknownConstructors = Map.keys $ Map.filter (== 0) knownKeys
+
+      when (null knownKeys) $ do
+        monitor $ counterexample $ "No keys found in given namespace: " <> toString namespace
+        assert False
+
+      unless (null unknownConstructors) $ do
+        let commaSeparated = intercalate ", " (toString <$> unknownConstructors)
+        monitor $ counterexample $ "Unimplemented constructors present in specification: " <> commaSeparated
+        assert False
  where
   -- Like Generics, if you squint hard-enough.
   strawmanGetConstr :: a -> Text

hydra-node/test/Hydra/LoggingSpec.hs

@@ -10,10 +10,9 @@ import Hydra.JSONSchema (prop_validateToJSON, withJsonSpecifications)
 import Hydra.Ledger.Simple (SimpleTx)
 import Hydra.Logging (Verbosity (Verbose), traceWith, withTracer)
 import Hydra.Logging.Messages (HydraLog)
-
 import System.FilePath ((</>))
 import System.IO.Silently (capture_)
-import Test.QuickCheck (property)
+import Test.QuickCheck.Property (withMaxSuccess)
 
 spec :: Spec
 spec = do
@@ -27,7 +26,7 @@ spec = do
   aroundAll (withJsonSpecifications "api-log.yaml") $ do
     specify "HydraLog" $ \(specs, tmp) ->
       -- TODO(AB): Add arbitrary instances for network log entries
-      property $ prop_validateToJSON @(Enveloppe (HydraLog SimpleTx ())) specs "logs" (tmp </> "HydraLog")
+      withMaxSuccess 1 $ prop_validateToJSON @(Enveloppe (HydraLog SimpleTx ())) specs (tmp </> "HydraLog")
 
 -- NOTE(AB): This type is used currently only for testing purpose in
 -- to provide a simple way to generate arbitrary log entries. In the