Fix logs schema

hydra-node/json-schemas/api.yaml

@@ -1555,7 +1555,7 @@ components:
             tag:
               type: string
               enum: ["InvalidHeadId"]
-            headSeed:
+            headId:
               $ref: "api.yaml#/components/schemas/HeadId"
         - title: FailedToConstructAbortTx
           description: |

hydra-node/json-schemas/logs.yaml

@@ -1732,30 +1732,27 @@ definitions:
         additionalProperties: false
         required:
           - tag
-          - contestationPeriod
-          - parties
           - headId
           - headSeed
+          - headParameters
+          - participants
         description: >-
           The initial transaction of the Head, announcing various parameters and
           the parties, has been posted on-chain.
         properties:
           tag:
             type: string
             enum: ["OnInitTx"]
-          contestationPeriod:
-            type: number
-            description: >-
-              The length of the contestaion period, in seconds, represented as a
-              decimal number.
-          parties:
-            type: array
-            items:
-              $ref: "api.yaml#/components/schemas/Party"
           headId:
             $ref: "api.yaml#/components/schemas/HeadId"
           headSeed:
             $ref: "api.yaml#/components/schemas/HeadSeed"
+          headParameters:
+            $ref: "api.yaml#/components/schemas/HeadParameters"
+          participants:
+            type: array
+            items:
+              $ref: "api.yaml#/components/schemas/OnChainId"
       - title: OnCommitTx
         type: object
         additionalProperties: false
@@ -1806,12 +1803,15 @@ definitions:
         additionalProperties: false
         required:
           - tag
+          - headId
           - snapshotNumber
           - contestationDeadline
         properties:
           tag:
             type: string
             enum: ["OnCloseTx"]
+          headId:
+            $ref: "api.yaml#/components/schemas/HeadId"
           snapshotNumber:
             type: integer
             minimum: 0
@@ -1822,11 +1822,14 @@ definitions:
         additionalProperties: false
         required:
           - tag
+          - headId
           - snapshotNumber
         properties:
           tag:
             type: string
             enum: ["OnContestTx"]
+          headId:
+            $ref: "api.yaml#/components/schemas/HeadId"
           snapshotNumber:
             type: integer
             minimum: 0
@@ -1835,10 +1838,13 @@ definitions:
         additionalProperties: false
         required:
           - tag
+          - headId
         properties:
           tag:
             type: string
             enum: ["OnFanoutTx"]
+          headId:
+            $ref: "api.yaml#/components/schemas/HeadId"
 
   Effect:
     description: >-

hydra-node/src/Hydra/Chain.hs

@@ -95,15 +95,22 @@ data OnChainTx tx
       , headParameters :: HeadParameters
       , participants :: [OnChainId]
       }
-  | OnCommitTx {headId :: HeadId, party :: Party, committed :: UTxOType tx}
+  | OnCommitTx
+      { headId :: HeadId
+      , party :: Party
+      , committed :: UTxOType tx
+      }
   | OnAbortTx {headId :: HeadId}
   | OnCollectComTx {headId :: HeadId}
   | OnCloseTx
       { headId :: HeadId
       , snapshotNumber :: SnapshotNumber
       , contestationDeadline :: UTCTime
       }
-  | OnContestTx {headId :: HeadId, snapshotNumber :: SnapshotNumber}
+  | OnContestTx
+      { headId :: HeadId
+      , snapshotNumber :: SnapshotNumber
+      }
   | OnFanoutTx {headId :: HeadId}
   deriving stock (Generic)
 

hydra-node/test/Hydra/API/HTTPServerSpec.hs

@@ -18,7 +18,7 @@ import System.FilePath ((</>))
 import System.IO.Unsafe (unsafePerformIO)
 import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
 import Test.Hspec.Wai (MatchBody (..), ResponseMatcher (matchBody), get, shouldRespondWith, with)
-import Test.QuickCheck.Property (counterexample, forAll, property, withMaxSuccess)
+import Test.QuickCheck.Property (counterexample, forAll, property)
 
 spec :: Spec
 spec = do
@@ -29,38 +29,30 @@ spec = do
     roundtripAndGoldenSpecs (Proxy @(ReasonablySized TransactionSubmitted))
 
     prop "Validate /commit publish api schema" $
-      property $
-        withMaxSuccess 1 $
-          prop_validateJSONSchema @DraftCommitTxRequest "api.json" $
-            key "components" . key "messages" . key "DraftCommitTxRequest" . key "payload"
+      prop_validateJSONSchema @DraftCommitTxRequest "api.json" $
+        key "components" . key "messages" . key "DraftCommitTxRequest" . key "payload"
 
     prop "Validate /commit subscribe api schema" $
