{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
module Boots.Endpoint.Health(
endpointHealth
) where
import Boots
import Boots.Endpoint.Class
import Boots.Factory.Web
import Data.Aeson
import Servant
type EndpointHealth = "health" :> Get '[JSON] Health
instance ToJSON HealthStatus
instance ToJSON Health where
toJSON = genericToJSON defaultOptions
{ omitNothingFields = True }
instance ToSchema HealthStatus
instance ToSchema Health
endpointHealth
:: (HasWeb context env, MonadMask n, MonadIO n)
=> Proxy context
-> Factory n (WebEnv env context) ()
endpointHealth pc = do
health <- asksEnv (view askHealth)
registerEndpoint "health" pc (Proxy @EndpointHealth) $ liftIO $ do
h@Health{..} <- health
if status == UP then return h else throwM err400 { errBody = encode h }