Add healthcheck to marlowe-proxy

input-output-hk · Mar 16, 2023 · 7cc80dc · 7cc80dc
1 parent 49c9028
commit 7cc80dc
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 3 deletions.
diff --git 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
@@ -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)