new predicate for non-output supplementary datums

alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs

@@ -48,6 +48,7 @@ import Control.DeepSeq (NFData (..))
 import Control.Iterate.SetAlgebra (domain, eval, (⊆), (◁), (➖))
 import Control.State.Transition.Extended
 import Data.Coders
+import Data.Foldable (toList)
 import qualified Data.Map.Strict as Map
 import Data.Sequence.Strict (StrictSeq)
 import Data.Set (Set)
@@ -97,6 +98,9 @@ data AlonzoPredFail era
   | MissingRequiredDatums
       !(Set (DataHash (Crypto era))) -- Set of missing data hashes
       !(Set (DataHash (Crypto era))) -- Set of received data hashes
+  | NonOutputSupplimentaryDatums
+      !(Set (DataHash (Crypto era))) -- Set of unallowed data hashes
+      !(Set (DataHash (Crypto era))) -- Set of acceptable supplimental data hashes
   | PPViewHashesDontMatch
       !(StrictMaybe (WitnessPPDataHash (Crypto era)))
       -- ^ The PPHash in the TxBody
@@ -149,9 +153,10 @@ encodePredFail ::
 encodePredFail (WrappedShelleyEraFailure x) = Sum WrappedShelleyEraFailure 0 !> E toCBOR x
 encodePredFail (UnRedeemableScripts x) = Sum UnRedeemableScripts 1 !> To x
 encodePredFail (MissingRequiredDatums x y) = Sum MissingRequiredDatums 2 !> To x !> To y
-encodePredFail (PPViewHashesDontMatch x y) = Sum PPViewHashesDontMatch 3 !> To x !> To y
-encodePredFail (MissingRequiredSigners x) = Sum MissingRequiredSigners 4 !> To x
-encodePredFail (UnspendableUTxONoDatumHash x) = Sum UnspendableUTxONoDatumHash 5 !> To x
+encodePredFail (NonOutputSupplimentaryDatums x y) = Sum NonOutputSupplimentaryDatums 3 !> To x !> To y
+encodePredFail (PPViewHashesDontMatch x y) = Sum PPViewHashesDontMatch 4 !> To x !> To y
+encodePredFail (MissingRequiredSigners x) = Sum MissingRequiredSigners 5 !> To x
+encodePredFail (UnspendableUTxONoDatumHash x) = Sum UnspendableUTxONoDatumHash 6 !> To x
 
 instance
   ( Era era,
@@ -174,9 +179,10 @@ decodePredFail ::
 decodePredFail 0 = SumD WrappedShelleyEraFailure <! D fromCBOR
 decodePredFail 1 = SumD UnRedeemableScripts <! From
 decodePredFail 2 = SumD MissingRequiredDatums <! From <! From
-decodePredFail 3 = SumD PPViewHashesDontMatch <! From <! From
-decodePredFail 4 = SumD MissingRequiredSigners <! From
-decodePredFail 5 = SumD UnspendableUTxONoDatumHash <! From
+decodePredFail 3 = SumD NonOutputSupplimentaryDatums <! From <! From
+decodePredFail 4 = SumD PPViewHashesDontMatch <! From <! From
+decodePredFail 5 = SumD MissingRequiredSigners <! From
+decodePredFail 6 = SumD UnspendableUTxONoDatumHash <! From
 decodePredFail n = Invalid n
 
 -- =============================================
@@ -270,8 +276,22 @@ alonzoStyleWitness = do
     SJust utxoHashes -> do
       let txHashes = domain (unTxDats . txdats . wits $ tx)
           inputHashes = Set.fromList utxoHashes
-          unmatchedInputHashes = eval (inputHashes ➖ txHashes)
-      Set.null unmatchedInputHashes ?! MissingRequiredDatums unmatchedInputHashes txHashes
+          unmatchedDatumHashes = eval (inputHashes ➖ txHashes)
+      Set.null unmatchedDatumHashes ?! MissingRequiredDatums unmatchedDatumHashes txHashes
+
+      -- Check that all supplimental datums contained in the witness set appear in the outputs.
+      let outputDatumHashes =
+            Set.fromList
+              [ dh
+                | out <- toList $ getField @"outputs" txbody,
+                  SJust dh <- [getField @"datahash" out]
+              ]
+          supplimentalDatumHashes = eval (txHashes ➖ inputHashes)
+          (okSupplimentalDHs, notOkSupplimentalDHs) =
+            Set.partition (`Set.member` outputDatumHashes) supplimentalDatumHashes
+      Set.null notOkSupplimentalDHs
+        ?! NonOutputSupplimentaryDatums notOkSupplimentalDHs okSupplimentalDHs
+
   {-  ∀ sph ∈ scriptsNeeded utxo tx, checkScriptData tx utxo  ph  -}
   let sphs :: [(ScriptPurpose (Crypto era), ScriptHash (Crypto era))]
       sphs = scriptsNeeded utxo tx

cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs

@@ -913,6 +913,58 @@ utxoStEx9 ::
   UTxOState era
 utxoStEx9 pf = UTxOState (utxoEx9 pf) (Coin 0) (Coin 5) def
 
+-- ====================================================================================
+--  Example 10: A transaction with an acceptable supplimentary datum
+-- ====================================================================================
+
+outEx10 :: forall era. (Scriptic era) => Proof era -> Core.TxOut era
+outEx10 pf =
+  newTxOut
+    Override
+    pf
+    [ Address (scriptAddr (always 3 pf) pf),
+      Amount (inject $ Coin 995),
+      DHash [hashData $ datumExample1 @era]
+    ]
+
+okSupplimentaryDatumTxBody :: Scriptic era => Proof era -> Core.TxBody era
+okSupplimentaryDatumTxBody pf =
+  newTxBody
+    Override
+    pf
+    [ Inputs [TxIn genesisId 3],
+      Outputs [outEx10 pf],
+      Txfee (Coin 5)
+    ]
+
+okSupplimentaryDatumTx ::
+  forall era.
+  ( Scriptic era,
+    SignBody era
+  ) =>
+  Proof era ->
+  Core.Tx era
+okSupplimentaryDatumTx pf =
+  newTx
+    Override
+    pf
+    [ Body (okSupplimentaryDatumTxBody pf),
+      Witnesses'
+        [ AddrWits [makeWitnessVKey (hashAnnotated (okSupplimentaryDatumTxBody pf)) (someKeys pf)],
+          DataWits [datumExample1]
+        ]
+    ]
+
+utxoEx10 :: forall era. PostShelley era => Proof era -> UTxO era
+utxoEx10 pf = expectedUTxO pf (ExpectSuccess (okSupplimentaryDatumTxBody pf) (outEx10 pf)) 3
+
+utxoStEx10 ::
+  forall era.
+  (Default (State (EraRule "PPUP" era)), PostShelley era) =>
+  Proof era ->
+  UTxOState era
+utxoStEx10 pf = UTxOState (utxoEx10 pf) (Coin 0) (Coin 5) def
+
 -- =======================
 -- Invalid Transactions
 -- =======================
@@ -1254,6 +1306,40 @@ plutusOutputWithNoDataTx pf =
         ]
     ]
 
