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`.

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
@@ -181,10 +181,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

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,
@@ -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
@@ -790,3 +791,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

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

@@ -24,7 +24,6 @@ module Plutus.Contract.Trace
     , AsTraceError(..)
     , toNotifyError
     -- * Handle contract requests
-    , handleBlockchainQueries
     , handleSlotNotifications
     , handleTimeNotifications
     , handleOwnPubKeyHashQueries
@@ -35,6 +34,7 @@ module Plutus.Contract.Trace
     , handlePendingTransactions
     , handleChainIndexQueries
     , handleOwnInstanceIdQueries
+    , handleYieldedUnbalancedTx
     -- * Initial distributions of emulated chains
     , InitialDistribution
     , defaultDist
@@ -67,7 +67,6 @@ import Ledger.Ada qualified as Ada
 import Ledger.Value (Value)
 
 import Plutus.ChainIndex (ChainIndexQueryEffect)
-import Plutus.Trace.Emulator.Types (EmulatedWalletEffects)
 import Wallet.Effects (NodeClientEffect, WalletEffect)
 import Wallet.Emulator (Wallet)
 import Wallet.Emulator qualified as EM
@@ -139,23 +138,6 @@ handleTimeToSlotConversions ::
 handleTimeToSlotConversions =
     generalise (preview E._PosixTimeRangeToContainedSlotRangeReq) (E.PosixTimeRangeToContainedSlotRangeResp . Right) RequestHandler.handleTimeToSlotConversions
 
-handleBlockchainQueries ::
-    RequestHandler
-        (Reader ContractInstanceId ': EmulatedWalletEffects)
-        PABReq
-        PABResp
-handleBlockchainQueries =
-    handleUnbalancedTransactions
-    <> handlePendingTransactions
-    <> handleChainIndexQueries
-    <> handleOwnPubKeyHashQueries
-    <> handleOwnInstanceIdQueries
-    <> handleSlotNotifications
-    <> handleCurrentSlotQueries
-    <> handleTimeNotifications
-    <> handleCurrentTimeQueries
-    <> handleTimeToSlotConversions
-
 handleUnbalancedTransactions ::
     ( Member (LogObserve (LogMessage Text)) effs
     , Member (LogMsg RequestHandlerLogMsg) effs
@@ -207,6 +189,17 @@ handleOwnInstanceIdQueries ::
 handleOwnInstanceIdQueries =
     generalise (preview E._OwnContractInstanceIdReq) E.OwnContractInstanceIdResp RequestHandler.handleOwnInstanceIdQueries
 
+handleYieldedUnbalancedTx ::
+    ( Member (LogObserve (LogMessage Text)) effs
+    , Member WalletEffect effs
+    )
+    => RequestHandler effs PABReq PABResp
+handleYieldedUnbalancedTx =
+    generalise
+        (preview E._YieldUnbalancedTxReq)
+        E.YieldUnbalancedTxResp
+        RequestHandler.handleYieldedUnbalancedTx
+
 defaultDist :: InitialDistribution
 defaultDist = defaultDistFor EM.knownWallets
 

plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs

@@ -27,6 +27,7 @@ module Plutus.Contract.Trace.RequestHandler(
     , handlePendingTransactions
     , handleChainIndexQueries
     , handleOwnInstanceIdQueries
+    , handleYieldedUnbalancedTx
     ) where
 
 import Control.Applicative (Alternative (empty, (<|>)))
@@ -59,7 +60,6 @@ import Wallet.Effects qualified
 import Wallet.Emulator.LogMessages (RequestHandlerLogMsg (..))
 import Wallet.Types (ContractInstanceId)
 
-
 -- | Request handlers that can choose whether to handle an effect (using
 --   'Alternative'). This is useful if 'req' is a sum type.
 newtype RequestHandler effs req resp = RequestHandler { unRequestHandler :: req -> Eff (NonDet ': effs) resp }
@@ -241,3 +241,14 @@ handleOwnInstanceIdQueries ::
     => RequestHandler effs a ContractInstanceId
 handleOwnInstanceIdQueries = RequestHandler $ \_ ->
     surroundDebug @Text "handleOwnInstanceIdQueries" ask
+
+handleYieldedUnbalancedTx ::
+    forall effs.
+    ( Member WalletEffect effs
+    , Member (LogObserve (LogMessage Text)) effs
+    )
+    => RequestHandler effs UnbalancedTx ()
+handleYieldedUnbalancedTx =
+    RequestHandler $ \utx ->
+        surroundDebug @Text "handleYieldedUnbalancedTx" $ do
+            Wallet.yieldUnbalancedTx utx