Add healthcheck to chain-sync

input-output-hk · Mar 16, 2023 · 86280d8 · 86280d8
1 parent dbd241b
commit 86280d8
Show file tree

Hide file tree

Showing 3 changed files with 25 additions and 3 deletions.
diff --git a/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync.hs b/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync.hs
@@ -14,6 +14,7 @@ import Cardano.Api (CardanoEra, CardanoMode, Tx, TxValidationErrorInMode)
 import qualified Cardano.Api as Cardano
 import Cardano.Api.Shelley (AcquiringFailure)
 import Control.Concurrent.Component
+import Control.Concurrent.Component.Probes
 import Language.Marlowe.Runtime.ChainSync.Api (ChainSyncCommand, ChainSyncQuery, RuntimeChainSeekServer)
 import Language.Marlowe.Runtime.ChainSync.Database (DatabaseQueries(..))
 import Language.Marlowe.Runtime.ChainSync.JobServer (ChainSyncJobServerDependencies(..), chainSyncJobServer)
@@ -39,6 +40,7 @@ data ChainSyncDependencies r = ChainSyncDependencies
        . CardanoEra era
       -> Tx era
       -> IO (SubmitResult (TxValidationErrorInMode CardanoMode))
+  , httpPort :: Int
   }
 
 chainSync :: Component IO (ChainSyncDependencies r) ()
@@ -47,3 +49,11 @@ chainSync = proc ChainSyncDependencies{..} -> do
   chainSyncServer -< ChainSyncServerDependencies{..}
   chainSyncQueryServer -< ChainSyncQueryServerDependencies{..}
   chainSyncJobServer -< ChainSyncJobServerDependencies{..}
+  probeServer -< ProbeServerDependencies
+    { probes = Probes
+        { startup = pure True
+        , liveness = pure True
+        , readiness = pure True
+        }
+    , port = httpPort
+    }
diff --git a/marlowe-chain-sync/marlowe-chain-sync/Main.hs b/marlowe-chain-sync/marlowe-chain-sync/Main.hs
@@ -44,7 +44,7 @@ main :: IO ()
 main = run =<< getOptions "0.0.0.0"
 
 run :: Options -> IO ()
-run Options{..} = bracket (Pool.acquire 100 (Just $ 5000000) (fromString databaseUri)) Pool.release $
+run Options{..} = bracket (Pool.acquire 100 (Just 5000000) (fromString databaseUri)) Pool.release $
   runComponent_ proc pool -> do
     eventBackend <- logger -< LoggerDependencies
       { configFilePath = logConfigFile
@@ -73,8 +73,7 @@ run Options{..} = bracket (Pool.acquire 100 (Just $ 5000000) (fromString databas
       }
 
     NodeClient{..} <- nodeClient -< NodeClientDependencies
-      {
-        connectToLocalNode = Cardano.connectToLocalNode localNodeConnectInfo
+      { connectToLocalNode = Cardano.connectToLocalNode localNodeConnectInfo
       , eventBackend = narrowEventBackend (injectSelector NodeService) eventBackend
       }
 
@@ -99,6 +98,7 @@ run Options{..} = bracket (Pool.acquire 100 (Just $ 5000000) (fromString databas
           MaryEra -> MaryEraInCardanoMode
           AlonzoEra -> AlonzoEraInCardanoMode
           BabbageEra -> BabbageEraInCardanoMode
+      , httpPort = fromIntegral httpPort
       }
   where
     throwUsageError (ConnectionUsageError err)                       = error $ show err

diff --git a/marlowe-chain-sync/marlowe-chain-sync/Options.hs b/marlowe-chain-sync/marlowe-chain-sync/Options.hs
@@ -19,6 +19,7 @@ data Options = Options
   , queryPort         :: !PortNumber
   , commandPort       :: !PortNumber
   , logConfigFile     :: !(Maybe FilePath)
+  , httpPort :: !PortNumber
   } deriving (Show, Eq)
 
 getOptions :: String -> IO Options
@@ -97,6 +98,7 @@ parseOptions defaultNetworkId defaultSocketPath defaultDatabaseUri defaultHost d
               <*> queryPortOption
               <*> jobPortOption
               <*> logConfigFileParser
+              <*> httpPortOption
           )
       where
         versionOption :: O.Parser (a -> a)
@@ -190,6 +192,16 @@ parseOptions defaultNetworkId defaultSocketPath defaultDatabaseUri defaultHost d
               , O.help "Path to the log configuration JSON file."
               ]
 
+        httpPortOption :: O.Parser PortNumber
+        httpPortOption = O.option O.auto $ mconcat
+          [ O.long "http-port"
+          , defaultPort
+          , O.metavar "PORT_NUMBER"
+          , O.help "Port number to serve the http healthcheck API on"
+          , O.value 8080
+          , O.showDefault
+          ]
+
     infoMod :: O.InfoMod Options
     infoMod = mconcat
       [ O.fullDesc