From 86280d8c722e66d9b1c6a6dc0b251dd8c5cf3618 Mon Sep 17 00:00:00 2001
From: Jamie Bertram <jamie.bertram@tweag.io>
Date: Wed, 15 Mar 2023 15:55:11 -0400
Subject: [PATCH] Add healthcheck to chain-sync

---
 .../Language/Marlowe/Runtime/ChainSync.hs            | 10 ++++++++++
 marlowe-chain-sync/marlowe-chain-sync/Main.hs        |  6 +++---
 marlowe-chain-sync/marlowe-chain-sync/Options.hs     | 12 ++++++++++++
 3 files changed, 25 insertions(+), 3 deletions(-)

diff --git a/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync.hs b/marlowe-chain-sync/libchainsync/Language/Marlowe/Runtime/ChainSync.hs
index e04db490d5..376d8c0b8f 100644
--- 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
index 56d886b00d..9e4eaeb803 100644
--- 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
index d249c79390..9efa8c82e6 100644
--- 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