From 9937efea5cb7410e77375d8ce2eccd18e9f9699c Mon Sep 17 00:00:00 2001 From: Alexander Nemish Date: Tue, 23 Feb 2021 21:23:12 +0200 Subject: [PATCH] Remove SigningProcessEffect --- .../.plan.nix/plutus-pab.nix | 4 - .../.plan.nix/plutus-pab.nix | 4 - .../Plutus/Trace/Effects/EmulatedWalletAPI.hs | 9 +-- .../Plutus/Trace/Emulator/ContractInstance.hs | 7 +- .../src/Plutus/Trace/Emulator/Types.hs | 1 - plutus-contract/src/Wallet/API.hs | 4 - plutus-contract/src/Wallet/Effects.hs | 8 -- .../src/Wallet/Emulator/MultiAgent.hs | 6 +- plutus-contract/src/Wallet/Emulator/Wallet.hs | 9 +-- plutus-pab/app/Cli.hs | 17 +--- plutus-pab/app/Command.hs | 1 - plutus-pab/app/CommandParser.hs | 8 -- plutus-pab/plutus-pab.cabal | 4 - plutus-pab/plutus-pab.yaml | 5 -- plutus-pab/src/Cardano/SigningProcess/API.hs | 11 --- .../src/Cardano/SigningProcess/Client.hs | 39 --------- .../src/Cardano/SigningProcess/Server.hs | 80 ------------------- .../src/Cardano/SigningProcess/Types.hs | 52 ------------ plutus-pab/src/Cardano/Wallet/Types.hs | 2 +- plutus-pab/src/Plutus/PAB/App.hs | 19 +---- .../src/Plutus/PAB/Core/ContractInstance.hs | 6 +- .../src/Plutus/PAB/Effects/MultiAgent.hs | 11 +-- plutus-pab/src/Plutus/PAB/PABLogMsg.hs | 5 -- plutus-pab/src/Plutus/PAB/Types.hs | 4 - 24 files changed, 20 insertions(+), 296 deletions(-) delete mode 100644 plutus-pab/src/Cardano/SigningProcess/API.hs delete mode 100644 plutus-pab/src/Cardano/SigningProcess/Client.hs delete mode 100644 plutus-pab/src/Cardano/SigningProcess/Server.hs delete mode 100644 plutus-pab/src/Cardano/SigningProcess/Types.hs diff --git a/nix/pkgs/haskell/materialized-musl/.plan.nix/plutus-pab.nix b/nix/pkgs/haskell/materialized-musl/.plan.nix/plutus-pab.nix index 388bc946624..a3c7e219e0a 100644 --- a/nix/pkgs/haskell/materialized-musl/.plan.nix/plutus-pab.nix +++ b/nix/pkgs/haskell/materialized-musl/.plan.nix/plutus-pab.nix @@ -139,10 +139,6 @@ "Cardano/Protocol/Socket/Type" "Cardano/Protocol/Socket/Server" "Cardano/Protocol/Socket/Client" - "Cardano/SigningProcess/API" - "Cardano/SigningProcess/Server" - "Cardano/SigningProcess/Client" - "Cardano/SigningProcess/Types" "Cardano/Wallet/API" "Cardano/Wallet/Client" "Cardano/Wallet/Mock" diff --git a/nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-pab.nix b/nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-pab.nix index 388bc946624..a3c7e219e0a 100644 --- a/nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-pab.nix +++ b/nix/pkgs/haskell/materialized-unix/.plan.nix/plutus-pab.nix @@ -139,10 +139,6 @@ "Cardano/Protocol/Socket/Type" "Cardano/Protocol/Socket/Server" "Cardano/Protocol/Socket/Client" - "Cardano/SigningProcess/API" - "Cardano/SigningProcess/Server" - "Cardano/SigningProcess/Client" - "Cardano/SigningProcess/Types" "Cardano/Wallet/API" "Cardano/Wallet/Client" "Cardano/Wallet/Mock" diff --git a/plutus-contract/src/Plutus/Trace/Effects/EmulatedWalletAPI.hs b/plutus-contract/src/Plutus/Trace/Effects/EmulatedWalletAPI.hs index d5351e68253..1a3910928ae 100644 --- a/plutus-contract/src/Plutus/Trace/Effects/EmulatedWalletAPI.hs +++ b/plutus-contract/src/Plutus/Trace/Effects/EmulatedWalletAPI.hs @@ -14,19 +14,19 @@ module Plutus.Trace.Effects.EmulatedWalletAPI( ) where import Control.Monad.Freer (Eff, Member, subsume, type (~>)) -import Control.Monad.Freer.Extras (raiseEnd2) +import Control.Monad.Freer.Extras (raiseEnd) import Control.Monad.Freer.TH (makeEffect) import Ledger.Tx (txId) import Ledger.TxId (TxId) import Ledger.Value (Value) import Wallet.API (defaultSlotRange, payToPublicKey) -import Wallet.Effects (SigningProcessEffect, WalletEffect) +import Wallet.Effects (WalletEffect) import qualified Wallet.Emulator as EM import Wallet.Emulator.MultiAgent (MultiAgentEffect, walletAction) import Wallet.Emulator.Wallet (Wallet) data EmulatedWalletAPI r where - LiftWallet :: Wallet -> Eff '[WalletEffect, SigningProcessEffect] a -> EmulatedWalletAPI a + LiftWallet :: Wallet -> Eff '[WalletEffect] a -> EmulatedWalletAPI a makeEffect ''EmulatedWalletAPI @@ -51,5 +51,4 @@ handleEmulatedWalletAPI = \case LiftWallet w action -> walletAction w $ subsume - $ subsume - $ raiseEnd2 action + $ raiseEnd action diff --git a/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs b/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs index e3b561b3a18..bb422f689eb 100644 --- a/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs +++ b/plutus-contract/src/Plutus/Trace/Emulator/ContractInstance.hs @@ -36,7 +36,7 @@ import Control.Monad.Freer.Coroutine (Yield) import Control.Monad.Freer.Error (Error, throwError) import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg (..), LogObserve, logDebug, logError, logInfo, logWarn, mapLog) -import Control.Monad.Freer.Extras.Modify (raiseEnd11) +import Control.Monad.Freer.Extras.Modify (raiseEnd10) import Control.Monad.Freer.Reader (Reader, ask, runReader) import Control.Monad.Freer.State (State, evalState, get, gets, modify, put) import Data.Aeson (object) @@ -64,7 +64,7 @@ import Plutus.Trace.Scheduler (AgentSystemCall, ThreadId, mkAgentSysCall) import qualified Wallet.API as WAPI import Wallet.Effects (ChainIndexEffect, ContractRuntimeEffect (..), - NodeClientEffect, SigningProcessEffect, WalletEffect) + NodeClientEffect, WalletEffect) import Wallet.Emulator.LogMessages (TxBalanceMsg) import Wallet.Types (ContractInstanceId, EndpointDescription (..), EndpointValue (..), Notification (..), @@ -286,14 +286,13 @@ respondToRequest :: forall s e effs. respondToRequest f = do hks <- getHooks @s @e let hdl :: (Eff (Reader ContractInstanceId ': ContractRuntimeEffect ': EmulatedWalletEffects) (Maybe (Response (Event s)))) = tryHandler (wrapHandler f) hks - hdl' :: (Eff (ContractInstanceRequests effs) (Maybe (Response (Event s)))) = raiseEnd11 hdl + hdl' :: (Eff (ContractInstanceRequests effs) (Maybe (Response (Event s)))) = raiseEnd10 hdl response_ :: Eff effs (Maybe (Response (Event s))) = subsume @(LogMsg T.Text) $ subsume @(LogMsg TxBalanceMsg) $ subsume @(LogMsg RequestHandlerLogMsg) $ subsume @(LogObserve (LogMessage T.Text)) - $ subsume @SigningProcessEffect $ subsume @ChainIndexEffect $ subsume @NodeClientEffect $ subsume @(Error WAPI.WalletAPIError) diff --git a/plutus-contract/src/Plutus/Trace/Emulator/Types.hs b/plutus-contract/src/Plutus/Trace/Emulator/Types.hs index 1e621769116..c9610cbbcd8 100644 --- a/plutus-contract/src/Plutus/Trace/Emulator/Types.hs +++ b/plutus-contract/src/Plutus/Trace/Emulator/Types.hs @@ -120,7 +120,6 @@ type EmulatedWalletEffects' effs = ': Error WAPI.WalletAPIError ': Wallet.NodeClientEffect ': Wallet.ChainIndexEffect - ': Wallet.SigningProcessEffect ': LogObserve (LogMessage T.Text) ': LogMsg RequestHandlerLogMsg ': LogMsg TxBalanceMsg diff --git a/plutus-contract/src/Wallet/API.hs b/plutus-contract/src/Wallet/API.hs index 74bb6cb432a..0d85192925b 100644 --- a/plutus-contract/src/Wallet/API.hs +++ b/plutus-contract/src/Wallet/API.hs @@ -26,8 +26,6 @@ module Wallet.API( NodeClientEffect, publishTx, getClientSlot, - SigningProcessEffect, - addSignatures, ChainIndexEffect, startWatching, watchedAddresses, @@ -78,7 +76,6 @@ createPaymentWithChange v = -- transaction that was submitted. payToPublicKey :: ( Member WalletEffect effs - , Member SigningProcessEffect effs ) => SlotRange -> Value -> PubKey -> Eff effs Tx payToPublicKey range v pk = do @@ -89,7 +86,6 @@ payToPublicKey range v pk = do -- | Transfer some funds to an address locked by a public key. payToPublicKey_ :: ( Member WalletEffect effs - , Member SigningProcessEffect effs ) => SlotRange -> Value -> PubKey -> Eff effs () payToPublicKey_ r v = void . payToPublicKey r v diff --git a/plutus-contract/src/Wallet/Effects.hs b/plutus-contract/src/Wallet/Effects.hs index edbcc01b0ad..9c35ebee38e 100644 --- a/plutus-contract/src/Wallet/Effects.hs +++ b/plutus-contract/src/Wallet/Effects.hs @@ -25,9 +25,6 @@ module Wallet.Effects( , NodeClientEffect(..) , publishTx , getClientSlot - -- * Signing process - , SigningProcessEffect(..) - , addSignatures -- * Chain index , ChainIndexEffect(..) , AddressChangeRequest(..) @@ -62,10 +59,6 @@ data NodeClientEffect r where GetClientSlot :: NodeClientEffect Slot makeEffect ''NodeClientEffect -data SigningProcessEffect r where - AddSignatures :: [PubKeyHash] -> Tx -> SigningProcessEffect Tx -makeEffect ''SigningProcessEffect - {-| Access the chain index. The chain index keeps track of the datums that are associated with unspent transaction outputs. Addresses that are of interest need to be added with 'startWatching' before their outputs @@ -91,7 +84,6 @@ makeEffect ''ContractRuntimeEffect type WalletEffects = '[ WalletEffect , NodeClientEffect - , SigningProcessEffect , ChainIndexEffect , ContractRuntimeEffect ] diff --git a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs index 19374f37fa3..96461505260 100644 --- a/plutus-contract/src/Wallet/Emulator/MultiAgent.hs +++ b/plutus-contract/src/Wallet/Emulator/MultiAgent.hs @@ -22,7 +22,7 @@ import Control.Monad import Control.Monad.Freer import Control.Monad.Freer.Error import Control.Monad.Freer.Extras.Log (LogMessage, LogMsg, LogObserve, handleObserveLog, mapLog) -import Control.Monad.Freer.Extras.Modify (handleZoomedState, raiseEnd5, raiseEnd9, writeIntoState) +import Control.Monad.Freer.Extras.Modify (handleZoomedState, raiseEnd5, raiseEnd8, writeIntoState) import Control.Monad.Freer.State import Data.Aeson (FromJSON, ToJSON) import Data.Map (Map) @@ -193,7 +193,6 @@ handleMultiAgentEffects wallet = . interpret (raiseWallet @(LogMsg TxBalanceMsg) wallet) . interpret (raiseWallet @(LogMsg RequestHandlerLogMsg) wallet) . interpret (raiseWallet @(LogObserve (LogMessage T.Text)) wallet) - . interpret (raiseWallet @WAPI.SigningProcessEffect wallet) . interpret (raiseWallet @WAPI.ChainIndexEffect wallet) . interpret (raiseWallet @WAPI.NodeClientEffect wallet) . interpret (raiseWallet @(Error WAPI.WalletAPIError) wallet) @@ -355,12 +354,11 @@ handleMultiAgent = interpret $ \case p7 :: AReview EmulatorEvent' Notify.EmulatorNotifyLogMsg p7 = notificationEvent act - & raiseEnd9 + & raiseEnd8 & Wallet.handleWallet & subsume & NC.handleNodeClient & ChainIndex.handleChainIndex - & Wallet.handleSigningProcess & handleObserveLog & interpret (mapLog (review p5)) & interpret (mapLog (review p6)) diff --git a/plutus-contract/src/Wallet/Emulator/Wallet.hs b/plutus-contract/src/Wallet/Emulator/Wallet.hs index 66de811c043..264e37c30aa 100644 --- a/plutus-contract/src/Wallet/Emulator/Wallet.hs +++ b/plutus-contract/src/Wallet/Emulator/Wallet.hs @@ -42,8 +42,7 @@ import qualified Ledger.Value as Value import Prelude as P import Servant.API (FromHttpApiData (..), ToHttpApiData (..)) import qualified Wallet.API as WAPI -import Wallet.Effects (ChainIndexEffect, NodeClientEffect, SigningProcessEffect (..), - WalletEffect (..)) +import Wallet.Effects (ChainIndexEffect, NodeClientEffect, WalletEffect (..)) import qualified Wallet.Effects as W import Wallet.Emulator.ChainIndex (ChainIndexState) import Wallet.Emulator.LogMessages (RequestHandlerLogMsg, TxBalanceMsg) @@ -276,9 +275,3 @@ type SigningProcessEffs = '[State SigningProcess, Error WAPI.WalletAPIError] handleSigningProcessControl :: (Members SigningProcessEffs effs) => Eff (SigningProcessControlEffect ': effs) ~> Eff effs handleSigningProcessControl = interpret $ \case SetSigningProcess proc -> put proc - -handleSigningProcess :: (Members SigningProcessEffs effs) => Eff (SigningProcessEffect ': effs) ~> Eff effs -handleSigningProcess = interpret $ \case - AddSignatures sigs tx -> do - SigningProcess process <- get - process sigs tx diff --git a/plutus-pab/app/Cli.hs b/plutus-pab/app/Cli.hs index 07d6bd84bb9..33647eed60b 100644 --- a/plutus-pab/app/Cli.hs +++ b/plutus-pab/app/Cli.hs @@ -61,7 +61,6 @@ import Cardano.BM.Data.Trace (Trace) import qualified Cardano.ChainIndex.Server as ChainIndex import qualified Cardano.Metadata.Server as Metadata import qualified Cardano.Node.Server as NodeServer -import qualified Cardano.SigningProcess.Server as SigningProcess import qualified Cardano.Wallet.Server as WalletServer import Cardano.Wallet.Types import Control.Concurrent (threadDelay) @@ -93,12 +92,11 @@ import qualified Plutus.PAB.Core.ContractInstance as Instance import Plutus.PAB.Events.Contract (ContractInstanceId (..)) import Plutus.PAB.PABLogMsg (AppMsg (..), ChainIndexServerMsg, ContractExeLogMsg (..), MetadataLogMessage, - MockServerLogMsg, PABLogMsg (..), SigningProcessMsg) + MockServerLogMsg, PABLogMsg (..)) import Plutus.PAB.Types (Config (Config), ContractExe (..), PABError, RequestProcessingConfig (..), chainIndexConfig, metadataServerConfig, nodeServerConfig, - requestProcessingConfig, signingProcessConfig, - walletServerConfig) + requestProcessingConfig, walletServerConfig) import qualified Plutus.PAB.Webserver.Server as PABServer -- | Interpret a 'Command' in 'Eff' using the provided tracer and configurations @@ -170,14 +168,6 @@ runCliCommand t _ Config {nodeServerConfig, chainIndexConfig} serviceAvailabilit (mscBaseUrl nodeServerConfig) serviceAvailability - --- Run the signing-process service -runCliCommand t _ Config {signingProcessConfig} serviceAvailability SigningProcess = - liftIO $ SigningProcess.main - (toSigningProcessLog t) - signingProcessConfig - serviceAvailability - -- Install a contract runCliCommand _ _ _ _ (InstallContract path) = interpret (mapLog SCoreMsg) @@ -259,9 +249,6 @@ toPABMsg = convertLog PABMsg toChainIndexLog :: Trace m AppMsg -> Trace m ChainIndexServerMsg toChainIndexLog = convertLog $ PABMsg . SChainIndexServerMsg -toSigningProcessLog :: Trace m AppMsg -> Trace m SigningProcessMsg -toSigningProcessLog = convertLog $ PABMsg . SSigningProcessMsg - toWalletLog :: Trace m AppMsg -> Trace m WalletMsg toWalletLog = convertLog $ PABMsg . SWalletMsg diff --git a/plutus-pab/app/Command.hs b/plutus-pab/app/Command.hs index 82025cfb454..f9f9fbe1cf7 100644 --- a/plutus-pab/app/Command.hs +++ b/plutus-pab/app/Command.hs @@ -23,7 +23,6 @@ data Command | ChainIndex -- ^ Run the chain index service | Metadata -- ^ Run the mock meta-data service | ForkCommands [Command] -- ^ Fork a list of commands - | SigningProcess -- ^ Run the signing process service | InstallContract FilePath -- ^ Install a contract | ActivateContract FilePath -- ^ Activate a contract | ContractState UUID -- ^ Display the contract identified by 'UUID' diff --git a/plutus-pab/app/CommandParser.hs b/plutus-pab/app/CommandParser.hs index f69fce3bd72..6e2b29c7a13 100644 --- a/plutus-pab/app/CommandParser.hs +++ b/plutus-pab/app/CommandParser.hs @@ -93,7 +93,6 @@ commandParser = , mockNodeParser , chainIndexParser , metadataParser - , signingProcessParser , reportTxHistoryParser , defaultConfigParser , command @@ -180,7 +179,6 @@ allServersParser = , Metadata , MockWallet , PABWebserver - , SigningProcess , ProcessAllContractOutboxes ])) (fullDesc <> progDesc "Run all the mock servers needed.") @@ -195,16 +193,10 @@ clientServicesParser = , Metadata , MockWallet , PABWebserver - , SigningProcess , ProcessAllContractOutboxes ])) (fullDesc <> progDesc "Run the client services (all services except the mock node).") -signingProcessParser :: Mod CommandFields Command -signingProcessParser = - command "signing-process" $ - info (pure SigningProcess) (fullDesc <> progDesc "Run the signing process.") - activateContractParser :: Mod CommandFields Command activateContractParser = command "activate" $ diff --git a/plutus-pab/plutus-pab.cabal b/plutus-pab/plutus-pab.cabal index a77bc24ca44..7c1152e77f7 100644 --- a/plutus-pab/plutus-pab.cabal +++ b/plutus-pab/plutus-pab.cabal @@ -68,10 +68,6 @@ library Cardano.Protocol.Socket.Type Cardano.Protocol.Socket.Server Cardano.Protocol.Socket.Client - Cardano.SigningProcess.API - Cardano.SigningProcess.Server - Cardano.SigningProcess.Client - Cardano.SigningProcess.Types Cardano.Wallet.API Cardano.Wallet.Client Cardano.Wallet.Mock diff --git a/plutus-pab/plutus-pab.yaml b/plutus-pab/plutus-pab.yaml index 143bf02d422..a9ba9cf2ee3 100644 --- a/plutus-pab/plutus-pab.yaml +++ b/plutus-pab/plutus-pab.yaml @@ -30,10 +30,5 @@ chainIndexConfig: requestProcessingConfig: requestProcessingInterval: 1 -signingProcessConfig: - spBaseUrl: http://localhost:8084 - spWallet: - getWallet: 1 - metadataServerConfig: mdBaseUrl: http://localhost:8085 diff --git a/plutus-pab/src/Cardano/SigningProcess/API.hs b/plutus-pab/src/Cardano/SigningProcess/API.hs deleted file mode 100644 index 1e9c059e5d2..00000000000 --- a/plutus-pab/src/Cardano/SigningProcess/API.hs +++ /dev/null @@ -1,11 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeOperators #-} - -module Cardano.SigningProcess.API - ( API - ) where - -import Ledger (PubKeyHash, Tx) -import Servant.API (Get, JSON, ReqBody, (:>)) - -type API = "add-signatures" :> ReqBody '[ JSON] ([PubKeyHash], Tx) :> Get '[ JSON] Tx diff --git a/plutus-pab/src/Cardano/SigningProcess/Client.hs b/plutus-pab/src/Cardano/SigningProcess/Client.hs deleted file mode 100644 index 38dd0c21add..00000000000 --- a/plutus-pab/src/Cardano/SigningProcess/Client.hs +++ /dev/null @@ -1,39 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE GADTs #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE TypeApplications #-} -{-# LANGUAGE TypeOperators #-} - -module Cardano.SigningProcess.Client where - -import Cardano.SigningProcess.API (API) -import Control.Monad.Freer -import Control.Monad.Freer.Error (Error, throwError) -import Control.Monad.IO.Class (MonadIO (..)) -import Data.Proxy (Proxy (Proxy)) -import Ledger (PubKeyHash, Tx) -import Servant.Client (ClientEnv, ClientError, ClientM, client, runClientM) -import Wallet.Effects (SigningProcessEffect (..)) - -addSignatures :: [PubKeyHash] -> Tx -> ClientM Tx -addSignatures = curry addSignatures_ where - addSignatures_ = client (Proxy @API) - -handleSigningProcessClient :: - forall m effs. - ( LastMember m effs - , MonadIO m - , Member (Error ClientError) effs - ) - => ClientEnv - -> SigningProcessEffect - ~> Eff effs -handleSigningProcessClient clientEnv = - let - runClient :: forall a. ClientM a -> Eff effs a - runClient a = (sendM $ liftIO $ runClientM a clientEnv) >>= either throwError pure - in - \case - AddSignatures sigs tx -> runClient (addSignatures sigs tx) diff --git a/plutus-pab/src/Cardano/SigningProcess/Server.hs b/plutus-pab/src/Cardano/SigningProcess/Server.hs deleted file mode 100644 index a9fe93e028f..00000000000 --- a/plutus-pab/src/Cardano/SigningProcess/Server.hs +++ /dev/null @@ -1,80 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE NamedFieldPuns #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE RankNTypes #-} -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TypeApplications #-} - -module Cardano.SigningProcess.Server( - -- $signingProcess - main - ) where - -import Control.Concurrent.Availability (Availability, available) -import Control.Concurrent.MVar (MVar, newMVar, putMVar, takeMVar) -import Control.Monad.Freer -import qualified Control.Monad.Freer.Error as Eff -import Control.Monad.Freer.Extras.Log -import qualified Control.Monad.Freer.State as Eff -import Control.Monad.IO.Class (MonadIO (..)) -import Data.Function ((&)) -import Data.Proxy (Proxy (..)) -import qualified Network.Wai.Handler.Warp as Warp -import Servant (Application, hoistServer, serve) -import Servant.Client (BaseUrl (baseUrlPort)) - -import Cardano.BM.Data.Trace (Trace) -import Cardano.SigningProcess.API (API) -import Cardano.SigningProcess.Types (SigningProcessConfig (..), SigningProcessEffects, - SigningProcessMsg (..)) -import Cardano.Wallet.Types (WalletUrl (..)) -import Data.Coerce (coerce) -import Plutus.PAB.Monitoring (runLogEffects) -import qualified Wallet.Effects as WE -import Wallet.Emulator.Wallet (SigningProcess, defaultSigningProcess, handleSigningProcess) - --- $ signingProcess --- The signing process that adds signatures to transactions. --- WARNING: This implements 'Wallet.Emulator.SigningProcess. --- defaultSigningProcess', which attaches the signature of a single --- wallet to the transaction. It does not support --- 'Wallet.Emulator.SigningProcess.signWallets', which attaches multiple --- signatures at once. 'signWallets' is needed for the multi sig examples. - -app :: MVar SigningProcess -> Application -app stateVar = - serve (Proxy @API) $ - hoistServer - (Proxy @API) - (processSigningProcessEffects stateVar) - (uncurry WE.addSignatures) - -main :: Trace IO SigningProcessMsg -> SigningProcessConfig -> Availability -> IO () -main trace SigningProcessConfig{spWallet, spBaseUrl} availability = runLogEffects trace $ do - stateVar <- liftIO $ newMVar (defaultSigningProcess spWallet) - logInfo $ StartingSigningProcess servicePort - liftIO $ Warp.runSettings warpSettings $ app stateVar - where - servicePort = baseUrlPort (coerce spBaseUrl) - isAvailable = available availability - warpSettings = Warp.defaultSettings - & Warp.setPort servicePort - & Warp.setBeforeMainLoop isAvailable - -processSigningProcessEffects :: - MonadIO m - => MVar SigningProcess - -> Eff SigningProcessEffects a - -> m a -processSigningProcessEffects procVar eff = do - process <- liftIO $ takeMVar procVar - let e = run $ Eff.runError $ Eff.runState process $ handleSigningProcess eff - case e of - Left err -> do - liftIO $ putMVar procVar process - error $ show err - Right (a, process') -> do - liftIO $ putMVar procVar process' - pure a diff --git a/plutus-pab/src/Cardano/SigningProcess/Types.hs b/plutus-pab/src/Cardano/SigningProcess/Types.hs deleted file mode 100644 index c21ddb8b64b..00000000000 --- a/plutus-pab/src/Cardano/SigningProcess/Types.hs +++ /dev/null @@ -1,52 +0,0 @@ -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE DerivingVia #-} -{-# LANGUAGE LambdaCase #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} - -module Cardano.SigningProcess.Types - ( SigningProcessEffects - , SigningProcessMsg (..) - , SigningProcessConfig (..) - , WalletUrl - ) where - -import Control.Monad.Freer.Error (Error) -import Data.Aeson (FromJSON, ToJSON) -import Data.Text.Prettyprint.Doc (Pretty (..), (<+>)) -import GHC.Generics (Generic) - -import Cardano.BM.Data.Tracer (ToObject (..)) -import Cardano.BM.Data.Tracer.Extras (Tagged (..), mkObjectStr) -import Cardano.Wallet.Types (WalletUrl) -import Control.Monad.Freer.State (State) -import Wallet (SigningProcessEffect) -import qualified Wallet.API as WAPI -import Wallet.Emulator.Wallet (SigningProcess, Wallet) - -type SigningProcessEffects = - '[ SigningProcessEffect, State SigningProcess, Error WAPI.WalletAPIError] - - -data SigningProcessConfig = - SigningProcessConfig - { spWallet :: Wallet -- Wallet with whose private key transactions should be signed. - , spBaseUrl :: WalletUrl - } deriving stock (Eq, Show, Generic) - deriving anyclass (ToJSON, FromJSON) - - -newtype SigningProcessMsg = - StartingSigningProcess Int -- ^ Starting up on the specified port - deriving stock (Show, Generic) - deriving anyclass (ToJSON, FromJSON) - -instance Pretty SigningProcessMsg where - pretty = \case - StartingSigningProcess port -> "Starting Signing Process on port " <+> pretty port - -instance ToObject SigningProcessMsg where - toObject _ = \case - StartingSigningProcess p -> mkObjectStr "starting signing process" (Tagged @"port" p) diff --git a/plutus-pab/src/Cardano/Wallet/Types.hs b/plutus-pab/src/Cardano/Wallet/Types.hs index a4924d11803..727307853cf 100644 --- a/plutus-pab/src/Cardano/Wallet/Types.hs +++ b/plutus-pab/src/Cardano/Wallet/Types.hs @@ -54,7 +54,7 @@ import Servant.Client (BaseUrl, ClientError) import Servant.Client.Internal.HttpClient (ClientEnv) import Wallet.Effects (ChainIndexEffect, NodeClientEffect, WalletEffect) import Wallet.Emulator.Error (WalletAPIError) -import Wallet.Emulator.Wallet (Wallet, WalletState) +import Wallet.Emulator.Wallet (Wallet) type Wallets = Map Wallet PrivateKey diff --git a/plutus-pab/src/Plutus/PAB/App.hs b/plutus-pab/src/Plutus/PAB/App.hs index 773bf3d1359..7875ab8390e 100644 --- a/plutus-pab/src/Plutus/PAB/App.hs +++ b/plutus-pab/src/Plutus/PAB/App.hs @@ -28,8 +28,6 @@ import Cardano.Node.Client (handleNodeClientClient, han handleRandomTxClient) import Cardano.Node.RandomTx (GenRandomTx) import Cardano.Node.Types (MockServerConfig (..), NodeFollowerEffect) -import qualified Cardano.SigningProcess.Client as SigningProcessClient -import qualified Cardano.SigningProcess.Types as SigningProcess import qualified Cardano.Wallet.Client as WalletClient import qualified Cardano.Wallet.Types as Wallet import Control.Monad.Catch (MonadCatch) @@ -65,12 +63,12 @@ import Plutus.PAB.Monitoring (handleLogMsgTrace, handleOb import Plutus.PAB.PABLogMsg (ContractExeLogMsg (..), PABLogMsg (..)) import Plutus.PAB.Types (Config (Config), ContractExe (..), PABError (..), chainIndexConfig, dbConfig, metadataServerConfig, nodeServerConfig, - signingProcessConfig, walletServerConfig) + walletServerConfig) import Servant.Client (ClientEnv, ClientError, mkClientEnv) import System.Exit (ExitCode (ExitFailure, ExitSuccess)) import System.Process (readProcessWithExitCode) import Wallet.Effects (ChainIndexEffect, ContractRuntimeEffect, NodeClientEffect, - SigningProcessEffect, WalletEffect) + WalletEffect) import Wallet.Emulator.Wallet (Wallet (..)) @@ -81,7 +79,6 @@ data Env = , walletClientEnv :: ClientEnv , nodeClientEnv :: ClientEnv , metadataClientEnv :: ClientEnv - , signingProcessEnv :: ClientEnv , chainIndexEnv :: ClientEnv } @@ -92,7 +89,6 @@ type AppBackend m = , WalletEffect , NodeClientEffect , MetadataEffect - , SigningProcessEffect , UUIDEffect , ContractEffect ContractExe , ChainIndexEffect @@ -124,7 +120,6 @@ runAppBackend trace loggingConfig config action = do , nodeClientEnv , metadataClientEnv , walletClientEnv - , signingProcessEnv , chainIndexEnv } <- mkEnv config let @@ -133,12 +128,6 @@ runAppBackend trace loggingConfig config action = do handleChainIndex = flip handleError (throwError . ChainIndexError) . reinterpret @_ @(Error ClientError) (handleChainIndexClient chainIndexEnv) - handleSigningProcess :: - Eff (SigningProcessEffect ': _) a -> Eff _ a - handleSigningProcess = - interpret (mapLog SWebsocketMsg) . - flip handleError (throwError . SigningProcessError) . - reinterpret2 @_ @(Error ClientError) (SigningProcessClient.handleSigningProcessClient signingProcessEnv) handleNodeClient :: Eff (NodeClientEffect ': _) a -> Eff _ a handleNodeClient = @@ -179,7 +168,6 @@ runAppBackend trace loggingConfig config action = do . handleChainIndex . interpret (mapLog SContractExeLogMsg) . reinterpret handleContractEffectApp . handleUUIDEffect - . handleSigningProcess . handleMetadata . handleNodeClient . handleWallet @@ -194,14 +182,11 @@ mkEnv Config { dbConfig , nodeServerConfig , metadataServerConfig , walletServerConfig - , signingProcessConfig , chainIndexConfig } = do walletClientEnv <- clientEnv (Wallet.baseUrl walletServerConfig) nodeClientEnv <- clientEnv (mscBaseUrl nodeServerConfig) metadataClientEnv <- clientEnv (Metadata.mdBaseUrl metadataServerConfig) - signingProcessEnv <- - clientEnv $ SigningProcess.spBaseUrl signingProcessConfig chainIndexEnv <- clientEnv (ChainIndex.ciBaseUrl chainIndexConfig) dbConnection <- dbConnect dbConfig pure Env {..} diff --git a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs index a7d2fd9af21..26fea624566 100644 --- a/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs +++ b/plutus-pab/src/Plutus/PAB/Core/ContractInstance.hs @@ -66,8 +66,7 @@ import Language.Plutus.Contract.Trace.RequestHandler (RequestHandler import qualified Language.Plutus.Contract.Trace.RequestHandler as RequestHandler import Ledger.Tx (Tx, txId) -import Wallet.Effects (ChainIndexEffect, ContractRuntimeEffect, - SigningProcessEffect, WalletEffect) +import Wallet.Effects (ChainIndexEffect, ContractRuntimeEffect, WalletEffect) import Wallet.Emulator.LogMessages (TxBalanceMsg) import Data.Text.Extras (tshow) @@ -471,7 +470,6 @@ processWriteTxRequests :: , Member (LogMsg RequestHandlerLogMsg) effs , Member (LogMsg (ContractInstanceMsg t)) effs , Member (LogMsg TxBalanceMsg) effs - , Member SigningProcessEffect effs ) => RequestHandler effs ContractPABRequest ContractResponse processWriteTxRequests = @@ -589,7 +587,6 @@ processAllContractOutboxes :: , Member (EventLogEffect (ChainEvent t)) effs , Member WalletEffect effs , Member ChainIndexEffect effs - , Member SigningProcessEffect effs , Member ContractRuntimeEffect effs , Member (Error PABError) effs , Member (ContractEffect t) effs @@ -608,7 +605,6 @@ contractRequestHandler :: ( Member (EventLogEffect (ChainEvent t)) effs , Member ChainIndexEffect effs , Member WalletEffect effs - , Member SigningProcessEffect effs , Member ContractRuntimeEffect effs , Member (LogMsg RequestHandlerLogMsg) effs , Member (LogObserve (LogMessage Text.Text)) effs diff --git a/plutus-pab/src/Plutus/PAB/Effects/MultiAgent.hs b/plutus-pab/src/Plutus/PAB/Effects/MultiAgent.hs index f14f1659558..182dc89742d 100644 --- a/plutus-pab/src/Plutus/PAB/Effects/MultiAgent.hs +++ b/plutus-pab/src/Plutus/PAB/Effects/MultiAgent.hs @@ -40,7 +40,7 @@ import Control.Monad.Freer (Eff, Members, interpret, su import Control.Monad.Freer.Error (Error, handleError, throwError) import Control.Monad.Freer.Extras.Log (LogLevel (..), LogMessage, LogMsg, LogObserve, handleLogWriter, handleObserveLog, logMessage) -import Control.Monad.Freer.Extras.Modify (handleZoomedState, handleZoomedWriter, raiseEnd10, raiseEnd18) +import Control.Monad.Freer.Extras.Modify (handleZoomedState, handleZoomedWriter, raiseEnd10, raiseEnd17) import Control.Monad.Freer.State (State) import Control.Monad.Freer.TH (makeEffect) import Control.Monad.Freer.Writer (Writer) @@ -66,7 +66,7 @@ import Plutus.PAB.Events (ChainEvent) import Plutus.PAB.Types (PABError (..)) import Wallet.Effects (ChainIndexEffect, ContractRuntimeEffect, NodeClientEffect, - SigningProcessEffect, WalletEffect) + WalletEffect) import qualified Wallet.Emulator.Chain as Chain import Wallet.Emulator.ChainIndex (ChainIndexControlEffect) import qualified Wallet.Emulator.ChainIndex as ChainIndex @@ -76,8 +76,7 @@ import Wallet.Emulator.MultiAgent (EmulatorEvent, EmulatorTime import Wallet.Emulator.NodeClient (NodeClientControlEffect, NodeClientEvent) import qualified Wallet.Emulator.NodeClient as NC import Wallet.Emulator.Wallet (SigningProcess, SigningProcessControlEffect, Wallet, WalletState, - defaultSigningProcess, handleSigningProcess, - handleSigningProcessControl) + defaultSigningProcess, handleSigningProcessControl) import qualified Wallet.Emulator.Wallet as Wallet -- $multiagent @@ -140,7 +139,6 @@ type PABClientEffects = , MetadataEffect , NodeClientEffect , ChainIndexEffect - , SigningProcessEffect , UUIDEffect , EventLogEffect (ChainEvent TestContracts) , NodeFollowerEffect @@ -210,14 +208,13 @@ handleMultiAgent = interpret $ \effect -> do p8 :: AReview [LogMessage PABMultiAgentMsg] (LogMessage ContractRuntimeMsg) p8 = _singleton . below _RuntimeLog action - & raiseEnd18 + & raiseEnd17 & Wallet.handleWallet & interpret (handleContractRuntime @TestContracts) & handleContractTest & handleMetadata & NC.handleNodeClient & ChainIndex.handleChainIndex - & handleSigningProcess & subsume & handleEventLogState & NF.handleNodeFollower diff --git a/plutus-pab/src/Plutus/PAB/PABLogMsg.hs b/plutus-pab/src/Plutus/PAB/PABLogMsg.hs index d9481b3629d..51f709c8e18 100644 --- a/plutus-pab/src/Plutus/PAB/PABLogMsg.hs +++ b/plutus-pab/src/Plutus/PAB/PABLogMsg.hs @@ -11,7 +11,6 @@ module Plutus.PAB.PABLogMsg( PABLogMsg(..), ContractExeLogMsg(..), ChainIndexServerMsg, - SigningProcessMsg, MetadataLogMessage, WalletMsg, MockServerLogMsg, @@ -32,7 +31,6 @@ import Cardano.BM.Data.Tracer.Extras (Tagged (..), mkObjectStr) import Cardano.ChainIndex.Types (ChainIndexServerMsg) import Cardano.Metadata.Types (MetadataLogMessage) import Cardano.Node.Types (MockServerLogMsg) -import Cardano.SigningProcess.Types (SigningProcessMsg) import Cardano.Wallet.Types (WalletMsg) import Language.Plutus.Contract.State (ContractRequest) import Ledger.Tx (Tx) @@ -87,7 +85,6 @@ data PABLogMsg = | SWebsocketMsg WebSocketLogMsg | SContractRuntimeMsg ContractRuntimeMsg | SChainIndexServerMsg ChainIndexServerMsg - | SSigningProcessMsg SigningProcessMsg | SWalletMsg WalletMsg | SMetaDataLogMsg MetadataLogMessage | SMockserverLogMsg MockServerLogMsg @@ -105,7 +102,6 @@ instance Pretty PABLogMsg where SWebsocketMsg m -> pretty m SContractRuntimeMsg m -> pretty m SChainIndexServerMsg m -> pretty m - SSigningProcessMsg m -> pretty m SWalletMsg m -> pretty m SMetaDataLogMsg m -> pretty m SMockserverLogMsg m -> pretty m @@ -210,7 +206,6 @@ instance ToObject PABLogMsg where SWebsocketMsg e -> toObject v e SContractRuntimeMsg e -> toObject v e SChainIndexServerMsg m -> toObject v m - SSigningProcessMsg m -> toObject v m SWalletMsg m -> toObject v m SMetaDataLogMsg m -> toObject v m SMockserverLogMsg m -> toObject v m diff --git a/plutus-pab/src/Plutus/PAB/Types.hs b/plutus-pab/src/Plutus/PAB/Types.hs index 0620411eada..d90397223cf 100644 --- a/plutus-pab/src/Plutus/PAB/Types.hs +++ b/plutus-pab/src/Plutus/PAB/Types.hs @@ -15,7 +15,6 @@ import Cardano.BM.Data.Tracer.Extras (StructuredLog (..)) import qualified Cardano.ChainIndex.Types as ChainIndex import qualified Cardano.Metadata.Types as Metadata import Cardano.Node.Types (MockServerConfig (..)) -import qualified Cardano.SigningProcess.Types as SigningProcess import qualified Cardano.Wallet.Types as Wallet import Control.Lens.TH (makePrisms) import Data.Aeson (FromJSON, ToJSON (..)) @@ -59,7 +58,6 @@ data PABError | NodeClientError ClientError | RandomTxClientError ClientError | MetadataError Metadata.MetadataError - | SigningProcessError ClientError | ChainIndexError ClientError | WalletError WalletAPIError | ContractCommandError Int Text @@ -79,7 +77,6 @@ instance Pretty PABError where NodeClientError e -> "Node client error:" <+> viaShow e RandomTxClientError e -> "Random tx client error:" <+> viaShow e MetadataError e -> "Metadata error:" <+> viaShow e - SigningProcessError e -> "Signing process error:" <+> viaShow e ChainIndexError e -> "Chain index error:" <+> viaShow e WalletError e -> "Wallet error:" <+> pretty e ContractCommandError i t -> "Contract command error:" <+> pretty i <+> pretty t @@ -105,7 +102,6 @@ data Config = , metadataServerConfig :: Metadata.MetadataConfig , pabWebserverConfig :: WebserverConfig , chainIndexConfig :: ChainIndex.ChainIndexConfig - , signingProcessConfig :: SigningProcess.SigningProcessConfig , requestProcessingConfig :: RequestProcessingConfig } deriving (Show, Eq, Generic, FromJSON)