SCP-2316: More realistic wallet API (#3315)

* SCP-2316: Reorganise wallet API * Handle wallet API errors on client side
IntersectMBO · Jun 16, 2021 · 4b347b5 · 4b347b5
1 parent 18100cb
commit 4b347b5
Show file tree

Hide file tree

Showing 29 changed files with 442 additions and 533 deletions.
diff --git a/marlowe-dashboard-client/src/API/Wallet.purs b/marlowe-dashboard-client/src/API/Wallet.purs
@@ -2,9 +2,6 @@ module API.Wallet
   ( createWallet
   , submitWalletTransaction
   , getWalletInfo
-  , updateWalletPaymentWithChange
-  , getWalletSlot
-  , getWalletTransactions
   , getWalletTotalFunds
   , signTransaction
   ) where
@@ -45,27 +42,6 @@ getWalletInfo ::
   Wallet -> m WalletInfo
 getWalletInfo wallet = doGetRequest ("/wallet/" <> toUrlPiece wallet <> "/own-public-key")
 
-updateWalletPaymentWithChange ::
-  forall m.
-  MonadError AjaxError m =>
-  MonadAff m =>
-  Wallet -> JsonTuple Value Payment -> m Payment
-updateWalletPaymentWithChange wallet valuePayment = doPostRequest ("/wallet/" <> toUrlPiece wallet <> "/update-payment-with-change") valuePayment
-
-getWalletSlot ::
-  forall m.
-  MonadError AjaxError m =>
-  MonadAff m =>
-  Wallet -> m Slot
-getWalletSlot wallet = doGetRequest $ "/wallet/" <> toUrlPiece wallet <> "/wallet-slot"
-
-getWalletTransactions ::
-  forall m.
-  MonadError AjaxError m =>
-  MonadAff m =>
-  Wallet -> m (Map TxOutRef TxOutTx)
-getWalletTransactions wallet = doGetRequest $ "/wallet/" <> toUrlPiece wallet <> "/own-outputs"
-
 getWalletTotalFunds ::
   forall m.
   MonadError AjaxError m =>

diff --git a/marlowe-dashboard-client/src/Capability/Wallet.purs b/marlowe-dashboard-client/src/Capability/Wallet.purs
@@ -3,9 +3,6 @@ module Capability.Wallet
   , createWallet
   , submitWalletTransaction
   , getWalletInfo
-  , updateWalletPaymentWithChange
-  , getWalletSlot
-  , getWalletTransactions
   , getWalletTotalFunds
   , signTransaction
   ) where
@@ -30,28 +27,19 @@ class
   createWallet :: m (AjaxResponse WalletInfo)
   submitWalletTransaction :: Wallet -> Tx -> m (AjaxResponse Unit)
   getWalletInfo :: Wallet -> m (AjaxResponse WalletInfo)
-  updateWalletPaymentWithChange :: Wallet -> JsonTuple Assets Payment -> m (AjaxResponse Payment)
-  getWalletSlot :: Wallet -> m (AjaxResponse Slot)
-  getWalletTransactions :: Wallet -> m (AjaxResponse (Map TxOutRef TxOutTx))
   getWalletTotalFunds :: Wallet -> m (AjaxResponse Assets)
   signTransaction :: Wallet -> Tx -> m (AjaxResponse Tx)
 
 instance monadWalletAppM :: ManageWallet AppM where
   createWallet = map toFront $ runExceptT $ API.createWallet
   submitWalletTransaction wallet tx = runExceptT $ API.submitWalletTransaction (toBack wallet) tx
   getWalletInfo wallet = map toFront $ runExceptT $ API.getWalletInfo (toBack wallet)
-  updateWalletPaymentWithChange wallet valuePayment = runExceptT $ API.updateWalletPaymentWithChange (toBack wallet) (toBack valuePayment)
-  getWalletSlot wallet = map toFront $ runExceptT $ API.getWalletSlot (toBack wallet)
-  getWalletTransactions wallet = runExceptT $ API.getWalletTransactions (toBack wallet)
   getWalletTotalFunds wallet = map toFront $ runExceptT $ API.getWalletTotalFunds (toBack wallet)
   signTransaction wallet tx = runExceptT $ API.signTransaction (toBack wallet) tx
 
 instance monadWalletHalogenM :: ManageWallet m => ManageWallet (HalogenM state action slots msg m) where
   createWallet = lift createWallet
   submitWalletTransaction tx wallet = lift $ submitWalletTransaction tx wallet
   getWalletInfo = lift <<< getWalletInfo
-  updateWalletPaymentWithChange valuePayment wallet = lift $ updateWalletPaymentWithChange valuePayment wallet
-  getWalletSlot = lift <<< getWalletSlot
-  getWalletTransactions = lift <<< getWalletTransactions
   getWalletTotalFunds = lift <<< getWalletTotalFunds
   signTransaction tx wallet = lift $ signTransaction tx wallet
diff --git a/plutus-contract/src/Plutus/Contract/Trace.hs b/plutus-contract/src/Plutus/Contract/Trace.hs
@@ -68,10 +68,9 @@ import           Ledger.Value                         (Value)
 
 import           Plutus.Trace.Emulator.Types          (EmulatedWalletEffects)
 import           Wallet.API                           (ChainIndexEffect)
-import           Wallet.Effects                       (ContractRuntimeEffect, WalletEffect)
+import           Wallet.Effects                       (ContractRuntimeEffect, NodeClientEffect, WalletEffect)
 import           Wallet.Emulator                      (EmulatorState, Wallet)
 import qualified Wallet.Emulator                      as EM