-      property $
-        withMaxSuccess 1 $
-          prop_validateJSONSchema @DraftCommitTxResponse "api.json" $
-            key "components" . key "messages" . key "DraftCommitTxResponse" . key "payload"
+      prop_validateJSONSchema @DraftCommitTxResponse "api.json" $
+        key "components" . key "messages" . key "DraftCommitTxResponse" . key "payload"
 
     prop "Validate /cardano-transaction publish api schema" $
-      property $
-        withMaxSuccess 1 $
-          prop_validateJSONSchema @(SubmitTxRequest Tx) "api.json" $
-            key "channels"
-              . key "/cardano-transaction"
-              . key "publish"
-              . key "message"
-              . key "payload"
+      prop_validateJSONSchema @(SubmitTxRequest Tx) "api.json" $
+        key "channels"
+          . key "/cardano-transaction"
+          . key "publish"
+          . key "message"
+          . key "payload"
 
     prop "Validate /cardano-transaction subscribe api schema" $
-      property $
-        withMaxSuccess 1 $
-          prop_validateJSONSchema @TransactionSubmitted "api.json" $
-            key "channels"
-              . key "/cardano-transaction"
-              . key "subscribe"
-              . key "message"
-              . key "oneOf"
-              . nth 0
-              . key "payload"
+      prop_validateJSONSchema @TransactionSubmitted "api.json" $
+        key "channels"
+          . key "/cardano-transaction"
+          . key "subscribe"
+          . key "message"
+          . key "oneOf"
+          . nth 0
+          . key "payload"
 
     apiServerSpec
     describe "SubmitTxRequest accepted tx formats" $ do

hydra-node/test/Hydra/LoggingSpec.hs

@@ -20,12 +20,8 @@ spec = do
 
     captured `shouldContain` "{\"foo\":42}"
 
-  -- NOTE: We limit the number of successes because those tests are rather
-  -- slow and the underlying `Property` already generate large samples.
-  modifyMaxSuccess (const 5) $
-    prop "Validates logs.yaml schema" $
-      prop_validateJSONSchema @(Envelope (HydraLog Tx ())) "logs.json" id
+  prop "Validates logs.yaml schema" $
+    prop_validateJSONSchema @(Envelope (HydraLog Tx ())) "logs.json" id
 
-  modifyMaxSuccess (const 10) $
-    prop "Schema covers all defined log entries" $
-      prop_specIsComplete @(HydraLog Tx ()) "logs.json" (key "properties" . key "message")
+  prop "Schema covers all defined log entries" $
+    prop_specIsComplete @(HydraLog Tx ()) "logs.json" (key "properties" . key "message")

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, mapSize, vectorOf, withMaxSuccess)
+import Test.QuickCheck (Property, counterexample, forAllShrink, vectorOf, withMaxSuccess)
 import Test.QuickCheck.Monadic (assert, monadicIO, monitor, run)
 import Prelude qualified
 
@@ -73,7 +73,7 @@ validateJSON schemaFilePath selector value = do
         writeFileLBS jsonSchema (Aeson.encode jsonSpecSchema)
     -- Validate using external program
     (exitCode, out, err) <-
-      readProcessWithExitCode "check-jsonschema" ["--schemafile", jsonSchema, jsonInput] ""
+      readProcessWithExitCode "check-jsonschema" ["-v", "--schemafile", jsonSchema, jsonInput] ""
     when (exitCode /= ExitSuccess) $
       failure . toString $
         unlines
@@ -90,20 +90,23 @@ validateJSON schemaFilePath selector value = do
 
 -- | Validate an 'Arbitrary' value against a JSON schema.
 --
+-- NOTE: This property runs with a fixed `maxSuccess` of 1, but generates 100
+-- values of 'a' to reduce the number of calls to the external schema validation
+-- (which is slow).
+--
 -- See 'validateJSON' for how to provide a selector.
 prop_validateJSONSchema ::
   forall a.
-  (ToJSON a, Arbitrary a, Show a) =>
+  (HasCallStack, ToJSON a, Arbitrary a, Show a) =>
   -- | Path to the JSON file holding the schema.
   FilePath ->
   -- | Selector into the JSON file pointing to the schema to be validated.
   SchemaSelector ->
   Property
 prop_validateJSONSchema specFileName selector =
-  -- 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]) ->
+  withMaxSuccess 1 $
+    -- NOTE: Shrinking will produce smaller lists again
+    forAllShrink (vectorOf 1000 arbitrary) shrink $ \(samples :: [a]) ->
       monadicIO $ do
         withJsonSpecifications $ \tmpDir -> do
           run ensureSystemRequirements