SCP-2945: Only script outputs in unbalanced transactions (#57)

* Only script outputs in unbalanced transactions

* Don't use ScriptLookups internals in PubKey tests

* Fix merge issue

playground-common/src/PSGenerator/Common.hs

@@ -22,7 +22,7 @@ import Ledger (Address, BlockId, ChainIndexTxOut, DatumHash, MintingPolicy, OnCh
                ScriptTag, Signature, StakeValidator, Tx, TxId, TxIn, TxInType, TxOut, TxOutRef, TxOutTx, UtxoIndex,
                ValidationPhase, Validator)
 import Ledger.Ada (Ada)
-import Ledger.Constraints.OffChain (MkTxError, UnbalancedTx)
+import Ledger.Constraints.OffChain (MkTxError, ScriptOutput, UnbalancedTx)
 import Ledger.Credential (Credential, StakingCredential)
 import Ledger.DCert (DCert)
 import Ledger.Index (ExCPU, ExMemory, ScriptType, ScriptValidationEvent, ValidationError)
@@ -379,6 +379,7 @@ ledgerTypes =
     , equal . genericShow . argonaut $ mkSumType @WriteBalancedTxResponse
     , equal . genericShow . argonaut $ mkSumType @ActiveEndpoint
     , equal . genericShow . argonaut $ mkSumType @UnbalancedTx
+    , equal . genericShow . argonaut $ mkSumType @ScriptOutput
     , order . equal . genericShow . argonaut $ mkSumType @TxValidity
     , equal . genericShow . argonaut $ mkSumType @TxOutState
     , equal . genericShow . argonaut $ mkSumType @(RollbackState A)

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

@@ -28,7 +28,6 @@ import Control.Monad.Error.Lens (throwing)
 import Control.Monad.Freer (Eff, Member)
 import Control.Monad.Freer.Error (Error, throwError)
 import Data.Aeson (ToJSON (..), Value (String), object, (.=))
-import Data.Aeson.Extras qualified as Aeson.Extras
 import Data.Aeson.Extras qualified as JSON
 import Data.Map (Map)
 import Data.Map qualified as Map
@@ -40,7 +39,7 @@ import GHC.Generics (Generic)
 import Ledger qualified as Plutus
 import Ledger.Ada qualified as Ada
 import Ledger.Constraints (mustPayToPubKey)
-import Ledger.Constraints.OffChain (UnbalancedTx (..), adjustUnbalancedTx, mkTx)
+import Ledger.Constraints.OffChain (ScriptOutput (..), UnbalancedTx (..), adjustUnbalancedTx, mkTx)
 import Ledger.Tx (CardanoTx, TxOutRef, getCardanoTxInputs, txInRef)
 import Plutus.Contract.CardanoAPI qualified as CardanoAPI
 import Plutus.Contract.Request qualified as Contract
@@ -161,7 +160,7 @@ instance ToJSON ExportTxInput where
 instance ToJSON ExportTx where
     toJSON ExportTx{partialTx, lookups, redeemers} =
         object
-            [ "transaction" .= Aeson.Extras.encodeByteString (C.serialiseToCBOR partialTx)
+            [ "transaction" .= JSON.encodeByteString (C.serialiseToCBOR partialTx)
             , "inputs"      .= lookups
             , "redeemers"   .= redeemers
             ]
@@ -177,21 +176,20 @@ export params networkId UnbalancedTx{unBalancedTxTx, unBalancedTxUtxoIndex, unBa
 mkPartialTx :: [WAPI.PubKeyHash] -> C.ProtocolParameters -> C.NetworkId -> Plutus.Tx -> Either CardanoAPI.ToCardanoError (C.Tx C.AlonzoEra)
 mkPartialTx requiredSigners params networkId = fmap (C.makeSignedTransaction []) . CardanoAPI.toCardanoTxBody requiredSigners (Just params) networkId
 
-mkInputs :: C.NetworkId -> Map Plutus.TxOutRef Plutus.TxOut -> Either CardanoAPI.ToCardanoError [ExportTxInput]
+mkInputs :: C.NetworkId -> Map Plutus.TxOutRef ScriptOutput -> Either CardanoAPI.ToCardanoError [ExportTxInput]
 mkInputs networkId = traverse (uncurry (toExportTxInput networkId)) . Map.toList
 
-toExportTxInput :: C.NetworkId -> Plutus.TxOutRef -> Plutus.TxOut -> Either CardanoAPI.ToCardanoError ExportTxInput
-toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} Plutus.TxOut{Plutus.txOutAddress, Plutus.txOutValue, Plutus.txOutDatumHash=Just dh} = do
-    cardanoValue <- CardanoAPI.toCardanoValue txOutValue
+toExportTxInput :: C.NetworkId -> Plutus.TxOutRef -> ScriptOutput -> Either CardanoAPI.ToCardanoError ExportTxInput
+toExportTxInput networkId Plutus.TxOutRef{Plutus.txOutRefId, Plutus.txOutRefIdx} (ScriptOutput vh value dh) = 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 txOutAddress
+        <*> CardanoAPI.toCardanoAddress networkId (Plutus.scriptHashAddress vh)
         <*> pure (C.selectLovelace cardanoValue)
         <*> CardanoAPI.toCardanoScriptDataHash dh
         <*> pure otherQuantities
-toExportTxInput _ _ _ = Left CardanoAPI.PublicKeyInputsNotSupported
 
 mkRedeemers :: Plutus.Tx -> Either CardanoAPI.ToCardanoError [ExportTxRedeemer]
 mkRedeemers tx = (++) <$> mkSpendingRedeemers tx <*> mkMintingRedeemers tx

plutus-contract/src/Wallet/Emulator/Wallet.hs

@@ -268,7 +268,7 @@ validateTxAndAddFees feeCfg slotCfg ownTxOuts utx = do
     -- Balance and sign just for validation
     tx <- handleBalanceTx ownTxOuts utx
     signedTx <- handleAddSignature tx
-    let utxoIndex        = Ledger.UtxoIndex $ unBalancedTxUtxoIndex utx <> (toTxOut <$> ownTxOuts)
+    let utxoIndex        = Ledger.UtxoIndex $ fmap toTxOut $ (U.fromScriptOutput <$> unBalancedTxUtxoIndex utx) <> ownTxOuts
         ((e, _), events) = Ledger.runValidation (Ledger.validateTransactionOffChain signedTx) (Ledger.ValidationCtx utxoIndex slotCfg)
     for_ e $ \(phase, ve) -> do
         logWarn $ ValidationFailed phase (txId tx) tx ve events

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

@@ -14,6 +14,7 @@
 {-# LANGUAGE TypeFamilies              #-}
 {-# LANGUAGE TypeOperators             #-}
 {-# LANGUAGE UndecidableInstances      #-}
+{-# LANGUAGE ViewPatterns              #-}
 module Ledger.Constraints.OffChain(
     -- * Lookups
     ScriptLookups(..)
@@ -33,6 +34,9 @@ module Ledger.Constraints.OffChain(
     , validityTimeRange
     , emptyUnbalancedTx
     , adjustUnbalancedTx
+    , ScriptOutput(..)
+    , toScriptOutput
+    , fromScriptOutput
     , MkTxError(..)
     , mkTx
     , mkSomeTx
@@ -124,14 +128,9 @@ instance Monoid (ScriptLookups a) where
 --   instance's validator.
 typedValidatorLookups :: TypedValidator a -> ScriptLookups a
 typedValidatorLookups inst =
-    ScriptLookups
+    mempty
         { slMPS = Map.singleton (Scripts.forwardingMintingPolicyHash inst) (Scripts.forwardingMintingPolicy inst)
-        , slTxOutputs = Map.empty
-        , slOtherScripts = Map.empty
-        , slOtherData = Map.empty
-        , slPubKeyHashes = Map.empty
         , slTypedValidator = Just inst
-        , slOwnPubkeyHash = Nothing
         }
 
 -- | A script lookups value that uses the map of unspent outputs to resolve
@@ -164,14 +163,37 @@ pubKey pk = mempty { slPubKeyHashes = Map.singleton (pubKeyHash pk) pk }
 ownPubKeyHash :: PubKeyHash -> ScriptLookups a
 ownPubKeyHash ph = mempty { slOwnPubkeyHash = Just ph}
 
+data ScriptOutput =
+    ScriptOutput
+        { scriptOutputValidatorHash :: ValidatorHash
+        , scriptOutputValue         :: Value
+        , scriptOutputDatumHash     :: DatumHash
+        }
+    deriving stock (Eq, Generic, Show)
+    deriving anyclass (FromJSON, ToJSON, OpenApi.ToSchema)
+
+toScriptOutput :: ChainIndexTxOut -> Maybe ScriptOutput
+toScriptOutput (Tx.ScriptChainIndexTxOut _ validatorOrHash datumOrHash v)
+    = Just $ ScriptOutput (either id validatorHash validatorOrHash) v (either id datumHash datumOrHash)
+toScriptOutput Tx.PublicKeyChainIndexTxOut{}
+    = Nothing
+
+fromScriptOutput :: ScriptOutput -> ChainIndexTxOut
+fromScriptOutput (ScriptOutput vh v dh) =
+    Tx.ScriptChainIndexTxOut (Address.scriptHashAddress vh) (Left vh) (Left dh) v
+
+instance Pretty ScriptOutput where
+    pretty ScriptOutput{scriptOutputValidatorHash, scriptOutputValue} =
+        hang 2 $ vsep ["-" <+> pretty scriptOutputValue <+> "addressed to", pretty scriptOutputValidatorHash]
+
 -- | An unbalanced transaction. It needs to be balanced and signed before it
 --   can be submitted to the ledeger. See note [Submitting transactions from
 --   Plutus contracts] in 'Plutus.Contract.Wallet'.
 data UnbalancedTx =
     UnbalancedTx
         { unBalancedTxTx                  :: Tx
         , unBalancedTxRequiredSignatories :: Map PubKeyHash (Maybe PubKey)
-        , unBalancedTxUtxoIndex           :: Map TxOutRef TxOut
+        , unBalancedTxUtxoIndex           :: Map TxOutRef ScriptOutput
         , unBalancedTxValidityTimeRange   :: POSIXTimeRange
         }
     deriving stock (Eq, Generic, Show)
@@ -386,7 +408,7 @@ updateUtxoIndex
     => m ()
 updateUtxoIndex = do
     ScriptLookups{slTxOutputs} <- ask
-    unbalancedTx . utxoIndex <>= fmap Tx.toTxOut slTxOutputs
+    unbalancedTx . utxoIndex <>= Map.mapMaybe toScriptOutput slTxOutputs
 
 -- | Add a typed input, checking the type of the output it spends. Return the value
 --   of the spent output.

plutus-ledger/src/Ledger/Tx/CardanoAPI.hs

@@ -650,7 +650,6 @@ data ToCardanoError
     | MissingMintingPolicyRedeemer
     | MissingMintingPolicy
     | ScriptPurposeNotSupported P.ScriptTag
-    | PublicKeyInputsNotSupported
     | Tag String ToCardanoError
     deriving stock (Show, Eq, Generic)
     deriving anyclass (FromJSON, ToJSON)
@@ -667,7 +666,6 @@ instance Pretty ToCardanoError where
     pretty MissingMintingPolicyRedeemer       = "Missing minting policy redeemer"
     pretty MissingMintingPolicy               = "Missing minting policy"
     pretty (ScriptPurposeNotSupported p)      = "Script purpose not supported:" <+> viaShow p
-    pretty PublicKeyInputsNotSupported        = "Public key inputs not supported"
     pretty (Tag t err)                        = pretty t <> colon <+> pretty err
 
 zeroExecutionUnits :: C.ExecutionUnits

plutus-use-cases/test/Spec/PubKey.hs

@@ -5,7 +5,6 @@ import Control.Monad (void)
 import Data.Map qualified as Map
 
 import Ledger.Ada qualified as Ada
-import Ledger.Constraints (ScriptLookups (..))
 import Ledger.Constraints qualified as Constraints
 import Ledger.Scripts (unitRedeemer)
 import Ledger.Typed.Scripts as Scripts
@@ -20,15 +19,8 @@ import Test.Tasty
 theContract :: Contract () EmptySchema PubKeyError ()
 theContract = do
   (txOutRef, ciTxOut, pkInst) <- pubKeyContract (walletPubKeyHash w1) (Ada.adaValueOf 10)
-  let lookups = ScriptLookups
-                  { slMPS = Map.empty
-                  , slTxOutputs = maybe mempty (Map.singleton txOutRef) ciTxOut
-                  , slOtherScripts = Map.singleton (Scripts.validatorHash pkInst) (Scripts.validatorScript pkInst)
-                  , slOtherData = Map.empty
-                  , slPubKeyHashes = Map.empty
-                  , slTypedValidator = Nothing
-                  , slOwnPubkeyHash = Nothing
-                  }
+  let lookups = maybe mempty (Constraints.unspentOutputs . Map.singleton txOutRef) ciTxOut
+              <> Constraints.otherScript (Scripts.validatorScript pkInst)
   void $ submitTxConstraintsWith @Scripts.Any lookups (Constraints.mustSpendScriptOutput txOutRef unitRedeemer)
 
 tests :: TestTree

plutus-use-cases/test/Spec/crowdfundingEmulatorTestOutput.txt

@@ -116,13 +116,13 @@ Slot 20: W872cb83: Balancing an unbalanced transaction:
                      Utxo index:
                        ( 2f869889c09e76fb2cbfe2a3a0d512bfc86fe515d0cee53ecea4a79d3e695029!1
                        , - Value (Map [(,Map [("",10000000)])]) addressed to
-                           ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) )
+                           845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b )
                        ( c351875a8d5d26a87f1cf365f007f8a543040e9d8d182d608223edd245c5ea9e!1
                        , - Value (Map [(,Map [("",2500000)])]) addressed to
-                           ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) )
+                           845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b )
                        ( e9628f4a7231fbe76f221ae02309b0d44df8d902154ab1bd93e38a274d52f370!1
                        , - Value (Map [(,Map [("",10000000)])]) addressed to
-                           ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) )
+                           845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b )
                      Validity range:
                        [ POSIXTime 1596059111000 , POSIXTime 1596059120999 ]
 Slot 20: W872cb83: Finished balancing. 3a20125dbda70ddc4408207505e362966252b6941ec7eb334ca11f11fc96ac35