From 126e4cb9a6c3ba6378d1467a29ec7f98c8305251 Mon Sep 17 00:00:00 2001 From: Jared Corduan Date: Mon, 21 Jun 2021 14:42:02 -0400 Subject: [PATCH] new predicate for non-output supplimentary datums --- .../src/Cardano/Ledger/Alonzo/Rules/Utxow.hs | 36 +++++-- .../Ledger/Examples/TwoPhaseValidation.hs | 102 +++++++++++++++++- 2 files changed, 129 insertions(+), 9 deletions(-) diff --git a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs b/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs index f7890cf1fb..6468ce7da5 100644 --- a/alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxow.hs +++ b/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 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 diff --git a/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs b/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs index 602cbb5c2d..048cd9c06c 100644 --- a/cardano-ledger-test/src/Test/Cardano/Ledger/Examples/TwoPhaseValidation.hs +++ b/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 + ] + ] ) ] ]