+totallyIrrelevantDatum :: Data era
+totallyIrrelevantDatum = Data (Plutus.I 1729)
+
+outputWithNoDatum :: forall era. Era era => Proof era -> Core.TxOut era
+outputWithNoDatum pf = newTxOut Override pf [Address $ someAddr pf, Amount (inject $ Coin 995)]
+
+notOkSupplimentaryDatumTxBody :: Scriptic era => Proof era -> Core.TxBody era
+notOkSupplimentaryDatumTxBody pf =
+  newTxBody
+    Override
+    pf
+    [ Inputs [TxIn genesisId 3],
+      Outputs [outputWithNoDatum pf],
+      Txfee (Coin 5)
+    ]
+
+notOkSupplimentaryDatumTx ::
+  forall era.
+  ( Scriptic era,
+    SignBody era
+  ) =>
+  Proof era ->
+  Core.Tx era
+notOkSupplimentaryDatumTx pf =
+  newTx
+    Override
+    pf
+    [ Body (notOkSupplimentaryDatumTxBody pf),
+      Witnesses'
+        [ AddrWits [makeWitnessVKey (hashAnnotated (notOkSupplimentaryDatumTxBody pf)) (someKeys pf)],
+          DataWits [totallyIrrelevantDatum]
+        ]
+    ]
+
 -- =======================
 -- Alonzo UTXOW Tests
 -- =======================
@@ -1318,7 +1404,11 @@ alonzoUTXOWexamples =
           testCase "validating scripts everywhere" $
             testUTXOW
               (trustMe True $ validatingTxManyScripts pf)
-              (Right . utxoStEx9 $ pf)
+              (Right . utxoStEx9 $ pf),
+          testCase "acceptable supplimentary datum" $
+            testUTXOW
+              (trustMe True $ okSupplimentaryDatumTx pf)
+              (Right . utxoStEx10 $ pf)
         ],
       testGroup
         "invalid transactions"
@@ -1508,6 +1598,16 @@ alonzoUTXOWexamples =
             testUTXOW
               (trustMe True $ plutusOutputWithNoDataTx pf)
               ( Left [[UnspendableUTxONoDatumHash . Set.singleton $ TxIn genesisId 101]]
+              ),
+          testCase "unacceptable supplimentary datum" $
+            testUTXOW
+              (trustMe True $ notOkSupplimentaryDatumTx pf)
+              ( Left
+                  [ [ NonOutputSupplimentaryDatums
+                        (Set.singleton $ hashData @A totallyIrrelevantDatum)
+                        mempty
+                    ]
+                  ]
               )
         ]
     ]