Add endpoint for chaintip query

Author: mesudip

.ci/Dockerfile

@@ -19,6 +19,7 @@ RUN bash -e /merge-root /layer1 \
 
 FROM node:16 as ui-layer
 WORKDIR /app
+ENV NODE_OPTIONS=--max_old_space_size=6144 
 COPY ./playground/package.json ./playground/package-lock.json ./
 RUN npm ci
 COPY ./playground .
@@ -30,4 +31,5 @@ COPY --from=layer1  / /
 WORKDIR /app
 COPY  --from=ui-layer /app/dist/ .
 EXPOSE 8081
+HEALTHCHECK --interval=40s --timeout=10s --start-period=30s --retries=2 CMD [ "/bin/kuber" , "--healthcheck" ]
 ENTRYPOINT  /bin/kuber

playground/package-lock.json

@@ -4,7 +4,7 @@
   "scripts": {
     "start": "vite --host=0.0.0.0",
     "dev": "vite",
-    "build": "vue-tsc --noEmit && vite build",
+    "build": "vite build",
     "preview": "vite preview --port 5050",
     "typecheck": "vue-tsc --noEmit"
   },

playground/package.json

@@ -1,6 +1,7 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# HLINT ignore "Use newtype instead of data" #-}
+{-# LANGUAGE TypeApplications #-}
 module Main where
 
 
@@ -12,31 +13,91 @@ import Cardano.Kuber.Util (timestampToSlot)
 import Data.Text (stripStart)
 import Data.Data (Data)
 import Data.Typeable (Typeable)
-import System.Console.CmdArgs
 import Text.Read (readMaybe)
 import Data.String (IsString(..))
 import System.IO
+import qualified Data.ByteString.Lazy.Char8 as L8
+import Network.HTTP.Simple (httpLBS, HttpException (HttpExceptionRequest))
+import Network.HTTP.Client.Conduit (Response(responseStatus, responseBody), HttpException (HttpExceptionRequest, InvalidUrlException), Request (requestBody))
+import System.Exit (exitFailure)
+import Network.HTTP.Types (status200)
+import Control.Exception (try, catch)
+import Data.Function ((&))
 
+
+import Options.Applicative
+import Data.Semigroup ((<>))
+
+data KuberConfig = KuberConfig
+  { host  :: Maybe String
+  , port  :: Int
+  , healthCheckUrl :: String
+  , healthCheck :: Bool 
+  }
+
+sample :: Parser KuberConfig
+sample = KuberConfig
+      <$> option auto(     
+            long "host"
+        <>  short 'H'
+        <>  metavar "IP-Address"
+        <>  help "IP Address to bind to"
+        <>  showDefaultWith (const "Listen on all available intefaces")
+        <>  value Nothing
+      )
+      <*> option auto
+          ( long "port"
+         <>   short 'p'
+         <>   help "Port to listen on"
+         <>   showDefault 
+         <>   value 8081)
+      <*>  option auto
+          ( long "url"
+         <> help "Url for  health-check operation"
+         <> showDefaultWith (const "http://127.0.0.1:8081/api/v1/chaintip")
+         <> value "http://127.0.0.1:8081/api/v1/chaintip"
+         <> metavar "URL" )
+      <*> switch  (
+        long "healthcheck"
+        <> help "Perform health-check request on kuber server"
+      )
+
+opts = info (sample <**> helper)
+  ( fullDesc
+  <> progDesc "Kuber Server"
+  )
 main :: IO ()
 main = do
-  hSetBuffering stdout LineBuffering
-  dcinfo <- chainInfoFromEnv >>= withDetails
-  Modes port hostStr <- cmdArgs $ modes [
-        Modes {
-          port = 8081 &= typ "Port",
-          host = "*" &=typ "Host"
-        }
-      ]&=program "kuber"
-
-  let settings = setPort port defaultSettings
-      host = setHost (fromString hostStr) settings
-  putStrLn $ "Starting server on port " ++ show port ++"..."
-  runSettings host $ app dcinfo
-  run port $ app dcinfo
-
-data Modes =
-      Modes {
-        port:: Int,
-        host :: String
-      }
-       deriving (Show, Data, Typeable)
+  KuberConfig hostStr port healthCheckUrl doHealthCheck <- execParser  opts
+
+  if  doHealthCheck 
+    then 
+     performRequest healthCheckUrl
+
+    else do 
+      dcinfo <- chainInfoFromEnv >>= withDetails
+
+      let settings = setPort port defaultSettings
+      let settings2  = (case hostStr of
+            Nothing -> settings
+            Just s -> setHost (fromString s) settings  ) 
+      putStrLn $ "Starting server on port " ++ show port ++"..."
+      runSettings settings2 $ app dcinfo
+      run port $ app dcinfo
+
+performRequest :: String -> IO ()
+performRequest  url = do
+  res <- catch  (httpLBS (fromString url))  exceptionHandler
+  if  responseStatus res /=  status200
+    then do
+      putStr $  "Response " ++ show (responseStatus res) ++" : "
+      L8.putStr  $ responseBody res
+      exitFailure
+    else L8.putStr  $ responseBody res
+  where
+    exceptionHandler :: HttpException -> IO a
+    exceptionHandler ex = do
+      case ex of
+        HttpExceptionRequest re hec -> putStr  (url ++": " ++  show hec)
+        InvalidUrlException s str -> putStr  $  str ++ ": " ++ s
+      exitFailure

server/app/Main.hs

@@ -97,8 +97,9 @@ executable kuber
     , cborg
     , http-types
     , http-media
+    , http-conduit
     , wai-cors
     , cardano-binary
     , cardano-ledger-core
     , kuber-server
-    , cmdargs >= 0.10.18
+    , optparse-applicative