SCP-3305 SCP-3263 fixed Ledger.Constraints.Offchain.updateUtxoIndex

Prior to this commit, `Ledger.Constraints.Offchain.updateUtxoIndex` would
discard lookups for inputs that aren't script outputs. However, sometimes it is
necessary to include particular public-key `TxIn`s in a transaction, via
`Plutus.Contract.Wallet.ExportTx.lookups`: a good example of this is when a
`Plutus.Contract.Currency.OneShotCurrency` needs to consume a specified `UTxO`
in its minting policy. Even though `Plutus.Constraints.Tx.mustSpendPubKeyOutput`
adds a public-key input to the lookups, `updateUtxoIndex` discards that, with
the result that it is only by chance that `cardano-wallet` would select that
necessary input for the balanced transaction and provide it to Plutus
validators. (Note that `cardano-wallet` does not automatically provide the
`TxIn` in the partially constructed transaction to validators: it only
provides `Cardano.Wallet.PartialTx.inputs` and the inputs it has semi-randomly
chosen.) The consequence of all of this is that scripts that require a
particular input will randomly fail during balancing in wallets with more than
one UTxO.

This fix simply adds public-key inputs to the type
`Ledger.Constraints.OffChain.ScriptOutput` so that it can also hold public-key
inputs. It makes minor adjustments to the chain of functions that pass this into
an unbalanced transaction before it is sent to `cardano-wallet`.

plutus-contract/src/Plutus/Contract/Wallet.hs

@@ -47,7 +47,7 @@ import GHC.Generics (Generic)
 import Ledger qualified as Plutus
 import Ledger.Ada qualified as Ada
 import Ledger.Constraints (mustPayToPubKey)
-import Ledger.Constraints.OffChain (ScriptOutput (ScriptOutput),
+import Ledger.Constraints.OffChain (ScriptOutput (PublicKeyOutput, ScriptOutput),
                                     UnbalancedTx (UnbalancedTx, unBalancedTxRequiredSignatories, unBalancedTxTx, unBalancedTxUtxoIndex),
                                     adjustUnbalancedTx, mkTx)
 import Ledger.Tx (CardanoTx, TxOutRef, getCardanoTxInputs, txInRef)
@@ -265,6 +265,16 @@ toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx}
         <*> pure (C.selectLovelace cardanoValue)
         <*> either (const $ pure Nothing) (pure . Just) (CardanoAPI.toCardanoScriptDataHash dh)
         <*> pure otherQuantities
+toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} (PublicKeyOutput address value) = do
+    cardanoValue <- CardanoAPI.toCardanoValue value
+    let otherQuantities = mapMaybe (\case { (C.AssetId policyId assetName, quantity) -> Just (policyId, assetName, quantity); _ -> Nothing }) $ C.valueToList cardanoValue
+    ExportTxInput
+        <$> CardanoAPI.toCardanoTxId txOutRefId
+        <*> pure (C.TxIx $ fromInteger txOutRefIdx)
+        <*> CardanoAPI.toCardanoAddress networkId address
+        <*> pure (C.selectLovelace cardanoValue)
+        <*> pure Nothing
+        <*> pure otherQuantities
 
 mkRedeemers :: Plutus.Tx -> Either CardanoAPI.ToCardanoError [ExportTxRedeemer]
 mkRedeemers tx = (++) <$> mkSpendingRedeemers tx <*> mkMintingRedeemers tx

plutus-ledger-constraints/src/Ledger/Constraints/OffChain.hs

@@ -191,22 +191,30 @@ data ScriptOutput =
         , scriptOutputValue         :: Value
         , scriptOutputDatumHash     :: DatumHash
         }
+  | PublicKeyOutput
+        { publicKeyOutputAddress :: Tx.Address
+        , publicKeyOutputValue   :: Value
+        }
     deriving stock (Eq, Generic, Show)
     deriving anyclass (FromJSON, ToJSON, OpenApi.ToSchema)
 
-toScriptOutput :: ChainIndexTxOut -> Maybe ScriptOutput
+toScriptOutput :: ChainIndexTxOut -> ScriptOutput
 toScriptOutput (Tx.ScriptChainIndexTxOut _ validatorOrHash datumOrHash v)
-    = Just $ ScriptOutput (either id validatorHash validatorOrHash) v (either id datumHash datumOrHash)
-toScriptOutput Tx.PublicKeyChainIndexTxOut{}
-    = Nothing
+    = ScriptOutput (either id validatorHash validatorOrHash) v (either id datumHash datumOrHash)
+toScriptOutput (Tx.PublicKeyChainIndexTxOut address value)
+    = PublicKeyOutput address value
 
 fromScriptOutput :: ScriptOutput -> ChainIndexTxOut
 fromScriptOutput (ScriptOutput vh v dh) =
     Tx.ScriptChainIndexTxOut (Address.scriptHashAddress vh) (Left vh) (Left dh) v
+fromScriptOutput (PublicKeyOutput a v) =
+    Tx.PublicKeyChainIndexTxOut a v
 
 instance Pretty ScriptOutput where
     pretty ScriptOutput{scriptOutputValidatorHash, scriptOutputValue} =
         hang 2 $ vsep ["-" <+> pretty scriptOutputValue <+> "addressed to", pretty scriptOutputValidatorHash]
+    pretty PublicKeyOutput{publicKeyOutputAddress, publicKeyOutputValue} =
+        hang 2 $ vsep ["-" <+> pretty publicKeyOutputValue <+> "addressed to", pretty publicKeyOutputAddress]
 
 -- | An unbalanced transaction. It needs to be balanced and signed before it
 --   can be submitted to the ledeger. See note [Submitting transactions from
@@ -431,7 +439,7 @@ updateUtxoIndex
     => m ()
 updateUtxoIndex = do
     ScriptLookups{slTxOutputs} <- ask
-    unbalancedTx . utxoIndex <>= Map.mapMaybe toScriptOutput slTxOutputs
+    unbalancedTx . utxoIndex <>= Map.map toScriptOutput slTxOutputs
 
 -- | Add a typed input, checking the type of the output it spends. Return the value
 --   of the spent output.