SCP-2368: Hosted PAB scenario - expose partial transactions that need…

… to be balanced, signed and submitted by a remote wallet.

* New WalletEffect, `yieldUnbalancedTx`, which makes available an unbalanced tx to be balanced, signed and then submitted to the blockchain.

* Added ToJSON and FromJSON instances to ExportTx (partial tx)

* Additionnal Generic and OpenAPI.ToSchema orphan instances for some cardano-api types.

* New wallet handler in the PAB: RemoteClient. The only implemented wallet effect for the moment is `YieldUnbalancedTx`. The rest of the effects will be implemented in the future.

* Changed the PAB wallet config settings which allows the user to specify if the wallet is available locally or remotely.

* In the PAB, partial txs (`ExportTx`) are now exposed in the contract instance status endpoint (additionnaly as a `NewYieldedPartialTx` message in the websocket) when calling `yieldUnbalancedTx`.

* Changed the PayToWallet example in plutus-pab to use `yieldUnbalancedTx`.

plutus-contract/plutus-contract.cabal

@@ -1,4 +1,4 @@
-cabal-version: 2.2
+cabal-version: 3.0
 name: plutus-contract
 version: 0.1.0.0
 license: Apache-2.0
@@ -77,6 +77,7 @@ library
         Wallet
         Wallet.API
         Wallet.Effects
+        Wallet.Error
         Wallet.Graph
         Wallet.Types
         Plutus.Trace
@@ -181,10 +182,12 @@ test-suite plutus-contract-test
         Spec.State
         Spec.ThreadToken
         Spec.Secrets
+        Spec.Plutus.Contract.Wallet
     build-depends:
         base >=4.9 && <5,
         bytestring -any,
         cardano-api -any,
+        cardano-api:gen -any,
         containers -any,
         data-default -any,
         freer-extras -any,

plutus-contract/src/Plutus/Contract.hs

