Do not query datums by hash in processConstraints

CHANGELOG.md

@@ -118,6 +118,7 @@ The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/)
   - **[BREAKING CHANGE]** `withBalancedTx` and `withBalancedTxs` now accept a `TxBalancer` and its corresponding balancer context as arguments.
   - The `submitTxFromConstraints` and `submitTxFromBuildPlan` functions have been deprecated in favor of `submitTxFromBlueprint`. The new function accepts a `TxBlueprint` with the steps and context needed to construct and balance a transaction, and returns a `TxReceipt` containing the balanced, signed transaction along with its hash.
   - *Note that all mentioned deprecated functions are planned for removal in a future release.*
+- For legacy tx constraints system: Removed the logic for querying datums by hash when not explicitly provided, eliminating the non-obvious dependency on blockchain state ([#1634](https://github.com/Plutonomicon/cardano-transaction-lib/pull/1634))
 
 ### Removed
 

examples/IncludeDatum.purs

@@ -13,21 +13,18 @@ module Ctl.Examples.IncludeDatum
 
 import Contract.Prelude
 
-import Cardano.Transaction.Builder
-  ( DatumWitness(DatumValue)
-  , OutputWitness(PlutusScriptOutput)
-  , ScriptWitness(ScriptValue)
-  , TransactionBuilderStep(SpendOutput, Pay)
-  )
+import Cardano.Transaction.Builder (TransactionBuilderStep(Pay))
 import Cardano.Types
   ( Credential(ScriptHashCredential)
   , OutputDatum(OutputDatumHash)
+  , PlutusScript
+  , ScriptHash
   , TransactionOutput(TransactionOutput)
   )
 import Cardano.Types.BigNum as BigNum
 import Cardano.Types.DataHash (hashPlutusData)
+import Cardano.Types.PlutusScript (hash) as PlutusScript
 import Cardano.Types.RedeemerDatum as RedeemerDatum
-import Cardano.Types.TransactionUnspentOutput (toUtxoMap)
 import Contract.Address (mkAddress)
 import Contract.Config
   ( ContractParams
@@ -39,7 +36,8 @@ import Contract.Config
 import Contract.Log (logInfo')
 import Contract.Monad (Contract, launchAff_, liftContractM, runContract)
 import Contract.PlutusData (PlutusData(Integer))
-import Contract.Scripts (Validator, ValidatorHash, validatorHash)
+import Contract.ScriptLookups (ScriptLookups)
+import Contract.ScriptLookups (unspentOutputs, validator) as Lookups
 import Contract.TextEnvelope (decodeTextEnvelope, plutusScriptFromEnvelope)
 import Contract.Transaction
   ( TransactionHash
@@ -48,7 +46,10 @@ import Contract.Transaction
   , emptyBalancerCtx
   , lookupTxHash
   , submitTxFromBlueprint
+  , submitTxFromConstraints
   )
+import Contract.TxConstraints (TxConstraints)
+import Contract.TxConstraints (mustIncludeDatum, mustSpendScriptOutput) as Constraints
 import Contract.Utxos (utxosAt)
 import Contract.Value as Value
 import Control.Monad.Error.Class (liftMaybe)
@@ -69,7 +70,7 @@ contract :: Contract Unit
 contract = do
   logInfo' "Running Examples.IncludeDatum"
   validator <- only42Script
-  let vhash = validatorHash validator
+  let vhash = PlutusScript.hash validator
   logInfo' "Attempt to lock value"
   txId <- payToIncludeDatum vhash
   awaitTxConfirmed txId
@@ -79,7 +80,7 @@ contract = do
 datum :: PlutusData
 datum = Integer $ BigInt.fromInt 42
 
-payToIncludeDatum :: ValidatorHash -> Contract TransactionHash
+payToIncludeDatum :: ScriptHash -> Contract TransactionHash
 payToIncludeDatum vhash = do
   address <- mkAddress (wrap $ ScriptHashCredential vhash) Nothing
   _.txHash <$> submitTxFromBlueprint
@@ -96,37 +97,31 @@ payToIncludeDatum vhash = do
     }
 
 spendFromIncludeDatum
-  :: ValidatorHash
-  -> Validator
+  :: ScriptHash
+  -> PlutusScript
   -> TransactionHash
   -> Contract Unit
 spendFromIncludeDatum vhash validator txId = do
   scriptAddress <- mkAddress (wrap $ ScriptHashCredential vhash) Nothing
   utxos <- utxosAt scriptAddress
-  utxo <- liftContractM "no locked output at address"
-    (head (lookupTxHash txId utxos))
-  { txHash: spendTxHash } <- submitTxFromBlueprint
-    { buildSteps:
-        [ SpendOutput
-            utxo
-            ( Just
-                $ PlutusScriptOutput (ScriptValue validator) RedeemerDatum.unit
-                $ Just
-                $ DatumValue datum
-            )
-        ]
-    , balancer: defaultBalancer
-    , balancerCtx:
-        { balancerConstraints: mempty
-        , extraUtxos: toUtxoMap [ utxo ]
-        }
+  txInput <- liftContractM "no locked output at address"
+    (_.input <<< unwrap <$> head (lookupTxHash txId utxos))
+  let
+    constraints :: TxConstraints
+    constraints =
+      Constraints.mustSpendScriptOutput txInput RedeemerDatum.unit
+        <> Constraints.mustIncludeDatum datum
 
-    }
+    lookups :: ScriptLookups
+    lookups = Lookups.validator validator
+      <> Lookups.unspentOutputs utxos
+
+  spendTxHash <- submitTxFromConstraints lookups constraints
   awaitTxConfirmed spendTxHash
   logInfo' "Successfully spent locked values."
 
 -- | checks if the datum equals 42
-only42Script :: Contract Validator
+only42Script :: Contract PlutusScript
 only42Script = do
   liftMaybe (error "Error decoding includeDatum") do
     envelope <- decodeTextEnvelope includeDatum

examples/Lose7Ada.purs

@@ -130,7 +130,7 @@ spendFromAlwaysFails vhash validator txId = do
     { balancerConstraints: mempty
     , extraUtxos: toUtxoMap [ utxo ]
     }
-  signedTx <- signTransaction (spendTx # _isValid .~ true)
+  signedTx <- signTransaction spendTx
   spendTxId <- submit signedTx
   logInfo' $ "Tx ID: " <> show spendTxId
   awaitTxConfirmed spendTxId
@@ -149,8 +149,8 @@ alwaysFails :: String
 alwaysFails =
   """
 {
-    "type": "PlutusScriptV1",
-    "description": "",
-    "cborHex": "581e581c01000033223232222350040071235002353003001498498480048005"
+    "type": "PlutusScriptV2",
+    "description": "AlwaysFails validator",
+    "cborHex": "4746010000222601"
 }
 """

src/Internal/ProcessConstraints.purs

@@ -86,7 +86,6 @@ import Ctl.Internal.ProcessConstraints.Error
       , CannotMintZero
       , ExpectedPlutusScriptGotNativeScript
       , CannotFindDatum
-      , CannotQueryDatum
       , CannotGetValidatorHashFromAddress
       , TxOutRefWrongType
       , CannotConvertPOSIXTimeRange
@@ -132,6 +131,7 @@ import Ctl.Internal.Types.Interval
   , posixTimeRangeToTransactionValidity
   )
 import Ctl.Internal.Types.ScriptLookups (ScriptLookups)
+import Ctl.Internal.Types.ScriptLookups (datum) as Lookups
 import Ctl.Internal.Types.TxConstraints
   ( DatumPresence(DatumWitness, DatumInline)
   , InputWithScriptRef(SpendInput, RefInput)
@@ -172,9 +172,9 @@ import Ctl.Internal.Types.TxConstraints
   , utxoWithScriptRef
   )
 import Data.Array (cons, partition, toUnfoldable, zip)
-import Data.Array (mapMaybe, singleton, (:)) as Array
+import Data.Array (fromFoldable, mapMaybe, (:)) as Array
 import Data.Bifunctor (lmap)
-import Data.Either (Either(Left, Right), either, hush, isRight, note)
+import Data.Either (Either(Left, Right), either, note)
 import Data.Foldable (foldM)
 import Data.Lens ((%=), (.=), (.~), (<>=))
 import Data.Lens.Getter (use)
@@ -193,7 +193,6 @@ import Effect.Aff.Class (liftAff)
 import Effect.Class (liftEffect)
 import Effect.Exception (throw)
 import Partial.Unsafe (unsafePartial)
-import Prelude (join) as Bind
 
 -- The constraints don't precisely match those of Plutus:
 -- `forall v. (FromData (DatumType v), ToData (DatumType v), ToData (RedeemerType v))`
@@ -226,7 +225,8 @@ processLookupsAndConstraints constraints = runExceptT do
 
   timeConstraintsSolved <- except $ resumeTimeConstraints constraints
 
-  ExceptT $ foldConstraints (processConstraint ctx) timeConstraintsSolved
+  ExceptT $ foldConstraints (processConstraint ctx) $ sortConstraints
+    timeConstraintsSolved
   ExceptT addFakeScriptDataHash
   ExceptT addMissingValueSpent
   ExceptT updateUsedUtxos
@@ -286,7 +286,7 @@ runConstraintsM lookups txConstraints = do
 addFakeScriptDataHash
   :: ConstraintsM (Either MkUnbalancedTxError Unit)
 addFakeScriptDataHash = runExceptT do
-  dats <- use _datums
+  dats <- Array.fromFoldable <$> use _datums
   costModels <- use _costModels
   -- Use both script and minting redeemers in the order they were appended.
   tx <- use _cpsTransaction
@@ -348,6 +348,21 @@ updateUsedUtxos = runExceptT do
   -- Left bias towards original map, hence `flip`:
   _cpsUsedUtxos %= flip union cTxOutputs
 
+sortConstraints :: Array TxConstraint -> Array TxConstraint
+sortConstraints constraints =
+  let
+    { yes: includeDatumConstraints, no: otherConstraints } = partition
+      isIncludeDatumConstraint
+      constraints
+  in
+    includeDatumConstraints <> otherConstraints
+  where
+  isIncludeDatumConstraint :: TxConstraint -> Boolean
+  isIncludeDatumConstraint =
+    case _ of
+      MustIncludeDatum _ -> true
+      _ -> false
+
 resumeTimeConstraints
   :: Array TxConstraint -> Either MkUnbalancedTxError (Array TxConstraint)
 resumeTimeConstraints constraints = do
@@ -496,7 +511,11 @@ processConstraint
   c = do
   provider <- lift $ getProvider
   case c of
-    MustIncludeDatum dat -> pure <$> addDatum dat
+    MustIncludeDatum dat -> do
+      -- add datum to lookups
+      _lookups <>= Lookups.datum dat
+      -- attach datum to the transaction and add it to the set of datums in the state
+      pure <$> addDatum dat
     MustValidateIn posixTimeRange -> do
       { systemStart } <- asks _.ledgerConstants
       eraSummaries <- liftAff $
@@ -551,15 +570,7 @@ processConstraint
             -- Use the datum hash inside the lookup
             case datum' of
               Just (OutputDatumHash dHash) -> do
-                dat <- ExceptT do
-                  mDatumLookup <- lookupDatum dHash
-                  if isRight mDatumLookup then
-                    pure mDatumLookup
-                  else
-                    liftAff $ provider.getDatumByHash dHash <#> hush
-                      >>> Bind.join
-                      >>> note
-                        (CannotQueryDatum dHash)
+                dat <- ExceptT $ lookupDatum dHash
                 lift $ addDatum dat
               Just (OutputDatum _) -> pure unit
               Nothing -> throwError CannotFindDatum
@@ -874,13 +885,13 @@ attachToCps handler object = do
   newTx <- liftEffect $ handler object tx
   _cpsTransaction .= newTx
 
--- Attaches datum to the transaction and to Array of datums in the state.
+-- Attaches datum to the transaction and to the set of datums in the state.
 addDatum
   :: PlutusData
   -> ConstraintsM Unit
 addDatum dat = do
   attachToCps (map pure <<< attachDatum) dat
-  _datums <>= Array.singleton dat
+  _datums <>= Set.singleton dat
 
 addCertificate
   :: Certificate

src/Internal/ProcessConstraints/Error.purs

@@ -38,7 +38,6 @@ import Data.UInt as UInt
 
 data MkUnbalancedTxError
   = CannotFindDatum
-  | CannotQueryDatum DataHash
   | CannotConvertPOSIXTimeRange POSIXTimeRange PosixTimeToSlotError
   | CannotSolveTimeConstraints POSIXTimeRange POSIXTimeRange
   | CannotGetMintingPolicyScriptIndex -- Should be impossible
@@ -72,10 +71,6 @@ instance Show MkUnbalancedTxError where
 explainMkUnbalancedTxError :: MkUnbalancedTxError -> String
 explainMkUnbalancedTxError = case _ of
   CannotFindDatum -> "Cannot find datum"
-  CannotQueryDatum dh ->
-    "Querying for datum by datum hash ("
-      <> byteArrayToHex (unwrap $ encodeCbor dh)
-      <> ") failed: no datum found"
   CannotConvertPOSIXTimeRange tr ttsErr ->
     "Cannot convert POSIX time range to slot time range.\nRange: "
       <> show tr

src/Internal/ProcessConstraints/State.purs

@@ -33,6 +33,7 @@ import Data.Lattice (join)
 import Data.Lens.Record (prop)
 import Data.Lens.Types (Lens')
 import Data.Map (Map)
+import Data.Set (Set)
 import Data.Show.Generic (genericShow)
 import Data.Tuple (snd)
 import Type.Proxy (Proxy(Proxy))
@@ -56,7 +57,7 @@ type ConstraintProcessingState =
   -- ^ Balance of the values given and required for the transaction's inputs
   , valueSpentBalancesOutputs :: ValueSpentBalances
   -- ^ Balance of the values produced and required for the transaction's outputs
-  , datums :: Array PlutusData
+  , datums :: Set PlutusData
   -- ^ Ordered accumulation of datums we can use to `setScriptDataHash`
   , redeemers :: Array DetachedRedeemer
   -- ^ Unindexed redeemers that will be attached to the Tx later, on balancing
@@ -86,7 +87,7 @@ _valueSpentBalancesOutputs
 _valueSpentBalancesOutputs = prop (Proxy :: Proxy "valueSpentBalancesOutputs")
 
 _datums
-  :: Lens' ConstraintProcessingState (Array PlutusData)
+  :: Lens' ConstraintProcessingState (Set PlutusData)
 _datums = prop (Proxy :: Proxy "datums")
 
 _costModels

templates/ctl-scaffold/flake.nix

@@ -16,7 +16,7 @@
       type = "github";
       owner = "Plutonomicon";
       repo = "cardano-transaction-lib";
-      rev = "9f7d48085966a4f4d2c5f1c190dca3cd700a502d";
+      rev = "4ae87e5509faafd48e7a2ccb1b4831d9eb9b752c";
     };
     # To use the same version of `nixpkgs` as we do
     nixpkgs.follows = "ctl/nixpkgs";

templates/ctl-scaffold/packages.dhall

@@ -112,7 +112,7 @@ let additions =
           , "web-storage"
           ]
         , repo = "https://github.com/Plutonomicon/cardano-transaction-lib.git"
-        , version = "9f7d48085966a4f4d2c5f1c190dca3cd700a502d"
+        , version = "4ae87e5509faafd48e7a2ccb1b4831d9eb9b752c"
         }
       }
 

test/Testnet/Contract.purs

@@ -1533,8 +1533,7 @@ suite = do
           AlwaysSucceeds.spendFromAlwaysSucceeds vhash validator txId
 
     group "CIP-40 Collateral Output" do
-      skip $ test
-        "Always failing script triggers Collateral Return (ADA-only) UNSKIP AFTER CONWAY"
+      test "Always failing script triggers Collateral Return (ADA-only)"
         do
           let
             distribution :: InitialUTxOs /\ InitialUTxOs
@@ -1565,8 +1564,7 @@ suite = do
                     collateralLoss
                 )
 
-      skip $ test
-        "AlwaysFails script triggers Native Asset Collateral Return (tokens) UNSKIP AFTER CONWAY"
+      test "AlwaysFails script triggers Native Asset Collateral Return (tokens)"
         do
           let
             distribution :: InitialUTxOs /\ InitialUTxOs