From 11e230258af987751d512848334eea827e775c72 Mon Sep 17 00:00:00 2001 From: Jamie Bertram Date: Thu, 21 Sep 2023 09:44:53 -0400 Subject: [PATCH] Remove deprecated chain seek options from marlowe-apps --- marlowe-apps/marlowe-apps.cabal | 1 - .../Language/Marlowe/Runtime/App/Parser.hs | 61 +------------------ .../src/Language/Marlowe/Runtime/App/Run.hs | 38 +----------- .../Language/Marlowe/Runtime/App/Submit.hs | 51 +--------------- .../src/Language/Marlowe/Runtime/App/Types.hs | 36 ++--------- 5 files changed, 11 insertions(+), 176 deletions(-) diff --git a/marlowe-apps/marlowe-apps.cabal b/marlowe-apps/marlowe-apps.cabal index 91dae60177..50d4d9b07c 100644 --- a/marlowe-apps/marlowe-apps.cabal +++ b/marlowe-apps/marlowe-apps.cabal @@ -51,7 +51,6 @@ library , text , time , time-units - , transformers , transformers-base ghc-options: diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App/Parser.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App/Parser.hs index ad65e24a98..12bfbd7199 100644 --- a/marlowe-apps/src/Language/Marlowe/Runtime/App/Parser.hs +++ b/marlowe-apps/src/Language/Marlowe/Runtime/App/Parser.hs @@ -8,10 +8,8 @@ import Data.Default (def) import Language.Marlowe.Runtime.App.Types ( Config (Config, buildSeconds, confirmSeconds, retryLimit, retrySeconds, timeoutSeconds), ) -import Language.Marlowe.Runtime.CLI.Option (CliOption, optParserWithEnvDefault) +import Language.Marlowe.Runtime.CLI.Option (optParserWithEnvDefault) import Language.Marlowe.Runtime.ChainSync.Api (Address, fromBech32) -import Network.Socket (HostName, PortNumber) -import Text.Read (readMaybe) import qualified Data.Text as T (pack) import qualified Language.Marlowe.Runtime.CLI.Option as CLI @@ -20,9 +18,6 @@ import qualified Options.Applicative as O getConfigParser :: IO (O.Parser Config) getConfigParser = do - chainSeekHostParser <- optParserWithEnvDefault chainSeekHost - chainSeekSyncPortParser <- optParserWithEnvDefault chainSeekSyncPort - chainSeekCommandPortParser <- optParserWithEnvDefault chainSeekCommandPort runtimeHostParser <- optParserWithEnvDefault CLI.runtimeHost runtimePortParser <- optParserWithEnvDefault CLI.runtimePort let timeoutSecondsParser = @@ -66,10 +61,7 @@ getConfigParser = "Maximum number of attempts for trying a failed transaction again. Each subsequent retry waits twice as long as the previous retry. No retries occur if a non-positive number of retries is specified." pure $ Config - <$> chainSeekHostParser - <*> chainSeekSyncPortParser - <*> chainSeekCommandPortParser - <*> runtimeHostParser + <$> runtimeHostParser <*> runtimePortParser <*> timeoutSecondsParser <*> buildSecondsParser @@ -77,55 +69,6 @@ getConfigParser = <*> retrySecondsParser <*> retryLimitParser -host' :: String -> String -> HostName -> String -> CliOption O.OptionFields HostName -host' optPrefix envPrefix defaultValue description = - CLI.CliOption - { CLI.env = env - , CLI.parseEnv = Just - , CLI.parser = - O.strOption - . (<>) - ( mconcat - [ O.long $ optPrefix <> "-host" - , O.value defaultValue - , O.metavar "HOST_NAME" - , O.help $ description <> " Can be set as the environment variable " <> env - , O.showDefault - ] - ) - } - where - env = "MARLOWE_" <> envPrefix <> "_HOST" - -port' :: String -> String -> PortNumber -> String -> CliOption O.OptionFields PortNumber -port' optPrefix envPrefix defaultValue description = - CLI.CliOption - { CLI.env = env - , CLI.parseEnv = readMaybe - , CLI.parser = - O.option O.auto - . (<>) - ( mconcat - [ O.long $ optPrefix <> "-port" - , O.value defaultValue - , O.metavar "PORT_NUMBER" - , O.help $ description <> " Can be set as the environment variable " <> env - , O.showDefault - ] - ) - } - where - env = "MARLOWE_" <> envPrefix <> "_PORT" - -chainSeekHost :: CliOption O.OptionFields HostName -chainSeekHost = host' "chain-sync" "CHAIN_SYNC" "127.0.0.1" "The hostname of the Marlowe Runtime chain-sync server." - -chainSeekSyncPort :: CliOption O.OptionFields PortNumber -chainSeekSyncPort = port' "chain-sync" "CHAIN_SYNC" 3715 "The port number of the chain-sync server's synchronization API." - -chainSeekCommandPort :: CliOption O.OptionFields PortNumber -chainSeekCommandPort = port' "chain-sync-command" "CHAIN_SYNC_COMMAND" 3720 "The port number of the chain-sync server's job API." - addressParser :: O.ReadM Address addressParser = O.maybeReader $ fromBech32 . T.pack diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App/Run.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App/Run.hs index ebeeaf626e..06e7a192b6 100644 --- a/marlowe-apps/src/Language/Marlowe/Runtime/App/Run.hs +++ b/marlowe-apps/src/Language/Marlowe/Runtime/App/Run.hs @@ -6,48 +6,14 @@ {-# LANGUAGE UndecidableInstances #-} module Language.Marlowe.Runtime.App.Run ( - runChainSeekClient, runClientWithConfig, - runJobClient, ) where -import Control.Monad.Reader (ask) -import Control.Monad.Trans.Control (liftBaseWith) -import Control.Monad.Trans.Reader (ReaderT (..)) -import Language.Marlowe.Runtime.App.Types (Client (..), Config (..), Services (..)) -import Language.Marlowe.Runtime.ChainSync.Api (RuntimeChainSeekClient) +import Language.Marlowe.Runtime.App.Types (Client (..), Config (..)) import Language.Marlowe.Runtime.Client (connectToMarloweRuntime) -import Network.Protocol.ChainSeek.Client (chainSeekClientPeer, hoistChainSeekClient) -import Network.Protocol.Connection (runConnector) -import Network.Protocol.Driver (tcpClient) -import Network.Protocol.Job.Client (JobClient, hoistJobClient, jobClientPeer) - -runJobClient - :: (Services IO -> JobClient q IO a -> IO a) - -> JobClient q Client a - -> Client a -runJobClient job client = - do - services <- Client ask - liftBaseWith $ \runInBase -> job services $ hoistJobClient runInBase client - -runChainSeekClient - :: (Services IO -> RuntimeChainSeekClient IO a -> IO a) - -> RuntimeChainSeekClient Client a - -> Client a -runChainSeekClient seek client = - do - services <- Client ask - liftBaseWith $ \runInBase -> seek services $ hoistChainSeekClient runInBase client runClientWithConfig :: Config -> Client a -> IO a -runClientWithConfig Config{..} client = - runReaderT - (connectToMarloweRuntime runtimeHost runtimePort (runClient client)) - Services - { runChainSeekCommandClient = runConnector $ tcpClient chainSeekHost chainSeekCommandPort jobClientPeer - , runChainSeekSyncClient = runConnector $ tcpClient chainSeekHost chainSeekSyncPort chainSeekClientPeer - } +runClientWithConfig Config{..} client = connectToMarloweRuntime runtimeHost runtimePort (runClient client) diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App/Submit.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App/Submit.hs index a63f6381bb..21debff142 100644 --- a/marlowe-apps/src/Language/Marlowe/Runtime/App/Submit.hs +++ b/marlowe-apps/src/Language/Marlowe/Runtime/App/Submit.hs @@ -2,37 +2,19 @@ module Language.Marlowe.Runtime.App.Submit ( submit, - submit', - waitForTx', ) where import Control.Concurrent (threadDelay) import Control.Monad.IO.Class (liftIO) -import Data.Bifunctor (second) -import Data.Functor (($>)) -import Language.Marlowe.Runtime.App.Run (runChainSeekClient, runJobClient) -import Language.Marlowe.Runtime.App.Types (Client, Services (..)) +import Language.Marlowe.Runtime.App.Types (Client) import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId) import Language.Marlowe.Runtime.ChainSync.Api ( - ChainSyncCommand (SubmitTx), - Move (FindTx), - Transaction, TxId, - WithGenesis (..), ) import Language.Marlowe.Runtime.Client (runMarloweTxClient) import Language.Marlowe.Runtime.Transaction.Api (MarloweTxCommand (Submit)) -import Network.Protocol.ChainSeek.Client ( - ChainSeekClient (ChainSeekClient), - ClientStIdle (..), - ClientStNext (..), - ClientStPoll (..), - ) -import Network.Protocol.Job.Client (liftCommand) import qualified Cardano.Api as C ( - BabbageEra, - ScriptDataSupportedInEra (ScriptDataInBabbageEra), Tx, getTxBody, getTxId, @@ -61,34 +43,3 @@ submit pollingFrequency era tx = } jobClient = J.JobClient . pure $ J.SendMsgExec (Submit era tx) next in runMarloweTxClient jobClient - -{-# DEPRECATED submit' "Crashes the chain-sync worker!" #-} -submit' - :: C.Tx C.BabbageEra - -> Client (Either String TxId) -submit' tx = - fmap (second . const . fromCardanoTxId . C.getTxId $ C.getTxBody tx) - . runJobClient runChainSeekCommandClient - . liftCommand - $ SubmitTx C.ScriptDataInBabbageEra tx - -{-# DEPRECATED waitForTx' "Crashes the chain-sync worker!" #-} -waitForTx' - :: Int - -> TxId - -> Client (Either String Transaction) -waitForTx' pollingFrequency txId = - let clientIdle = SendMsgQueryNext (FindTx txId True) clientNext - clientNext = - ClientStNext - { recvMsgQueryRejected = \err _ -> - pure $ SendMsgDone $ Left $ "Chain sync rejected query: " <> show err <> "." - , recvMsgWait = liftIO (threadDelay $ pollingFrequency * 1_000_000) $> SendMsgPoll clientNext - , recvMsgRollBackward = \_ _ -> pure clientIdle - , recvMsgRollForward = \tx point _ -> case point of - Genesis -> pure $ SendMsgDone $ Left "Chain sync rolled forward to genesis." - At _ -> pure $ SendMsgDone $ Right tx - } - in runChainSeekClient runChainSeekSyncClient - . ChainSeekClient - $ pure clientIdle diff --git a/marlowe-apps/src/Language/Marlowe/Runtime/App/Types.hs b/marlowe-apps/src/Language/Marlowe/Runtime/App/Types.hs index 2c08e28755..76c8140c5c 100644 --- a/marlowe-apps/src/Language/Marlowe/Runtime/App/Types.hs +++ b/marlowe-apps/src/Language/Marlowe/Runtime/App/Types.hs @@ -25,7 +25,6 @@ module Language.Marlowe.Runtime.App.Types ( MarloweResponse (..), PollingFrequency (..), RunClient, - Services (..), mkBody, ) where @@ -35,7 +34,6 @@ import Control.Monad.Except (ExceptT) import Control.Monad.Fix (MonadFix) import Control.Monad.IO.Class (MonadIO (..)) import Control.Monad.Trans.Control (MonadBaseControl) -import Control.Monad.Trans.Reader (ReaderT (..)) import Control.Monad.With (MonadWith (..)) import Data.Default (Default (..)) import Data.Functor ((<&>)) @@ -45,9 +43,7 @@ import Language.Marlowe (POSIXTime (..)) import Language.Marlowe.Runtime.Cardano.Api (fromCardanoTxId) import Language.Marlowe.Runtime.ChainSync.Api ( Address, - ChainSyncCommand, Lovelace (..), - RuntimeChainSeekClient, TokenName, TransactionMetadata, TxId, @@ -82,7 +78,6 @@ import Language.Marlowe.Runtime.History.Api ( CreateStep (..), RedeemStep (RedeemStep, datum, redeemingTx, utxo), ) -import Network.Protocol.Job.Client (JobClient) import Network.Socket (HostName, PortNumber) import Cardano.Api (AnyCardanoEra (..)) @@ -125,10 +120,7 @@ data TxInEraWithReferenceScripts where type App = ExceptT String IO data Config = Config - { chainSeekHost :: HostName - , chainSeekSyncPort :: PortNumber - , chainSeekCommandPort :: PortNumber - , runtimeHost :: HostName + { runtimeHost :: HostName , runtimePort :: PortNumber , timeoutSeconds :: Int , buildSeconds :: Int @@ -141,10 +133,7 @@ data Config = Config instance Default Config where def = Config - { chainSeekHost = "127.0.0.1" - , chainSeekSyncPort = 3715 - , chainSeekCommandPort = 3720 - , runtimeHost = "127.0.0.1" + { runtimeHost = "127.0.0.1" , runtimePort = 3700 , timeoutSeconds = 900 , buildSeconds = 3 @@ -153,18 +142,13 @@ instance Default Config where , retryLimit = 5 } -data Services m = Services - { runChainSeekCommandClient :: RunClient m (JobClient ChainSyncCommand) - , runChainSeekSyncClient :: RunClient m RuntimeChainSeekClient - } - -- | A monad type for Marlowe Runtime.Client programs. -newtype Client a = Client {runClient :: MarloweT (ReaderT (Services IO) IO) a} +newtype Client a = Client {runClient :: MarloweT IO a} deriving newtype (Alternative, Applicative, Functor, Monad, MonadBase IO, MonadBaseControl IO, MonadFail, MonadFix, MonadIO) instance MonadWith Client where - type WithException Client = WithException (MarloweT (ReaderT (Services IO) IO)) + type WithException Client = WithException (MarloweT IO) stateThreadingGeneralWith :: forall a b releaseReturn . GeneralAllocate Client (WithException Client) releaseReturn b a @@ -174,16 +158,8 @@ instance MonadWith Client where stateThreadingGeneralWith (GeneralAllocate allocA') $ runClient . go where allocA' - :: (forall x. MarloweT (ReaderT (Services IO) IO) x -> MarloweT (ReaderT (Services IO) IO) x) - -> MarloweT - (ReaderT (Services IO) IO) - ( GeneralAllocated - (MarloweT (ReaderT (Services IO) IO)) - (WithException (MarloweT (ReaderT (Services IO) IO))) - releaseReturn - b - a - ) + :: (forall x. MarloweT IO x -> MarloweT IO x) + -> MarloweT IO (GeneralAllocated (MarloweT IO) (WithException (MarloweT IO)) releaseReturn b a) allocA' restore = runClient (allocA restore') <&> \case GeneralAllocated a releaseA -> GeneralAllocated a $ runClient . releaseA