-import           Wallet.Emulator.LogMessages          (TxBalanceMsg)
 import qualified Wallet.Emulator.MultiAgent           as EM
 import           Wallet.Emulator.Notify               (EmulatorNotifyLogMsg (..))
 import           Wallet.Types                         (ContractInstanceId, EndpointDescription (..),
@@ -109,15 +108,15 @@ makeTimed e = do
 handleSlotNotifications ::
     ( Member (LogObserve (LogMessage Text)) effs
     , Member (LogMsg RequestHandlerLogMsg) effs
-    , Member WalletEffect effs
+    , Member NodeClientEffect effs
     )
     => RequestHandler effs PABReq PABResp
 handleSlotNotifications =
     generalise (preview E._AwaitSlotReq) E.AwaitSlotResp RequestHandler.handleSlotNotifications
 
 handleCurrentSlotQueries ::
     ( Member (LogObserve (LogMessage Text)) effs
-    , Member WalletEffect effs
+    , Member NodeClientEffect effs
     )
     => RequestHandler effs PABReq PABResp
 handleCurrentSlotQueries =
@@ -146,7 +145,6 @@ handlePendingTransactions ::
     , Member (LogMsg RequestHandlerLogMsg) effs
     , Member WalletEffect effs
     , Member ChainIndexEffect effs
-    , Member (LogMsg TxBalanceMsg) effs
     )
     => RequestHandler effs PABReq PABResp
 handlePendingTransactions =
@@ -174,8 +172,8 @@ handleTxConfirmedQueries =
 handleAddressChangedAtQueries ::
     ( Member (LogObserve (LogMessage Text)) effs
     , Member (LogMsg RequestHandlerLogMsg) effs
-    , Member WalletEffect effs
     , Member ChainIndexEffect effs
+    , Member NodeClientEffect effs
     )
     => RequestHandler effs PABReq PABResp
 handleAddressChangedAtQueries =

diff --git a/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs b/plutus-contract/src/Plutus/Contract/Trace/RequestHandler.hs
@@ -55,9 +55,10 @@ import           Ledger.Constraints.OffChain    (UnbalancedTx (unBalancedTxTx))
 import           Plutus.Contract.Effects        (TxConfirmed (..), UtxoAtAddress (..))
 import qualified Plutus.Contract.Wallet         as Wallet
 import           Wallet.API                     (WalletAPIError)
-import           Wallet.Effects                 (ChainIndexEffect, ContractRuntimeEffect, WalletEffect)
+import           Wallet.Effects                 (ChainIndexEffect, ContractRuntimeEffect, NodeClientEffect,
+                                                 WalletEffect)
 import qualified Wallet.Effects
-import           Wallet.Emulator.LogMessages    (RequestHandlerLogMsg (..), TxBalanceMsg)
+import           Wallet.Emulator.LogMessages    (RequestHandlerLogMsg (..))
 import           Wallet.Types                   (AddressChangeRequest (..), AddressChangeResponse, ContractInstanceId,
                                                  Notification, NotificationError, slotRange, targetSlot)
 
@@ -124,37 +125,36 @@ handleOwnPubKey =
 
 handleSlotNotifications ::
     forall effs.
-    ( Member WalletEffect effs
+    ( Member NodeClientEffect effs
     , Member (LogObserve (LogMessage Text)) effs
     , Member (LogMsg RequestHandlerLogMsg) effs
     )
     => RequestHandler effs Slot Slot
 handleSlotNotifications =
     RequestHandler $ \targetSlot_ ->
         surroundDebug @Text "handleSlotNotifications" $ do
-            currentSlot <- Wallet.Effects.walletSlot
+            currentSlot <- Wallet.Effects.getClientSlot
             logDebug $ SlotNoficationTargetVsCurrent targetSlot_ currentSlot
             guard (currentSlot >= targetSlot_)
             pure currentSlot
 
 handleCurrentSlot ::
     forall effs a.
-    ( Member WalletEffect effs
+    ( Member NodeClientEffect effs
     , Member (LogObserve (LogMessage Text)) effs
     )
     => RequestHandler effs a Slot
 handleCurrentSlot =
     RequestHandler $ \_ ->
         surroundDebug @Text "handleCurrentSLot" $ do
-            currentSlot <- Wallet.Effects.walletSlot
+            currentSlot <- Wallet.Effects.getClientSlot
             pure currentSlot
 
 handlePendingTransactions ::
     forall effs.
     ( Member WalletEffect effs
     , Member (LogObserve (LogMessage Text)) effs
     , Member (LogMsg RequestHandlerLogMsg) effs
-    , Member (LogMsg TxBalanceMsg) effs
     , Member ChainIndexEffect effs
     )
     => RequestHandler effs UnbalancedTx (Either WalletAPIError Tx)
@@ -199,13 +199,13 @@ handleAddressChangedAtQueries ::
     forall effs.
     ( Member (LogObserve (LogMessage Text)) effs
     , Member (LogMsg RequestHandlerLogMsg) effs
-    , Member WalletEffect effs
     , Member ChainIndexEffect effs
+    , Member NodeClientEffect effs
     )
     => RequestHandler effs AddressChangeRequest AddressChangeResponse
 handleAddressChangedAtQueries = RequestHandler $ \req ->
     surroundDebug @Text "handleAddressChangedAtQueries" $ do
-        current <- Wallet.Effects.walletSlot
+        current <- Wallet.Effects.getClientSlot
         let target = targetSlot req
         logDebug $ HandleAddressChangedAt current (slotRange req)
         -- If we ask the chain index for transactions that were confirmed in