Skip to content

Commit

Permalink
Add endpoint for chaintip query
Browse files Browse the repository at this point in the history
  • Loading branch information
mesudip authored and Sudip Bhattarai committed Feb 20, 2023
1 parent af5f758 commit ead85f8
Show file tree
Hide file tree
Showing 8 changed files with 155 additions and 94 deletions.
2 changes: 2 additions & 0 deletions .ci/Dockerfile
Original file line number Diff line number Diff line change
Expand Up @@ -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 .
Expand All @@ -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
100 changes: 35 additions & 65 deletions playground/package-lock.json

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion playground/package.json
Original file line number Diff line number Diff line change
Expand Up @@ -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"
},
Expand Down
105 changes: 83 additions & 22 deletions server/app/Main.hs
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use newtype instead of data" #-}
{-# LANGUAGE TypeApplications #-}
module Main where


Expand All @@ -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
3 changes: 2 additions & 1 deletion server/kuber-server.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -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
Loading

0 comments on commit ead85f8

Please sign in to comment.