Add golden tests for Cardano.Tracing.OrphanInstances.Shelley

cardano-node/cardano-node.cabal

@@ -247,6 +247,8 @@ test-suite cardano-node-test
                       , cardano-crypto-wrapper
                       , cardano-api:{cardano-api, internal}
                       , cardano-ledger-core
+                      , cardano-ledger-allegra
+                      , cardano-ledger-alonzo
                       , cardano-node
                       , cardano-slotting
                       , directory
@@ -275,5 +277,6 @@ test-suite cardano-node-test
                         Test.Cardano.Node.POM
                         Test.Cardano.Tracing.NewTracing.Consistency
                         Test.Cardano.Tracing.OrphanInstances.HardFork
+                        Test.Cardano.Tracing.OrphanInstances.Shelley
 
   ghc-options:          -threaded -rtsopts "-with-rtsopts=-N -T"

cardano-node/test/Test/Cardano/Tracing/OrphanInstances/Shelley.hs

@@ -0,0 +1,107 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+-- | Test the JSON encoding of instances in Cardano.Tracing.OrphanInstances.Shelley
+--
+-- The golden files are stored in the path given by 'addPrefix'.
+--
+-- If a new test is added and no golden file exists for it it will be created.
+-- This new file needs to be commited.
+--
+-- For now we added a couple of representative examples, however the tests are
+-- not exhaustive.
+--
+-- The examples can be best viewed using a tool like 'jq'.
+module Test.Cardano.Tracing.OrphanInstances.Shelley (tests) where
+
+import           Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
+import           Cardano.Ledger.Alonzo.Rules (FailureDescription (..), TagMismatchDescription (..))
+import           Cardano.Ledger.Alonzo.Tx (IsValid (..))
+import           Cardano.Ledger.BaseTypes (SlotNo (..), StrictMaybe (..))
+import           Cardano.Tracing.OrphanInstances.Shelley ()
+
+import qualified Data.Aeson as Aeson
+import           Data.ByteString.Lazy.Char8 (unpack)
+import qualified Data.List.NonEmpty as NE
+
+import           Hedgehog (Property)
+import qualified Hedgehog as H
+import qualified Hedgehog.Extras.Test.Base as H.Base
+import qualified Hedgehog.Extras.Test.Golden as H.Golden
+import           Hedgehog.Internal.Property (PropertyName (PropertyName))
+
+tests :: IO Bool
+tests = H.checkSequential
+      $ H.Group "Shelley JSON instances"
+        [ test
+            (  validityInterval
+            , "validityInterval.json")
+        , test
+            (  isValid
+            , "isValid.json")
+        , test
+            (  failureDescription
+            , "failureDescription.json")
+        , test
+            (  tagMismatchDescription
+            , "tagMismatchDescription.json")
+        ]
+  where
+    test (actualValue, goldenBaseName) =
+        (PropertyName goldenBaseName, goldenTestJSON actualValue goldenBaseName)
+
+--------------------------------------------------------------------------------
+-- Examples
+--------------------------------------------------------------------------------
+
+validityInterval :: [ValidityInterval]
+validityInterval =
+  [ ValidityInterval
+      { invalidBefore = SNothing
+      , invalidHereafter = SNothing
+      }
+  , ValidityInterval
+      { invalidBefore = SJust (SlotNo 12345)
+      , invalidHereafter = SNothing
+      }
+  , ValidityInterval
+      { invalidBefore = SNothing
+      , invalidHereafter = SJust (SlotNo 12354)
+      }
+  , ValidityInterval
+      { invalidBefore = SJust (SlotNo 12345)
+      , invalidHereafter = SJust (SlotNo 12354)
+      }
+  ]
+
+isValid :: [IsValid]
+isValid =
+  [ IsValid True
+  , IsValid False
+  ]
+
+failureDescription :: [FailureDescription]
+failureDescription =
+  [ PlutusFailure "A description" "A reconstruction"
+  ]
+
+tagMismatchDescription :: [TagMismatchDescription]
+tagMismatchDescription =
+  [ PassedUnexpectedly
+  , FailedUnexpectedly (NE.fromList failureDescription)
+  ]
+
+--------------------------------------------------------------------------------
+-- Helper functions
+--------------------------------------------------------------------------------
+
+goldenTestJSON :: Aeson.ToJSON a => a -> FilePath -> Property
+goldenTestJSON valueToEncode goldenFileBaseName =
+    H.withTests 1 $ H.withShrinks 0 $ H.property $ do
+      goldenFp    <- H.Base.note $ addPrefix goldenFileBaseName
+      let actualValue = unpack $ Aeson.encode valueToEncode
+      H.Golden.diffVsGoldenFile actualValue goldenFp
+
+-- | NB: this function is only used in 'goldenTestJSON' but it is defined at the
+-- top level so that we can refer to it in the documentation of this module.
+addPrefix :: FilePath -> FilePath
+addPrefix fname = "test/Test/Cardano/Tracing/OrphanInstances/data/" <> fname

cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/failureDescription.json

@@ -0,0 +1 @@
+[{"description":"A description","error":"PlutusFailure","kind":"FailureDescription"}]

cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/isValid.json

@@ -0,0 +1 @@
+[true,false]

cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/tagMismatchDescription.json

@@ -0,0 +1 @@
+[{"error":"PassedUnexpectedly","kind":"TagMismatchDescription"},{"error":"FailedUnexpectedly","kind":"TagMismatchDescription","reconstruction":[{"description":"A description","error":"PlutusFailure","kind":"FailureDescription"}]}]

cardano-node/test/Test/Cardano/Tracing/OrphanInstances/data/validityInterval.json

@@ -0,0 +1 @@
+[{},{"invalidBefore":12345},{"invalidHereafter":12354},{"invalidBefore":12345,"invalidHereafter":12354}]

cardano-node/test/cardano-node-test.hs

@@ -14,6 +14,7 @@ import qualified Test.Cardano.Node.FilePermissions
 import qualified Test.Cardano.Node.Json
 import qualified Test.Cardano.Node.POM
 import qualified Test.Cardano.Tracing.OrphanInstances.HardFork
+import qualified Test.Cardano.Tracing.OrphanInstances.Shelley
 import qualified Test.Cardano.Tracing.NewTracing.Consistency
 
 import qualified Cardano.Crypto.Init as Crypto
@@ -35,5 +36,6 @@ main = do
       , Test.Cardano.Node.Json.tests
       , Test.Cardano.Node.POM.tests
       , Test.Cardano.Tracing.OrphanInstances.HardFork.tests
+      , Test.Cardano.Tracing.OrphanInstances.Shelley.tests
       , Test.Cardano.Tracing.NewTracing.Consistency.tests
       ]