Merge pull request #5480 from IntersectMBO/td/skip-isvalid-in-tx-serialization

Skip `isValid` flag in transaction (de)/serialization

Author: teodanciu

eras/dijkstra/impl/cddl/data/dijkstra.cddl

@@ -15,7 +15,10 @@ block =
 
 
 transaction = 
-  [transaction_body, transaction_witness_set, bool, auxiliary_data/ nil]
+  [  transaction_body, transaction_witness_set, true, auxiliary_data/ nil
+  // transaction_body, transaction_witness_set, auxiliary_data/ nil
+  ]
+
 
 kes_signature = bytes .size 448
 

eras/dijkstra/impl/cddl/lib/Cardano/Ledger/Dijkstra/HuddleSpec.hs

@@ -672,7 +672,12 @@ instance HuddleRule "transaction" DijkstraEra where
       =:= arr
         [ a $ huddleRule @"transaction_body" p
         , a $ huddleRule @"transaction_witness_set" p
-        , a VBool
+        , a $ (bool True)
+        , a (huddleRule @"auxiliary_data" p / VNil)
+        ]
+      / arr
+        [ a $ huddleRule @"transaction_body" p
+        , a $ huddleRule @"transaction_witness_set" p
         , a (huddleRule @"auxiliary_data" p / VNil)
         ]
 

eras/dijkstra/impl/src/Cardano/Ledger/Dijkstra/Tx.hs

