{-# LANGUAGE DataKinds #-}

module Hercules.API.Health where

import Servant.API
import Servant.API.Generic

data HealthAPI auth f = HealthAPI
  { HealthAPI auth f
-> f
   :- (Summary "Health check for the database"
       :> ("health" :> ("db" :> Get '[JSON] NoContent)))
db ::
      f
        :- Summary "Health check for the database"
        :> "health"
        :> "db"
        :> Get '[JSON] NoContent,
    HealthAPI auth f
-> f
   :- (Summary "Health check for the queue"
       :> ("health" :> ("queue" :> Get '[JSON] NoContent)))
queue ::
      f
        :- Summary "Health check for the queue"
        :> "health"
        :> "queue"
        :> Get '[JSON] NoContent,
    HealthAPI auth f
-> f
   :- (Summary "Health check for the github"
       :> ("health" :> ("github" :> Get '[JSON] NoContent)))
github ::
      f
        :- Summary "Health check for the github"
        :> "health"
        :> "github"
        :> Get '[JSON] NoContent
  }
  deriving ((forall x. HealthAPI auth f -> Rep (HealthAPI auth f) x)
-> (forall x. Rep (HealthAPI auth f) x -> HealthAPI auth f)
-> Generic (HealthAPI auth f)
forall x. Rep (HealthAPI auth f) x -> HealthAPI auth f
forall x. HealthAPI auth f -> Rep (HealthAPI auth f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall auth f x. Rep (HealthAPI auth f) x -> HealthAPI auth f
forall auth f x. HealthAPI auth f -> Rep (HealthAPI auth f) x
$cto :: forall auth f x. Rep (HealthAPI auth f) x -> HealthAPI auth f
$cfrom :: forall auth f x. HealthAPI auth f -> Rep (HealthAPI auth f) x
Generic)