{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TupleSections     #-}
{-# LANGUAGE TypeApplications  #-}
{-# LANGUAGE TypeOperators     #-}

module Boots.Endpoint.Health 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

-- | Register health endpoint.
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 }