Only script outputs in unbalanced transactions

playground-common/src/PSGenerator/Common.hs

@@ -25,7 +25,7 @@ import           Ledger                                    (Address, BlockId, Ch
                                                             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,
@@ -422,6 +422,7 @@ ledgerTypes =
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @WriteBalancedTxResponse)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @ActiveEndpoint)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @UnbalancedTx)
+    , (equal <*> (genericShow <*> mkSumType)) (Proxy @ScriptOutput)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @TxValidity)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @TxOutState)
     , (equal <*> (genericShow <*> mkSumType)) (Proxy @(RollbackState A))

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

@@ -39,7 +39,7 @@ import           GHC.Generics                (Generic)
 import qualified Ledger                      as Plutus
 import qualified Ledger.Ada                  as Ada
 import           Ledger.Constraints          (mustPayToPubKey)
-import           Ledger.Constraints.OffChain (UnbalancedTx (..), mkTx)
+import           Ledger.Constraints.OffChain (ScriptOutput (..), UnbalancedTx (..), mkTx)
 import           Ledger.Tx                   (CardanoTx, TxOutRef, getCardanoTxInputs, txInRef)
 import qualified Plutus.Contract.CardanoAPI  as CardanoAPI
 import qualified Plutus.Contract.Request     as Contract
@@ -176,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

@@ -267,7 +267,7 @@ validateTxAndAddFees feeCfg 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) utxoIndex
     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(..)
@@ -32,6 +33,9 @@ module Ledger.Constraints.OffChain(
     , utxoIndex
     , validityTimeRange
     , emptyUnbalancedTx
+    , ScriptOutput(..)
+    , toScriptOutput
+    , fromScriptOutput
     , MkTxError(..)
     , mkTx
     , mkSomeTx
@@ -123,14 +127,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
@@ -163,14 +162,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)
@@ -370,7 +392,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/crowdfundingEmulatorTestOutput.txt

@@ -116,13 +116,13 @@ Slot 20: W872cb83: Balancing an unbalanced transaction:
                      Utxo index:
                        ( 59787e76d53e8f04159c9773f396d4ec2328599985556ab8aa8f5238350eabe7!1
                        , - Value (Map [(,Map [("",100)])]) addressed to
-                           ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) )
+                           845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b )
                        ( 60c276ac1952e6be91b4890f7d80cd466442d200a160be025556a1f2284e636e!1
                        , - Value (Map [(,Map [("",100)])]) addressed to
-                           ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) )
+                           845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b )
                        ( fe1787e340b05a51c7887431d4f455bae359b3373d283a3d04784bb7dfae473b!1
                        , - Value (Map [(,Map [("",25)])]) addressed to
-                           ScriptCredential: 845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b (no staking credential) )
+                           845f884d10feb1d0e664ebcde25320391e85c179e3f53c875583bf3b )
                      Validity range:
                        [ POSIXTime 1596059111000 , POSIXTime 1596059120999 ]
 Slot 20: W872cb83: Finished balancing. 204cfccb9dc69b5b6843f7f11a9c50aec9006e62c11bd8673211e88a974a86bc