Implement equality for raw script types

eras/alonzo/impl/src/Cardano/Ledger/Alonzo/Scripts.hs

@@ -27,6 +27,7 @@ module Cardano.Ledger.Alonzo.Scripts
     pointWiseExUnits,
     validScript,
     transProtocolVersion,
+    eqAlonzoScriptRaw,
 
     -- * Cost Model
     CostModel,
@@ -84,7 +85,7 @@ import qualified Cardano.Ledger.Core as Core
 import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.SafeHash (SafeToHash (..))
 import Cardano.Ledger.Shelley (nativeMultiSigTag)
-import Cardano.Ledger.ShelleyMA.Timelocks (Timelock)
+import Cardano.Ledger.ShelleyMA.Timelocks (Timelock, eqTimelockRaw)
 import Control.DeepSeq (NFData (..), deepseq, rwhnf)
 import Control.Monad (when)
 import Control.Monad.Trans.Writer (WriterT (runWriterT))
@@ -428,3 +429,10 @@ validScript pv script =
 transProtocolVersion :: ProtVer -> PV1.ProtocolVersion
 transProtocolVersion (ProtVer major minor) =
   PV1.ProtocolVersion ((fromIntegral :: Word64 -> Int) (getVersion64 major)) (fromIntegral minor)
+
+-- | Check the equality of two underlying types, while ignoring their binary
+-- representation, which `Eq` instance normally does. This is used for testing.
+eqAlonzoScriptRaw :: AlonzoScript era -> AlonzoScript era -> Bool
+eqAlonzoScriptRaw (TimelockScript t1) (TimelockScript t2) = eqTimelockRaw t1 t2
+eqAlonzoScriptRaw (PlutusScript l1 s1) (PlutusScript l2 s2) = l1 == l2 && s1 == s2
+eqAlonzoScriptRaw _ _ = False

eras/alonzo/test-suite/test/Test/Cardano/Ledger/Alonzo/Serialisation/Tripping.hs

@@ -11,7 +11,7 @@ module Test.Cardano.Ledger.Alonzo.Serialisation.Tripping where
 import Cardano.Ledger.Alonzo (Alonzo)
 import Cardano.Ledger.Alonzo.Data (BinaryData, Data (..))
 import Cardano.Ledger.Alonzo.Rules (AlonzoUtxoPredFailure, AlonzoUtxosPredFailure, AlonzoUtxowPredFailure)
-import Cardano.Ledger.Alonzo.Scripts (CostModels)
+import Cardano.Ledger.Alonzo.Scripts (CostModels, eqAlonzoScriptRaw)
 import Cardano.Ledger.Alonzo.TxWits (AlonzoTxWits)
 import Cardano.Ledger.Block (Block)
 import Cardano.Ledger.Core