@@ -80,6 +80,7 @@ module Plutus.Contract(
     , Request.submitBalancedTx
     , Request.balanceTx
     , Request.mkTxConstraints
+    , Request.yieldUnbalancedTx
     -- ** Creating transactions
     , module Tx
     -- ** Tx confirmation
@@ -106,12 +107,12 @@ module Plutus.Contract(
     ) where
 
 import Data.Aeson (ToJSON (toJSON))
-import Data.Row
+import Data.Row (Empty, HasType, type (.\/))
 
 import Plutus.Contract.Request (ContractRow)
 import Plutus.Contract.Request qualified as Request
 import Plutus.Contract.Schema qualified as Schema
-import Plutus.Contract.Typed.Tx as Tx
+import Plutus.Contract.Typed.Tx as Tx (collectFromScript, collectFromScriptFilter)
 import Plutus.Contract.Types (AsCheckpointError (..), AsContractError (..), CheckpointError (..), Contract (..),
                               ContractError (..), IsContract (..), Promise (..), checkpoint, checkpointLoop,
                               handleError, mapError, never, promiseBind, promiseMap, runError, select, selectEither,

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

@@ -23,6 +23,7 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal
     _WriteBalancedTxReq,
     _ExposeEndpointReq,
     _PosixTimeRangeToContainedSlotRangeReq,
+    _YieldUnbalancedTxReq,
     -- ** Chain index query effect types
     _DatumFromHash,
     _ValidatorFromHash,
@@ -52,6 +53,7 @@ module Plutus.Contract.Effects( -- TODO: Move to Requests.Internal
     _WriteBalancedTxResp,
     _ExposeEndpointResp,
     _PosixTimeRangeToContainedSlotRangeResp,
+    _YieldUnbalancedTxResp,
     -- ** Chain index response effect types
     _DatumHashResponse,
     _ValidatorHashResponse,
@@ -85,14 +87,14 @@ import Ledger (Address, AssetClass, Datum, DatumHash, MintingPolicy, MintingPoli
 import Ledger.Constraints.OffChain (UnbalancedTx)
 import Ledger.Credential (Credential)
 import Ledger.Scripts (Validator)
-import Ledger.Slot (Slot (..), SlotRange)
-import Ledger.Time (POSIXTime (..), POSIXTimeRange)
+import Ledger.Slot (Slot, SlotRange)
+import Ledger.Time (POSIXTime, POSIXTimeRange)
 import Ledger.TimeSlot (SlotConversionError)
 import Ledger.Tx (CardanoTx, ChainIndexTxOut, getCardanoTxId)
 import Plutus.ChainIndex (Page (pageItems), PageQuery)
 import Plutus.ChainIndex.Tx (ChainIndexTx (_citxTxId))
-import Plutus.ChainIndex.Types (Tip (..), TxOutStatus, TxStatus)
-import Prettyprinter (Pretty (..), hsep, indent, viaShow, vsep, (<+>))
+import Plutus.ChainIndex.Types (Tip, TxOutStatus, TxStatus)
+import Prettyprinter (Pretty (pretty), hsep, indent, viaShow, vsep, (<+>))
 import Wallet.API (WalletAPIError)
 import Wallet.Types (ContractInstanceId, EndpointDescription, EndpointValue)
 
@@ -113,6 +115,7 @@ data PABReq =
     | WriteBalancedTxReq CardanoTx
     | ExposeEndpointReq ActiveEndpoint
     | PosixTimeRangeToContainedSlotRangeReq POSIXTimeRange
+    | YieldUnbalancedTxReq UnbalancedTx
     deriving stock (Eq, Show, Generic)
     deriving anyclass (ToJSON, FromJSON, OpenApi.ToSchema)
 
@@ -133,6 +136,7 @@ instance Pretty PABReq where
     WriteBalancedTxReq tx                   -> "Write balanced tx:" <+> pretty tx
     ExposeEndpointReq ep                    -> "Expose endpoint:" <+> pretty ep
     PosixTimeRangeToContainedSlotRangeReq r -> "Posix time range to contained slot range:" <+> pretty r
+    YieldUnbalancedTxReq utx                -> "Yield unbalanced tx:" <+> pretty utx
 
 -- | Responses that 'Contract's receive
 data PABResp =
@@ -151,6 +155,7 @@ data PABResp =
     | WriteBalancedTxResp WriteBalancedTxResponse
     | ExposeEndpointResp EndpointDescription (EndpointValue JSON.Value)
     | PosixTimeRangeToContainedSlotRangeResp (Either SlotConversionError SlotRange)
+    | YieldUnbalancedTxResp ()
     deriving stock (Eq, Show, Generic)
     deriving anyclass (ToJSON, FromJSON)
 
@@ -171,6 +176,7 @@ instance Pretty PABResp where
     WriteBalancedTxResp r                    -> "Write balanced tx:" <+> pretty r
     ExposeEndpointResp desc rsp              -> "Call endpoint" <+> pretty desc <+> "with" <+> pretty rsp
     PosixTimeRangeToContainedSlotRangeResp r -> "Slot range:" <+> pretty r
+    YieldUnbalancedTxResp ()                 -> "Yielded unbalanced tx"
 
 matches :: PABReq -> PABResp -> Bool
 matches a b = case (a, b) of
@@ -190,6 +196,7 @@ matches a b = case (a, b) of
   (ExposeEndpointReq ActiveEndpoint{aeDescription}, ExposeEndpointResp desc _)
     | aeDescription == desc -> True
   (PosixTimeRangeToContainedSlotRangeReq{}, PosixTimeRangeToContainedSlotRangeResp{}) -> True
+  (YieldUnbalancedTxReq{}, YieldUnbalancedTxResp{})        -> True
   _                                                        -> False
 
 chainIndexMatches :: ChainIndexQuery -> ChainIndexResponse -> Bool

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

@@ -82,6 +82,7 @@ module Plutus.Contract.Request(
     , submitTxConstraintsWith
     , submitTxConfirmed
     , mkTxConstraints
+    , yieldUnbalancedTx
     -- * Etc.
     , ContractRow
     , pabReq
@@ -97,8 +98,8 @@ import Data.List.NonEmpty (NonEmpty)
 import Data.Map (Map)
 import Data.Map qualified as Map
 import Data.Maybe (catMaybes, mapMaybe)
-import Data.Proxy (Proxy (..))
-import Data.Row
+import Data.Proxy (Proxy (Proxy))
+import Data.Row (AllUniqueLabels, HasType, KnownSymbol, type (.==))
 import Data.Text qualified as Text
 import Data.Text.Extras (tshow)
 import Data.Void (Void)
@@ -111,20 +112,24 @@ import Ledger.Constraints (TxConstraints)
 import Ledger.Constraints.OffChain (ScriptLookups, UnbalancedTx)
 import Ledger.Constraints.OffChain qualified as Constraints
 import Ledger.Tx (CardanoTx, ChainIndexTxOut, ciTxOutValue, getCardanoTxId)
-import Ledger.Typed.Scripts (TypedValidator, ValidatorTypes (..))
+import Ledger.Typed.Scripts (TypedValidator, ValidatorTypes (DatumType, RedeemerType))
 import Ledger.Value qualified as V
 import Plutus.Contract.Util (loopM)
 import PlutusTx qualified
 
-import Plutus.Contract.Effects (ActiveEndpoint (..), PABReq (..), PABResp (..))
+import Plutus.Contract.Effects (ActiveEndpoint (..),
+                                PABReq (AwaitSlotReq, AwaitTimeReq, AwaitTxOutStatusChangeReq, AwaitTxStatusChangeReq, AwaitUtxoProducedReq, AwaitUtxoSpentReq, BalanceTxReq, ChainIndexQueryReq, CurrentSlotReq, CurrentTimeReq, ExposeEndpointReq, OwnContractInstanceIdReq, OwnPublicKeyHashReq, WriteBalancedTxReq, YieldUnbalancedTxReq),
+                                PABResp (ExposeEndpointResp))
 import Plutus.Contract.Effects qualified as E
 import Plutus.Contract.Schema (Input, Output)
 import Wallet.Types (ContractInstanceId, EndpointDescription (..), EndpointValue (..))
 
 import Plutus.ChainIndex (ChainIndexTx, Page (nextPageQuery, pageItems), PageQuery, txOutRefs)
-import Plutus.ChainIndex.Types (RollbackState (..), Tip, TxOutStatus, TxStatus)
-import Plutus.Contract.Resumable
-import Plutus.Contract.Types
+import Plutus.ChainIndex.Types (RollbackState (Unknown), Tip, TxOutStatus, TxStatus)
+import Plutus.Contract.Resumable (prompt)
+import Plutus.Contract.Types (AsContractError (_ConstraintResolutionError, _OtherError, _ResumableError, _WalletError),
+                              Contract (Contract), MatchingError (WrongVariantError), Promise (Promise), runError,
+                              throwError)
 
 -- | Constraints on the contract schema, ensuring that the labels of the schema
 --   are unique.
@@ -790,3 +795,11 @@ submitTxConstraintsWith sl constraints = mkTxConstraints sl constraints >>= subm
 --   confirmed on the ledger before returning.
 submitTxConfirmed :: forall w s e. (AsContractError e) => UnbalancedTx -> Contract w s e ()
 submitTxConfirmed t = submitUnbalancedTx t >>= awaitTxConfirmed . getCardanoTxId
+
+-- | Take an 'UnbalancedTx' then balance, sign and submit it to the blockchain
+-- without returning any results.
+yieldUnbalancedTx
+    :: forall w s e. (AsContractError e)
+    => UnbalancedTx
+    -> Contract w s e ()
+yieldUnbalancedTx utx = pabReq (YieldUnbalancedTxReq utx) E._YieldUnbalancedTxResp