Reuse validateJSONSchema in prop_validateJSONSchema

hydra-node/test/Hydra/JSONSchemaSpec.hs

@@ -7,11 +7,12 @@ import Test.Hydra.Prelude
 import Control.Exception (IOException)
 import Data.Aeson (Value (..), object, (.=))
 import Data.Aeson.Lens (key)
-import Hydra.JSONSchema (validateJSON, withJsonSpecifications)
+import Hydra.JSONSchema (prop_validateJSONSchema, validateJSON, withJsonSpecifications)
 import System.FilePath ((</>))
+import Test.QuickCheck.Instances.Time ()
 
 spec :: Spec
-spec =
+spec = do
   describe "validateJSON withJsonSpecifications" $ do
     it "works using identity selector and Null input" $
       withJsonSpecifications $ \dir ->
@@ -49,3 +50,9 @@ spec =
           -- NOTE: MultiSignature has a local ref into api.yaml for Signature
           (key "components" . key "schemas" . key "MultiSignature")
           (object ["multiSignature" .= [String "bar"]])
+
+  describe "prop_validateJSONSchema" $
+    it "works with api.yaml and UTCTime" $
+      prop_validateJSONSchema @UTCTime
+        "api.yaml"
+        (key "components" . key "schemas" . key "UTCTime")

hydra-node/testlib/Hydra/JSONSchema.hs

@@ -23,7 +23,7 @@ import System.Exit (ExitCode (..))
 import System.FilePath (normalise, takeBaseName, takeDirectory, takeExtension, takeFileName, (<.>), (</>))
 import System.IO.Error (IOError, isDoesNotExistError)
 import System.Process (readProcessWithExitCode)
-import Test.QuickCheck (Property, counterexample, forAllShrink, resize, vectorOf)
+import Test.QuickCheck (Property, counterexample, forAllShrink, mapSize, resize, vectorOf, withMaxSuccess)
 import Test.QuickCheck.Monadic (assert, monadicIO, monitor, run)
 import Prelude qualified
 
@@ -100,32 +100,26 @@ prop_validateJSONSchema ::
   SchemaSelector ->
   Property
 prop_validateJSONSchema specFileName selector =
-  forAllShrink (resize 10 arbitrary) shrink $ \(samples :: [a]) ->
-    monadicIO $ do
-      withJsonSpecifications $ \tmpDir -> do
-        run ensureSystemRequirements
-        let jsonInput = tmpDir </> "jsonInput"
-        let jsonSchema = tmpDir </> "jsonSchema"
-        let specJsonFile = tmpDir </> specFileName
-        mSpecs <- run $ Aeson.decodeFileStrict specJsonFile
-        case mSpecs of
-          Nothing -> error "Failed to decode specFile to JSON"
-          Just specs -> run $ do
-            let jsonSpecSchema =
+  -- NOTE: Avoid slow execution (due to external program) by testing the
+  -- property once with size 100 instead of 100 times with growing sizes.
+  withMaxSuccess 1 . mapSize (const 100) $
+    forAllShrink arbitrary shrink $ \(samples :: [a]) ->
+      monadicIO $ do
+        withJsonSpecifications $ \tmpDir -> do
+          run ensureSystemRequirements
+          let jsonSchema = tmpDir </> "jsonSchema"
+          run $
+            Aeson.decodeFileStrict (tmpDir </> specFileName) >>= \case
+              Nothing -> error "Failed to decode specFile to JSON"
+              Just specs -> do
+                Aeson.encodeFile jsonSchema $
                   Aeson.object
                     [ "$id" .= ("file://" <> tmpDir <> "/")
                     , "type" .= Aeson.String "array"
                     , "items" .= (specs ^? selector)
                     ]
-            writeFileLBS jsonInput (Aeson.encode samples)
-            writeFileLBS jsonSchema (Aeson.encode jsonSpecSchema)
-        monitor $ counterexample (decodeUtf8 . Aeson.encode $ samples)
-        -- TODO: should be able to re-use validateJSON here
-        (exitCode, out, err) <- run $ do
-          readProcessWithExitCode "check-jsonschema" ["--schemafile", jsonSchema, jsonInput] mempty
-        monitor $ counterexample out
-        monitor $ counterexample err
-        assert (exitCode == ExitSuccess)
+          monitor $ counterexample (decodeUtf8 . Aeson.encode $ samples)
+          run $ validateJSON jsonSchema id (toJSON samples)
 
 -- | Check specification is complete wr.t. to generated data
 -- This second sub-property ensures that any key found in the