@@ -32,28 +32,28 @@ tests =
     "Alonzo CBOR round-trip"
     [ testProperty "alonzo/Script" $
         roundTripAnnExpectation @(Script Alonzo) v,
-      -- skip $
-      -- testProperty "alonzo/Script twiddled" $
-      --   roundTripAnnTwiddledProperty @(Script Alonzo) (zipMemoRawType (===)) v,
+      skip $
+        testProperty "alonzo/Script twiddled" $
+          roundTripAnnTwiddledProperty @(Script Alonzo) eqAlonzoScriptRaw v,
       testProperty "alonzo/Data" $
         roundTripAnnExpectation @(Data Alonzo) v,
       skip $
-      testProperty "alonzo/Data twiddled" $
-        roundTripAnnTwiddledProperty @(Data Alonzo) (zipMemoRawType (===)) v,
+        testProperty "alonzo/Data twiddled" $
+          roundTripAnnTwiddledProperty @(Data Alonzo) (zipMemoRawType (===)) v,
       testProperty "alonzo/BinaryData" $
         roundTripCborExpectation @(BinaryData Alonzo) v,
       skip $
-      testProperty "alonzo/BinaryData twiddled" $
-        roundTripTwiddledProperty @(BinaryData Alonzo) v,
+        testProperty "alonzo/BinaryData twiddled" $
+          roundTripTwiddledProperty @(BinaryData Alonzo) v,
       testProperty "alonzo/TxAuxData" $
         roundTripAnnExpectation @(ShelleyTxAuxData Alonzo) v,
       testProperty "alonzo/AlonzoTxWits" $
         roundTripAnnExpectation @(AlonzoTxWits Alonzo) v,
       testProperty "alonzo/TxBody" $
         roundTripAnnExpectation @(TxBody Alonzo) v,
       skip $
-      testProperty "alonzo/TxBody twiddled" $
-        roundTripAnnTwiddledProperty @(TxBody Alonzo) (zipMemoRawType (===)) v,
+        testProperty "alonzo/TxBody twiddled" $
+          roundTripAnnTwiddledProperty @(TxBody Alonzo) (zipMemoRawType (===)) v,
       testProperty "alonzo/CostModels" $
         roundTripCborExpectation @CostModels v,
       testProperty "alonzo/PParams" $

eras/shelley-ma/impl/src/Cardano/Ledger/ShelleyMA/Timelocks.hs

@@ -30,6 +30,7 @@ module Cardano.Ledger.ShelleyMA.Timelocks
     inInterval,
     showTimelock,
     evalTimelock,
+    eqTimelockRaw,
     ValidityInterval (..),
     encodeVI,
     decodeVI,
@@ -74,7 +75,7 @@ import Cardano.Slotting.Slot (SlotNo (..))
 import Control.DeepSeq (NFData (..))
 import Data.ByteString.Lazy (fromStrict)
 import Data.ByteString.Short (fromShort)
-import Data.Sequence.Strict (StrictSeq)
+import Data.Sequence.Strict (StrictSeq (Empty, (:<|)))
 import Data.Set (Set, member)
 import GHC.Generics (Generic)
 import NoThunks.Class (NoThunks (..))
@@ -293,3 +294,19 @@ showTimelock (RequireMOf m xs) = "(MOf " ++ show m ++ " " ++ foldl accum ")" xs
   where
     accum ans x = showTimelock x ++ " " ++ ans
 showTimelock (RequireSignature hash) = "(Signature " ++ show hash ++ ")"
+
+-- | Check the equality of two underlying types, while ignoring their binary
+-- representation, which `Eq` instance normally does. This is used for testing.
+eqTimelockRaw :: Timelock era -> Timelock era -> Bool
+eqTimelockRaw t1 t2 = go (getMemoRawType t1) (getMemoRawType t2)
+  where
+    seqEq Empty Empty = True
+    seqEq (x :<| xs) (y :<| ys) = eqTimelockRaw x y && seqEq xs ys
+    seqEq _ _ = False
+    go (Signature kh1) (Signature kh2) = kh1 == kh2
+    go (AllOf ts1) (AllOf ts2) = seqEq ts1 ts2
+    go (AnyOf ts1) (AnyOf ts2) = seqEq ts1 ts2
+    go (MOfN n1 ts1) (MOfN n2 ts2) = n1 == n2 && seqEq ts1 ts2
+    go (TimeStart sn1) (TimeStart sn2) = sn1 == sn2
+    go (TimeExpire sn1) (TimeExpire sn2) = sn1 == sn2
+    go _ _ = False

libs/cardano-ledger-binary/test-lib/Test/Cardano/Ledger/Binary/RoundTrip.hs

@@ -128,8 +128,9 @@ roundTripTwiddledProperty version t = property $ do
       pure (tDecoded === t)
 
 roundTripAnnTwiddledProperty ::
-  (Twiddle t, FromCBOR (Annotator t)) =>
-  (t -> t -> Property) ->
+  forall t q.
+  (Twiddle t, FromCBOR (Annotator t), Testable q) =>
+  (t -> t -> q) ->
   Version ->
   t ->
   Property
@@ -138,7 +139,7 @@ roundTripAnnTwiddledProperty eqProp version t = property $ do
     Left err ->
       pure $ counterexample ("Failed to deserialize twiddled encoding: " ++ show err) False
     Right tDecoded ->
-      pure (tDecoded `eqProp` t)
+      pure $ property (tDecoded `eqProp` t)
 
 embedTripExpectation ::
   forall a b.