@@ -36,6 +36,7 @@ import Cardano.Ledger.Binary (
   EncCBOR (..),
   Encoding,
   ToCBOR (..),
+  decodeListLen,
   decodeNullStrictMaybe,
   encodeListLen,
   encodeNullStrictMaybe,
@@ -119,13 +120,35 @@ instance EraTx era => EncCBOR (DijkstraTx l era) where
 
 instance (EraTx era, Typeable l) => DecCBOR (Annotator (DijkstraTx l era)) where
   decCBOR = withSTxBothLevels @l $ \case
-    STopTx ->
-      decode $
-        Ann (RecD DijkstraTx)
-          <*! From
-          <*! From
-          <*! Ann From
-          <*! D (sequence <$> decodeNullStrictMaybe decCBOR)
+    STopTx -> do
+      decodeListLen >>= \case
+        4 -> do
+          bodyAnn <- decCBOR
+          witsAnn <- decCBOR
+          isValid <-
+            decCBOR
+              >>= \case
+                True -> pure (IsValid True)
+                False -> fail "value `false` not allowed for `isValid`"
+          auxAnn <- decodeNullStrictMaybe decCBOR
+          pure $
+            DijkstraTx
+              <$> bodyAnn
+              <*> witsAnn
+              <*> pure isValid
+              <*> sequence auxAnn
+        3 -> do
+          bodyAnn <- decCBOR
+          witsAnn <- decCBOR
+          auxAnn <- decodeNullStrictMaybe decCBOR
+          pure $
+            DijkstraTx
+              <$> bodyAnn
+              <*> witsAnn
+              <*> pure (IsValid True)
+              <*> sequence auxAnn
+        n ->
+          fail $ "Unexpected list length: " <> show n <> ". Expected: 4 or 3."
     SSubTx ->
       decode $
         Ann (RecD DijkstraSubTx)
@@ -323,7 +346,7 @@ toCBORForMempoolSubmission = \case
       Rec DijkstraTx
         !> To dtBody
         !> To dtWits
-        !> To dtIsValid
+        !> OmitC dtIsValid
         !> E (encodeNullStrictMaybe encCBOR) dtAuxData
   DijkstraSubTx {dstBody, dstWits, dstAuxData} ->
     encode $

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Arbitrary.hs

@@ -131,7 +131,9 @@ sizedDijkstraNativeScript n =
 instance (Arbitrary (TxBody l DijkstraEra), Typeable l) => Arbitrary (Tx l DijkstraEra) where
   arbitrary =
     fmap MkDijkstraTx . withSTxBothLevels @l $ \case
-      STopTx -> DijkstraTx <$> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary
+      -- Per CIP-0167, Dijkstra transactions should always have isValid = True
+      -- The isValid flag is omitted in serialization and defaults to True
+      STopTx -> DijkstraTx <$> arbitrary <*> arbitrary <*> pure (IsValid True) <*> arbitrary
       SSubTx -> DijkstraSubTx <$> arbitrary <*> arbitrary <*> arbitrary
 
 instance Era era => Arbitrary (DijkstraTxCert era) where

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Annotator.hs

@@ -17,6 +17,7 @@ module Test.Cardano.Ledger.Dijkstra.Binary.Annotator (
 
 import Cardano.Ledger.Address (Withdrawals (..))
 import Cardano.Ledger.Allegra.Scripts (invalidBeforeL, invalidHereAfterL)
+import Cardano.Ledger.Alonzo.Tx (IsValid (..))
 import Cardano.Ledger.BaseTypes
 import Cardano.Ledger.Binary
 import Cardano.Ledger.Binary.Coders
@@ -165,12 +166,24 @@ instance Typeable l => DecCBOR (DijkstraTx l DijkstraEra) where
   decCBOR =
     withSTxBothLevels @l $ \case
       STopTx ->
-        decode $
-          RecD DijkstraTx
-            <! From
-            <! From
-            <! From
-            <! D (decodeNullStrictMaybe decCBOR)
+        decodeListLen >>= \case
+          4 -> do
+            body <- decCBOR
+            wits <- decCBOR
+            isValid <-
+              decCBOR
+                >>= \case
+                  True -> pure (IsValid True)
+                  False -> fail "value `false` not allowed for `isValid`"
+            aux <- decodeNullStrictMaybe decCBOR
+            pure $ DijkstraTx body wits isValid aux
+          3 -> do
+            DijkstraTx
+              <$> decCBOR
+              <*> decCBOR
+              <*> pure (IsValid True)
+              <*> decodeNullStrictMaybe decCBOR
+          n -> fail $ "Unexpected list length: " <> show n <> ". Expected: 4 or 3."
       SSubTx ->
         decode $
           RecD DijkstraSubTx

eras/dijkstra/impl/testlib/Test/Cardano/Ledger/Dijkstra/Binary/Golden.hs

@@ -18,14 +18,7 @@ import Cardano.Ledger.BaseTypes (Version)
 import Cardano.Ledger.Binary (Annotator, DecoderError (..), DeserialiseFailure (..), Tokens (..))
 import qualified Cardano.Ledger.Binary as Binary
 import Cardano.Ledger.Coin (Coin (..))
-import Cardano.Ledger.Dijkstra.Core (
-  EraTx (..),
-  EraTxBody (..),
-  EraTxOut (..),
-  EraTxWits (..),
-  TxLevel (..),
-  eraProtVerLow,
- )
+import Cardano.Ledger.Dijkstra.Core
 import Cardano.Ledger.Dijkstra.TxBody
 import Cardano.Ledger.Plutus (SLanguage (..))
 import Cardano.Ledger.TxIn (TxIn (..))
@@ -55,8 +48,11 @@ spec = describe "Golden" . forEachEraVersion @era $ \version -> do
     goldenDuplicatePlutusScriptsDisallowed @era version SPlutusV2
     goldenDuplicatePlutusScriptsDisallowed @era version SPlutusV3
     goldenDuplicatePlutusDataDisallowed @era version
-    goldenSubTransactions @era
     goldenEmptyFields @era version
+  describe "Subtransactions" $ do
+    goldenSubTransactions @era
+  describe "IsValid flag" $ do
+    goldenIsValidFlag @era
 
 goldenEmptyFields :: forall era. DijkstraEraTest era => Version -> Spec
 goldenEmptyFields version =
@@ -279,3 +275,59 @@ goldenSubTransactions = do
         , E (TkMapLen 0)
         , E TkNull
         ]
+
+goldenIsValidFlag :: forall era. DijkstraEraTest era => Spec
+goldenIsValidFlag = do
+  it "Deserialize transactions with missing `isValid` flag" $
+    expectDecoderResultOn @(Tx TopTx era)
+      version
+      txWithoutFlagEnc
+      basicValidTx
+      id
+  it "Deserialize transactions with `isValid` flag set to true" $
+    expectDecoderResultOn @(Tx TopTx era)
+      version
+      txWithFlagTrueEnc
+      basicValidTx
+      id
+  it "Fail to deserialize transactions with `isValid` flag set to false" $
+    expectDecoderFailureAnn @(Tx TopTx era)
+      version
+      txWithFlagFalseEnc
+      ( DecoderErrorDeserialiseFailure
+          "Annotator (Tx TopTx DijkstraEra)"
+          (DeserialiseFailure 13 "value `false` not allowed for `isValid`")
+      )
+  where
+    version = eraProtVerLow @era
+    basicValidTx = mkBasicTx @era @TopTx (mkBasicTxBody @era @TopTx) & isValidTxL .~ IsValid True
+    txWithoutFlagEnc =
+      mconcat
+        [ E $ TkListLen 3
+        , txBodyEnc
+        , E (TkMapLen 0)
+        , E TkNull
+        ]
+    txWithFlagTrueEnc =
+      mconcat
+        [ E $ TkListLen 4
+        , txBodyEnc
+        , E (TkMapLen 0)
+        , E (TkBool True)
+        , E TkNull
+        ]
+    txWithFlagFalseEnc =
+      mconcat
+        [ E $ TkListLen 4
+        , txBodyEnc
+        , E (TkMapLen 0)
+        , E (TkBool False)
+        , E TkNull
+        ]
+    txBodyEnc =
+      mconcat
+        [ E $ TkMapLen 3
+        , Em [E @Int 0, Ev version $ Set.empty @TxIn]
+        , Em [E @Int 1, Ev version $ [] @(TxOut era)]
+        , Em [E @Int 2, E $ Coin 0]
+        ]

libs/cardano-ledger-api/test/Tests.hs

@@ -49,7 +49,10 @@ apiSpec =
       Upgrade.spec @AlonzoEra (BinaryUpgradeOpts False False)
       Upgrade.spec @BabbageEra def
       Upgrade.spec @ConwayEra def
-      Upgrade.spec @DijkstraEra def
+      -- Transactions with isValid=False cannot be binary-upgraded due to CIP-0167,
+      -- which removes the isValid flag from mempool transactions. They are still
+      -- upgradeable via the translateEra method at the hard fork boundary.
+      Upgrade.spec @DijkstraEra (BinaryUpgradeOpts True False)
 
 main :: IO ()
 main = ledgerTestMain apiSpec