From b999f7d09a1ec8b471a776a71bcbee9dbe81ea93 Mon Sep 17 00:00:00 2001 From: Noon van der Silk Date: Fri, 7 Jan 2022 11:15:19 +0000 Subject: [PATCH] removes the wallet proxy (#217) --- .../src/Plutus/PAB/Run/PSGenerator.hs | 4 +- plutus-pab/src/Plutus/PAB/Run/Cli.hs | 3 +- plutus-pab/src/Plutus/PAB/Webserver/API.hs | 5 -- .../src/Plutus/PAB/Webserver/Handler.hs | 62 +------------------ plutus-pab/src/Plutus/PAB/Webserver/Server.hs | 52 ++++------------ 5 files changed, 15 insertions(+), 111 deletions(-) diff --git a/plutus-pab-executables/src/Plutus/PAB/Run/PSGenerator.hs b/plutus-pab-executables/src/Plutus/PAB/Run/PSGenerator.hs index 347c802877..9e6ec6ff38 100644 --- a/plutus-pab-executables/src/Plutus/PAB/Run/PSGenerator.hs +++ b/plutus-pab-executables/src/Plutus/PAB/Run/PSGenerator.hs @@ -41,7 +41,6 @@ import Plutus.PAB.Webserver.API qualified as API import Plutus.PAB.Webserver.Types (ChainReport, CombinedWSStreamToClient, CombinedWSStreamToServer, ContractActivationArgs, ContractInstanceClientState, ContractReport, ContractSignatureResponse, FullReport, InstanceStatusToClient) -import Servant ((:<|>)) import Servant.PureScript (HasBridge, Settings, apiModuleName, defaultBridge, defaultSettings, languageBridge, writeAPIModuleWithSettings) @@ -126,8 +125,7 @@ generateAPIModule _ outputDir = do mySettings outputDir pabBridgeProxy - ( Proxy @(API.API (Contract.ContractDef (Builtin a)) Text.Text - :<|> API.WalletProxy Text.Text) + ( Proxy @(API.API (Contract.ContractDef (Builtin a)) Text.Text) ) -- | Generate PS modules in 'outputDir' which includes common types for the PAB. diff --git a/plutus-pab/src/Plutus/PAB/Run/Cli.hs b/plutus-pab/src/Plutus/PAB/Run/Cli.hs index cba5152165..048cac1ea9 100644 --- a/plutus-pab/src/Plutus/PAB/Run/Cli.hs +++ b/plutus-pab/src/Plutus/PAB/Run/Cli.hs @@ -170,8 +170,7 @@ runConfigCommand contractHandler ConfigCommandArgs{ccaTrace, ccaPABConfig=config logInfo @(LM.PABMultiAgentMsg (Builtin a)) (LM.PABStateRestored $ length ts) -- then, actually start the server. - let walletClientEnv = App.walletClientEnv (Core.appEnv env) - (mvar, _) <- PABServer.startServer pabWebserverConfig (Left walletClientEnv) ccaAvailability + (mvar, _) <- PABServer.startServer pabWebserverConfig ccaAvailability liftIO $ takeMVar mvar either handleError return result where diff --git a/plutus-pab/src/Plutus/PAB/Webserver/API.hs b/plutus-pab/src/Plutus/PAB/Webserver/API.hs index ab9b5c1e97..3a6ed5028c 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/API.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/API.hs @@ -6,11 +6,9 @@ module Plutus.PAB.Webserver.API ( API , WSAPI - , WalletProxy , SwaggerAPI ) where -import Cardano.Wallet.Mock.API qualified as Wallet import Data.Aeson qualified as JSON import Data.Text (Text) import Plutus.PAB.Webserver.Types (ContractActivationArgs, ContractInstanceClientState, ContractSignatureResponse, @@ -20,9 +18,6 @@ import Servant.API.WebSocket (WebSocketPending) import Servant.Swagger.UI (SwaggerSchemaUI) import Wallet.Types (ContractInstanceId) --- TODO: This wallet proxy will be eventually removed. See SCP-3096. -type WalletProxy walletId = "wallet" :> Wallet.API walletId - type WSAPI = "ws" :> (Capture "contract-instance-id" ContractInstanceId :> WebSocketPending -- Websocket for a specific contract instance diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs index eb24c388b7..681213eb6a 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs @@ -17,51 +17,38 @@ module Plutus.PAB.Webserver.Handler ( apiHandler , swagger - , walletProxy - , walletProxyClientEnv -- * Reports , getFullReport , contractSchema ) where -import Cardano.Wallet.Mock.Client qualified as Wallet.Client -import Cardano.Wallet.Mock.Types (WalletInfo (WalletInfo, wiPaymentPubKeyHash, wiWallet)) import Control.Lens (preview) import Control.Monad (join) -import Control.Monad.Freer (sendM) import Control.Monad.Freer.Error (throwError) -import Control.Monad.IO.Class (MonadIO (liftIO)) import Data.Aeson qualified as JSON -import Data.Either (fromRight) import Data.Foldable (traverse_) import Data.Map qualified as Map import Data.Maybe (fromMaybe, mapMaybe) import Data.OpenApi.Schema (ToSchema) import Data.Proxy (Proxy (Proxy)) import Data.Text (Text) -import Ledger (Value) -import Ledger.Constraints.OffChain (UnbalancedTx) -import Ledger.Tx (Tx) import Plutus.Contract.Effects (PABReq, _ExposeEndpointReq) import Plutus.Contract.Wallet (ExportTx) import Plutus.PAB.Core (PABAction) import Plutus.PAB.Core qualified as Core import Plutus.PAB.Effects.Contract qualified as Contract import Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (hooks), fromResp) -import Plutus.PAB.Types (PABError (ContractInstanceNotFound, EndpointCallError, WalletClientError)) +import Plutus.PAB.Types (PABError (ContractInstanceNotFound, EndpointCallError)) import Plutus.PAB.Webserver.API (API) import Plutus.PAB.Webserver.Types (ContractActivationArgs (ContractActivationArgs, caID, caWallet), ContractInstanceClientState (ContractInstanceClientState, cicContract, cicCurrentState, cicDefinition, cicStatus, cicWallet, cicYieldedExportTxs), ContractReport (ContractReport, crActiveContractStates, crAvailableContracts), ContractSignatureResponse (ContractSignatureResponse), FullReport (FullReport, chainReport, contractReport), emptyChainReport) -import Servant (NoContent (NoContent), (:<|>) ((:<|>))) -import Servant.Client (ClientEnv, ClientM, runClientM) +import Servant ((:<|>) ((:<|>))) import Servant.OpenApi (toOpenApi) import Servant.Server qualified as Servant import Servant.Swagger.UI (SwaggerSchemaUI', swaggerSchemaUIServer) -import Wallet.Effects qualified -import Wallet.Emulator.Error (WalletAPIError) import Wallet.Emulator.Wallet (Wallet (Wallet), WalletId, knownWallet) import Wallet.Types (ContractActivityStatus, ContractInstanceId, parseContractActivityStatus) @@ -194,48 +181,3 @@ availableContracts = do shutdown :: forall t env. ContractInstanceId -> PABAction t env () shutdown = Core.stopInstance - --- | Proxy for the wallet API -walletProxyClientEnv :: - forall t env. - ClientEnv -> - (PABAction t env WalletInfo -- Create new wallet - :<|> (WalletId -> Tx -> PABAction t env NoContent) -- Submit txn - :<|> (WalletId -> PABAction t env WalletInfo) - :<|> (WalletId -> UnbalancedTx -> PABAction t env (Either WalletAPIError Tx)) - :<|> (WalletId -> PABAction t env Value) - :<|> (WalletId -> Tx -> PABAction t env Tx)) -walletProxyClientEnv clientEnv = - let createWallet = runWalletClientM clientEnv Wallet.Client.createWallet - in walletProxy createWallet - --- | Run a 'ClientM' action against a remote host using the given 'ClientEnv'. -runWalletClientM :: forall t env a. ClientEnv -> ClientM a -> PABAction t env a -runWalletClientM clientEnv action = do - x <- sendM $ liftIO $ runClientM action clientEnv - case x of - Left err -> throwError @PABError (WalletClientError err) - Right result -> pure result - --- | Proxy for the wallet API -walletProxy :: - forall t env. - PABAction t env WalletInfo -> -- default action for creating a new wallet - (PABAction t env WalletInfo -- Create new wallet - :<|> (WalletId -> Tx -> PABAction t env NoContent) -- Submit txn - :<|> (WalletId -> PABAction t env WalletInfo) - :<|> (WalletId -> UnbalancedTx -> PABAction t env (Either WalletAPIError Tx)) - :<|> (WalletId -> PABAction t env Value) - :<|> (WalletId -> Tx -> PABAction t env Tx)) -walletProxy createNewWallet = - createNewWallet - :<|> (\w tx -> fmap (const NoContent) (Core.handleAgentThread (Wallet w) Nothing $ Wallet.Effects.submitTxn $ Right tx)) - :<|> (\w -> (\pkh -> WalletInfo{wiWallet=Wallet w, wiPaymentPubKeyHash = pkh }) - <$> Core.handleAgentThread (Wallet w) Nothing Wallet.Effects.ownPaymentPubKeyHash) - :<|> (\w -> fmap (fmap (fromRight (error "Plutus.PAB.Webserver.Handler: Expecting a mock tx, not an Alonzo tx when submitting it."))) - . Core.handleAgentThread (Wallet w) Nothing . Wallet.Effects.balanceTx) - :<|> (\w -> Core.handleAgentThread (Wallet w) Nothing Wallet.Effects.totalFunds) - :<|> (\w tx -> fmap (fromRight (error "Plutus.PAB.Webserver.Handler: Expecting a mock tx, not an Alonzo tx when adding a signature.")) - $ Core.handleAgentThread (Wallet w) Nothing - $ Wallet.Effects.walletAddSignature - $ Right tx) diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Server.hs b/plutus-pab/src/Plutus/PAB/Webserver/Server.hs index b4cddfd5ed..cb7a08e345 100644 --- a/plutus-pab/src/Plutus/PAB/Webserver/Server.hs +++ b/plutus-pab/src/Plutus/PAB/Webserver/Server.hs @@ -18,7 +18,6 @@ module Plutus.PAB.Webserver.Server , startServerDebug' ) where -import Cardano.Wallet.Mock.Types (WalletInfo (WalletInfo, wiPaymentPubKeyHash, wiWallet)) import Control.Concurrent (MVar, forkFinally, forkIO, newEmptyMVar, putMVar) import Control.Concurrent.Availability (Availability, available, newToken) import Control.Concurrent.STM qualified as STM @@ -42,16 +41,15 @@ import Plutus.PAB.Core qualified as Core import Plutus.PAB.Effects.Contract qualified as Contract import Plutus.PAB.Monitoring.PABLogMsg qualified as LM import Plutus.PAB.Simulator (Simulation) -import Plutus.PAB.Simulator qualified as Simulator import Plutus.PAB.Types (PABError, WebserverConfig (WebserverConfig, endpointTimeout, permissiveCorsPolicy, staticDir), baseUrl, defaultWebServerConfig) -import Plutus.PAB.Webserver.API (API, SwaggerAPI, WSAPI, WalletProxy) -import Plutus.PAB.Webserver.Handler (apiHandler, swagger, walletProxy, walletProxyClientEnv) +import Plutus.PAB.Webserver.API (API, SwaggerAPI, WSAPI) +import Plutus.PAB.Webserver.Handler (apiHandler, swagger) import Plutus.PAB.Webserver.WebSocket qualified as WS import Servant (Application, Handler (Handler), Raw, ServerT, err500, errBody, hoistServer, serve, serveDirectoryFileServer, (:<|>) ((:<|>))) import Servant qualified -import Servant.Client (BaseUrl (baseUrlPort), ClientEnv) +import Servant.Client (BaseUrl (baseUrlPort)) import Wallet.Emulator.Wallet (WalletId) asHandler :: forall t env a. PABRunner t env -> PABAction t env a -> Handler a @@ -74,10 +72,9 @@ app :: , OpenApi.ToSchema (Contract.ContractDef t) ) => Maybe FilePath - -> Either (Maybe ClientEnv) (PABAction t env WalletInfo) -- ^ wallet client (if wallet proxy is enabled) -> PABRunner t env -> Application -app fp walletClient pabRunner = do +app fp pabRunner = do let apiServer :: ServerT (CombinedAPI t) Handler apiServer = Servant.hoistServer @@ -87,33 +84,12 @@ app fp walletClient pabRunner = do case fp of Nothing -> do - let wpM = either (fmap walletProxyClientEnv) (Just . walletProxy) walletClient - case wpM of - Nothing -> do - Servant.serve (Proxy @(CombinedAPI t)) apiServer - Just wp -> do - let wpServer = - Servant.hoistServer - (Proxy @(WalletProxy WalletId)) - (asHandler pabRunner) - wp - rest = Proxy @(CombinedAPI t :<|> WalletProxy WalletId) - Servant.serve rest (apiServer :<|> wpServer) + Servant.serve (Proxy @(CombinedAPI t)) apiServer Just filePath -> do let fileServer :: ServerT Raw Handler fileServer = serveDirectoryFileServer filePath - case either (fmap walletProxyClientEnv) (Just . walletProxy) walletClient of - Nothing -> do - Servant.serve (Proxy @(CombinedAPI t :<|> Raw)) (apiServer :<|> fileServer) - Just wp -> do - let wpServer = - Servant.hoistServer - (Proxy @(WalletProxy WalletId)) - (asHandler pabRunner) - wp - rest = Proxy @(CombinedAPI t :<|> WalletProxy WalletId :<|> Raw) - Servant.serve rest (apiServer :<|> wpServer :<|> fileServer) + Servant.serve (Proxy @(CombinedAPI t :<|> Raw)) (apiServer :<|> fileServer) -- | Start the server using the config. Returns an action that shuts it down -- again, and an MVar that is filled when the webserver @@ -127,14 +103,12 @@ startServer :: , OpenApi.ToSchema (Contract.ContractDef t) ) => WebserverConfig -- ^ Optional file path for static assets - -> Either (Maybe ClientEnv) (PABAction t env WalletInfo) - -- ^ How to generate a new wallet, either by proxying the request to the wallet API, or by running the PAB action -> Availability -> PABAction t env (MVar (), PABAction t env ()) -startServer WebserverConfig{baseUrl, staticDir, permissiveCorsPolicy, endpointTimeout} walletClient availability = do +startServer WebserverConfig{baseUrl, staticDir, permissiveCorsPolicy, endpointTimeout} availability = do when permissiveCorsPolicy $ logWarn @(LM.PABMultiAgentMsg t) (LM.UserLog "Warning: Using a very permissive CORS policy! *Any* website serving JavaScript can interact with these endpoints.") - startServer' middlewares (baseUrlPort baseUrl) walletClient staticDir availability (timeout endpointTimeout) + startServer' middlewares (baseUrlPort baseUrl) staticDir availability (timeout endpointTimeout) where middlewares = if permissiveCorsPolicy then corsMiddlewares else [] corsMiddlewares = @@ -163,12 +137,11 @@ startServer' :: ) => [Middleware] -- ^ Optional wai middleware -> Int -- ^ Port - -> Either (Maybe ClientEnv) (PABAction t env WalletInfo) -- ^ How to generate a new wallet, either by proxying the request to the wallet API, or by running the PAB action -> Maybe FilePath -- ^ Optional file path for static assets -> Availability -> Int -> PABAction t env (MVar (), PABAction t env ()) -startServer' waiMiddlewares port walletClient staticPath availability timeout = do +startServer' waiMiddlewares port staticPath availability timeout = do simRunner <- Core.pabRunner shutdownVar <- liftIO $ STM.atomically $ STM.newEmptyTMVar @() mvar <- liftIO newEmptyMVar @@ -190,7 +163,7 @@ startServer' waiMiddlewares port walletClient staticPath availability timeout = void $ liftIO $ forkFinally (Warp.runSettings warpSettings $ middleware - $ app staticPath walletClient simRunner) + $ app staticPath simRunner) (\_ -> putMVar mvar ()) pure (mvar, liftIO $ STM.atomically $ STM.putTMVar shutdownVar ()) @@ -219,7 +192,4 @@ startServerDebug' :: -> Simulation t (Simulation t ()) startServerDebug' conf = do tk <- newToken - let mkWalletInfo = do - (wllt, pk) <- Simulator.addWallet - pure $ WalletInfo{wiWallet = wllt, wiPaymentPubKeyHash = pk} - snd <$> startServer conf (Right mkWalletInfo) tk + snd <$> startServer conf tk