diff --git a/marlowe-runtime/marlowe-proxy/Main.hs b/marlowe-runtime/marlowe-proxy/Main.hs index 9cebed1db2..f3fa1e70e8 100644 --- a/marlowe-runtime/marlowe-proxy/Main.hs +++ b/marlowe-runtime/marlowe-proxy/Main.hs @@ -81,6 +81,7 @@ run = runComponent_ proc Options{..} -> do , connectionSource = SomeConnectionSource $ logConnectionSource (hoistEventBackend liftIO $ narrowEventBackend (injectSelector MarloweServer) eventBackend) $ handshakeConnectionSource connectionSource + , httpPort = fromIntegral httpPort } driverFactory @@ -107,6 +108,7 @@ data Options = Options , txHost :: HostName , txPort :: PortNumber , logConfigFile :: Maybe FilePath + , httpPort :: PortNumber } getOptions :: IO Options @@ -129,6 +131,7 @@ getOptions = do <*> txHostParser <*> txPortParser <*> logConfigFileParser + <*> httpPortParser ) ) infoMod @@ -157,6 +160,14 @@ getOptions = do , help "The logging configuration JSON file." ] + httpPortParser = option auto $ mconcat + [ long "http-port" + , metavar "PORT_NUMBER" + , help "Port number to serve the http healthcheck API on" + , value 8080 + , showDefault + ] + infoMod = mconcat [ fullDesc , progDesc "API proxy service for Marlowe Runtime" diff --git a/marlowe-runtime/proxy/Language/Marlowe/Runtime/Proxy.hs b/marlowe-runtime/proxy/Language/Marlowe/Runtime/Proxy.hs index 8772f944bd..e77b02777a 100644 --- a/marlowe-runtime/proxy/Language/Marlowe/Runtime/Proxy.hs +++ b/marlowe-runtime/proxy/Language/Marlowe/Runtime/Proxy.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE Arrows #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE ExistentialQuantification #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -7,6 +8,7 @@ module Language.Marlowe.Runtime.Proxy where import Control.Concurrent.Component +import Control.Concurrent.Component.Probes import Control.Monad.Base (MonadBase(..)) import Control.Monad.Catch (MonadCatch, MonadMask, MonadThrow) import Control.Monad.IO.Class (MonadIO, liftIO) @@ -54,12 +56,22 @@ data ProxyDependencies = forall dState. ProxyDependencies , getMarloweQueryDriver :: ServerM (Driver (Handshake MarloweQuery) dState ServerM) , getTxJobDriver :: ServerM (Driver (Handshake (Job MarloweTxCommand)) dState ServerM) , connectionSource :: SomeConnectionSource MarloweServer ServerM + , httpPort :: Int } proxy :: Component IO ProxyDependencies () -proxy = serverComponent (component_ worker) \ProxyDependencies{..} -> do - connector <- runResourceT $ runWrappedUnliftIO $ acceptSomeConnector connectionSource - pure WorkerDependencies{..} +proxy = proc deps -> do + (serverComponent (component_ worker) \ProxyDependencies{..} -> do + connector <- runResourceT $ runWrappedUnliftIO $ acceptSomeConnector connectionSource + pure WorkerDependencies{..}) -< deps + probeServer -< ProbeServerDependencies + { probes = Probes + { startup = pure True + , liveness = pure True + , readiness = pure True + } + , port = httpPort deps + } data WorkerDependencies = forall dState. WorkerDependencies { getMarloweSyncDriver :: ServerM (Driver (Handshake MarloweSync) dState ServerM)