Remove deprecated chain seek options from marlowe-apps

marlowe-apps/marlowe-apps.cabal

@@ -51,7 +51,6 @@ library
     , text
     , time
     , time-units
-    , transformers
     , transformers-base
 
   ghc-options:

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,66 +61,14 @@ 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
         <*> confirmSecondsParser
         <*> 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
 

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)

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

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