{-# LANGUAGE FlexibleContexts #-}

module Prod.App (
    app,
    appWithContext,
    initialize,
    Init,
    Runtime (..),
    alwaysReadyRuntime,
)
where

import Data.Aeson (ToJSON)
import Data.Proxy (Proxy (..))
import Prod.Health
import Prod.Prometheus
import Prod.Status
import Servant
import Servant.Server

-- | Run a full API, with raw-serving.
type AppApi status api =
    HealthApi
        :<|> StatusApi status
        :<|> PrometheusApi
        :<|> api
        :<|> Raw

-- | Opaque proof of initialization.
data Init = Init Runtime

-- | Initializes internal data.
initialize :: Runtime -> IO Init
initialize :: Runtime -> IO Init
initialize Runtime
runtime =
    IO GHCMetrics
initPrometheus IO GHCMetrics -> IO Init -> IO Init
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Init -> IO Init
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Runtime -> Init
Init Runtime
runtime)

-- | Application.
app ::
    ( HasServer api '[]
    , ToJSON status
    ) =>
    Init ->
    IO status ->
    RenderStatus status ->
    Server api ->
    Proxy api ->
    Application
app :: forall api status.
(HasServer api '[], ToJSON status) =>
Init
-> IO status
-> RenderStatus status
-> Server api
-> Proxy api
-> Application
app (Init Runtime
runtime) IO status
getStatus RenderStatus status
renderStatus Server api
appHandler Proxy api
proxy0 =
    Proxy (AppApi status api)
-> Server (AppApi status api) -> Application
forall api.
HasServer api '[] =>
Proxy api -> Server api -> Application
serve
        (Proxy api -> Proxy (AppApi status api)
forall y status. Proxy y -> Proxy (AppApi status y)
proxy Proxy api
proxy0)
        ( Runtime
-> Server (GetLivenessApi :<|> (GetReadinessApi :<|> DrainApi))
handleHealth Runtime
runtime
            (Handler Liveness :<|> (Handler Readiness :<|> Handler Readiness))
-> (Handler (Status status)
    :<|> (Handler
            (Headers
               '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
               PrometheusResult)
          :<|> (Server api :<|> Tagged Handler Application)))
-> (Handler Liveness
    :<|> (Handler Readiness :<|> Handler Readiness))
   :<|> (Handler (Status status)
         :<|> (Handler
                 (Headers
                    '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
                    PrometheusResult)
               :<|> (Server api :<|> Tagged Handler Application)))
forall a b. a -> b -> a :<|> b
:<|> Runtime
-> IO status -> RenderStatus status -> Handler (Status status)
forall a. Runtime -> IO a -> RenderStatus a -> Handler (Status a)
handleStatus Runtime
runtime IO status
getStatus RenderStatus status
renderStatus
            Handler (Status status)
-> (Handler
      (Headers
         '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
         PrometheusResult)
    :<|> (Server api :<|> Tagged Handler Application))
-> Handler (Status status)
   :<|> (Handler
           (Headers
              '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
              PrometheusResult)
         :<|> (Server api :<|> Tagged Handler Application))
forall a b. a -> b -> a :<|> b
:<|> CORSAllowOrigin -> Server PrometheusApi
handlePrometheus (Text -> CORSAllowOrigin
CORSAllowOrigin Text
"*")
            Handler
  (Headers
     '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
     PrometheusResult)
-> (Server api :<|> Tagged Handler Application)
-> Handler
     (Headers
        '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
        PrometheusResult)
   :<|> (Server api :<|> Tagged Handler Application)
forall a b. a -> b -> a :<|> b
:<|> Server api
appHandler
            Server api
-> Tagged Handler Application
-> Server api :<|> Tagged Handler Application
forall a b. a -> b -> a :<|> b
:<|> FilePath -> ServerT Raw Handler
forall (m :: * -> *). FilePath -> ServerT Raw m
serveDirectoryFileServer FilePath
"www"
        )
  where
    proxy :: Proxy y -> Proxy (AppApi status y)
    proxy :: forall y status. Proxy y -> Proxy (AppApi status y)
proxy Proxy y
_ = Proxy (AppApi status y)
forall {k} (t :: k). Proxy t
Proxy

-- | Application.
appWithContext ::
    ( HasServer api context
    , HasContextEntry (context .++ DefaultErrorFormatters) ErrorFormatters
    , ToJSON status
    ) =>
    Init ->
    IO status ->
    RenderStatus status ->
    Server api ->
    Proxy api ->
    Context context ->
    Application
appWithContext :: forall api (context :: [*]) status.
(HasServer api context,
 HasContextEntry
   (context .++ DefaultErrorFormatters) ErrorFormatters,
 ToJSON status) =>
Init
-> IO status
-> RenderStatus status
-> Server api
-> Proxy api
-> Context context
-> Application
appWithContext (Init Runtime
runtime) IO status
getStatus RenderStatus status
renderStatus Server api
appHandler Proxy api
proxy0 Context context
context =
    Proxy (AppApi status api)
-> Context context -> Server (AppApi status api) -> Application
forall api (context :: [*]).
(HasServer api context, ServerContext context) =>
Proxy api -> Context context -> Server api -> Application
serveWithContext
        (Proxy api -> Proxy (AppApi status api)
forall y status. Proxy y -> Proxy (AppApi status y)
proxy Proxy api
proxy0)
        Context context
context
        ( Runtime
-> Server (GetLivenessApi :<|> (GetReadinessApi :<|> DrainApi))
handleHealth Runtime
runtime
            (Handler Liveness :<|> (Handler Readiness :<|> Handler Readiness))
-> (Handler (Status status)
    :<|> (Handler
            (Headers
               '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
               PrometheusResult)
          :<|> (Server api :<|> Tagged Handler Application)))
-> (Handler Liveness
    :<|> (Handler Readiness :<|> Handler Readiness))
   :<|> (Handler (Status status)
         :<|> (Handler
                 (Headers
                    '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
                    PrometheusResult)
               :<|> (Server api :<|> Tagged Handler Application)))
forall a b. a -> b -> a :<|> b
:<|> Runtime
-> IO status -> RenderStatus status -> Handler (Status status)
forall a. Runtime -> IO a -> RenderStatus a -> Handler (Status a)
handleStatus Runtime
runtime IO status
getStatus RenderStatus status
renderStatus
            Handler (Status status)
-> (Handler
      (Headers
         '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
         PrometheusResult)
    :<|> (Server api :<|> Tagged Handler Application))
-> Handler (Status status)
   :<|> (Handler
           (Headers
              '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
              PrometheusResult)
         :<|> (Server api :<|> Tagged Handler Application))
forall a b. a -> b -> a :<|> b
:<|> CORSAllowOrigin -> Server PrometheusApi
handlePrometheus (Text -> CORSAllowOrigin
CORSAllowOrigin Text
"*")
            Handler
  (Headers
     '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
     PrometheusResult)
-> (Server api :<|> Tagged Handler Application)
-> Handler
     (Headers
        '[Header "Access-Control-Allow-Origin" CORSAllowOrigin]
        PrometheusResult)
   :<|> (Server api :<|> Tagged Handler Application)
forall a b. a -> b -> a :<|> b
:<|> Server api
appHandler
            Server api
-> Tagged Handler Application
-> Server api :<|> Tagged Handler Application
forall a b. a -> b -> a :<|> b
:<|> FilePath -> ServerT Raw Handler
forall (m :: * -> *). FilePath -> ServerT Raw m
serveDirectoryFileServer FilePath
"www"
        )
  where
    proxy :: Proxy x -> Proxy (AppApi status x)
    proxy :: forall y status. Proxy y -> Proxy (AppApi status y)
proxy Proxy x
_ = Proxy (AppApi status x)
forall {k} (t :: k). Proxy t
Proxy