{-# LANGUAGE PolyKinds #-}

-- | Allows to enable logging of requests and responses.
module Servant.Util.Combinators.Logging
    ( -- * Automatic requests logging
      LoggingApi
    , LoggingApiRec
    , LoggingMod
    , LoggingLevel
    , LoggingRequestsEnabled
    , LoggingRequestsDisabled
    , LoggingResponsesEnabled
    , LoggingResponsesDisabled
    , LoggingDisabled
    , LogContext (..)
    , HasLoggingServer (..)
    , ServantLogConfig (..)
    , ForResponseLog (..)
    , BuildableForResponseIfNecessary
    , buildListForResponse
    , buildForResponse
    , ApiHasArgClass (..)
    , ApiCanLogArg (..)
    , addParamLogInfo
    , setInPrefix
    , serverWithLogging
    ) where

import Universum

import Control.Monad.Error.Class (catchError, throwError)
import Data.Constraint (Dict (..))
import Data.Default (Default (..))
import Data.Reflection (Reifies (..), reify)
import Data.Swagger (Swagger)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Fmt (Buildable (..), Builder, blockListF, pretty, (+|), (|+), (||+))
import GHC.IO.Unsafe (unsafePerformIO)
import GHC.TypeLits (KnownSymbol, symbolVal)
import Servant.API (Capture, Description, NoContent, NoContentVerb, QueryFlag, QueryParam', Raw,
                    ReflectMethod (..), ReqBody, SBoolI, Summary, Verb, (:<|>) (..), (:>))
import Servant.API.Modifiers (FoldRequired, foldRequiredArgument)
import Servant.Client (HasClient (..))
import Servant.Server (Handler (..), HasServer (..), Server, ServerError (..))
import Servant.Swagger (HasSwagger (..))
import Servant.Swagger.UI.Core (SwaggerUiHtml)
import System.Console.Pretty (Color (..), Style (..), color, style)

import qualified Data.Text as T
import qualified Servant.Server.Internal as SI

import Servant.Util.Common

-- | Enables logging for server which serves given api.
--
-- `config` is a type at which you have to specify 'ServantLogConfig' via
-- reflection. This way was chosen because the least thing we need in
-- config is 'LoggerName', and we want to have '<>' on 'LoggerName's thus
-- 'KnownSymbol' is not enough.
--
-- This logging will report
--
-- * Request parameters, including request bodies
-- * If execution failed with error, it will be displayed
-- * Details like request method and endpoint execution time
--
-- If user makes request which is not defined it won't be logged. However,
-- I don't find it a great problem, it may impede only in development or on
-- getting acknowledged with api.
data LoggingApi config api

-- | Helper to traverse servant api and apply logging.
data LoggingApiRec config (lcontext :: LoggingContext) api

-- | Logging context at type-level, accumulates all the 'LoggingMod' modifiers.
data LoggingContext = LoggingContext
  (Maybe Nat)  -- ^ Recommended logging level.
  Bool  -- ^ Whether requests are logged.
  Bool  -- ^ Whether responses are logged.

type family EmptyLoggingContext :: LoggingContext where
  EmptyLoggingContext = 'LoggingContext 'Nothing 'True 'True

type family LcResponsesEnabled (lcontext :: LoggingContext) :: Bool where
  LcResponsesEnabled ('LoggingContext _ _ flag) = flag

-- | Require 'Buildable' for the response type, but only if logging context
-- assumes that the response will indeed be built.
type BuildableForResponseIfNecessary lcontext resp =
  ( If (LcResponsesEnabled lcontext)
      (Buildable (ForResponseLog resp))
      (() :: Constraint)
  , Demote (LcResponsesEnabled lcontext)
  )

-- | Servant combinator that changes how the logs will be printed for the
-- affected endpoints.
--
-- This is an internal thing, we export aliases.
data LoggingMod (mod :: LoggingModKind)

-- | How to change the logging of the endpoints.
data LoggingModKind
  = LMLoggingLevel Nat
  | LMRequestsLogged Bool
  | LMResponsesLogged Bool
  | LMLoggingDisabled

-- | Combinator to set the logging level within the endpoints.
type LoggingLevel lvl = LoggingMod ('LMLoggingLevel lvl)

-- | Combinator to disable logging of requests.
type LoggingRequestsDisabled = LoggingMod ('LMRequestsLogged 'False)

-- | Combinator to enable logging of requests back for a narrower
-- set of entrypoints.
type LoggingRequestsEnabled = LoggingMod ('LMRequestsLogged 'True)

-- | Combinator to disable logging of responses.
type LoggingResponsesDisabled = LoggingMod ('LMResponsesLogged 'False)

-- | Combinator to enable logging of responses.
type LoggingResponsesEnabled = LoggingMod ('LMResponsesLogged 'True)

-- | Combinator to disable all the logging.
--
-- This works similarly to other similar combinators and can be partially
-- or fully reverted with 'LoggingRequestsDisabled' or 'LoggingResponsesDisabled'.
type LoggingDisabled = LoggingMod 'LMLoggingDisabled

-- | Full context of the logging action.
data LogFullContext = LogFullContext
  { LogFullContext -> Maybe Natural
lcRecommendedLevel :: Maybe Natural
    -- ^ Logging level specified by 'LoggingLevel' combinator.
    -- Will be provided to the user.
  , LogFullContext -> Bool
lcRequestsEnabled  :: Bool
    -- ^ Whether to log requests.
    -- Accounted automatically.
  , LogFullContext -> Bool
lcResponsesEnabled :: Bool
    -- ^ Whether to log responses.
    -- Accounted automatically.
  } deriving (Int -> LogFullContext -> ShowS
[LogFullContext] -> ShowS
LogFullContext -> String
(Int -> LogFullContext -> ShowS)
-> (LogFullContext -> String)
-> ([LogFullContext] -> ShowS)
-> Show LogFullContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogFullContext] -> ShowS
$cshowList :: [LogFullContext] -> ShowS
show :: LogFullContext -> String
$cshow :: LogFullContext -> String
showsPrec :: Int -> LogFullContext -> ShowS
$cshowsPrec :: Int -> LogFullContext -> ShowS
Show)

type instance Demoted LoggingContext = LogFullContext
instance ( ctx ~ 'LoggingContext lvl req resp
         , Demote lvl
         , Demote req
         , Demote resp
         ) => Demote ctx where
  demote :: Proxy ctx -> Demoted LoggingContext
demote Proxy ctx
_ = LogFullContext :: Maybe Natural -> Bool -> Bool -> LogFullContext
LogFullContext
    { lcRecommendedLevel :: Maybe Natural
lcRecommendedLevel = Proxy lvl -> Demoted (Maybe Nat)
forall k (ty :: k). Demote ty => Proxy ty -> Demoted k
demote (Proxy lvl
forall k (t :: k). Proxy t
Proxy @lvl)
    , lcRequestsEnabled :: Bool
lcRequestsEnabled = Proxy req -> Demoted Bool
forall k (ty :: k). Demote ty => Proxy ty -> Demoted k
demote (Proxy req
forall k (t :: k). Proxy t
Proxy @req)
    , lcResponsesEnabled :: Bool
lcResponsesEnabled = Proxy resp -> Demoted Bool
forall k (ty :: k). Demote ty => Proxy ty -> Demoted k
demote (Proxy resp
forall k (t :: k). Proxy t
Proxy @resp)
    }

type family ApplyLoggingMod (lcontext :: LoggingContext) (mod :: LoggingModKind) where
  ApplyLoggingMod ('LoggingContext _ req resp) ('LMLoggingLevel lvl) =
    'LoggingContext ('Just lvl) req resp
  ApplyLoggingMod ('LoggingContext mlvl _ resp) ('LMRequestsLogged req) =
    'LoggingContext mlvl req resp
  ApplyLoggingMod ('LoggingContext mlvl req _) ('LMResponsesLogged resp) =
    'LoggingContext mlvl req resp
  ApplyLoggingMod ('LoggingContext mlvl _ _) 'LMLoggingDisabled =
    'LoggingContext mlvl 'False 'False

-- | Logging context that will be supplied to the user.
newtype LogContext = LogContext
  { LogContext -> Maybe Natural
lecRecommendedLevel :: Maybe Natural
    -- ^ Logging level specified by 'LoggingLevel' combinator.
  } deriving (Int -> LogContext -> ShowS
[LogContext] -> ShowS
LogContext -> String
(Int -> LogContext -> ShowS)
-> (LogContext -> String)
-> ([LogContext] -> ShowS)
-> Show LogContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogContext] -> ShowS
$cshowList :: [LogContext] -> ShowS
show :: LogContext -> String
$cshow :: LogContext -> String
showsPrec :: Int -> LogContext -> ShowS
$cshowsPrec :: Int -> LogContext -> ShowS
Show, LogContext -> LogContext -> Bool
(LogContext -> LogContext -> Bool)
-> (LogContext -> LogContext -> Bool) -> Eq LogContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LogContext -> LogContext -> Bool
$c/= :: LogContext -> LogContext -> Bool
== :: LogContext -> LogContext -> Bool
$c== :: LogContext -> LogContext -> Bool
Eq)

-- | Logging configuration specified at server start.
newtype ServantLogConfig = ServantLogConfig
    { ServantLogConfig -> LogContext -> Text -> IO ()
clcLog :: LogContext -> Text -> IO ()
    }

dullColor :: Color -> Text -> Text
dullColor :: Color -> Text -> Text
dullColor Color
c = Style -> Text -> Text
forall a. Pretty a => Style -> a -> a
style Style
Faint (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color -> Text -> Text
forall a. Pretty a => Color -> a -> a
color Color
c

gray :: Text -> Text
gray :: Text -> Text
gray = Color -> Text -> Text
dullColor Color
White

-- | Used to incrementally collect info about passed parameters.
data ApiParamsLogInfo
      -- | Parameters gathered at current stage.
      -- The first field tells whether have we met '(:<|>)',
      -- the second is path prefix itself,
      -- the third field is the remaining part.
    = ApiParamsLogInfo Bool [Text] [Text]
      -- | Parameters collection failed with reason
      --   (e.g. decoding error)
    | ApiNoParamsLogInfo Text

instance Default ApiParamsLogInfo where
    def :: ApiParamsLogInfo
def = Bool -> [Text] -> [Text] -> ApiParamsLogInfo
ApiParamsLogInfo Bool
False [] []

addParamLogInfo :: Text -> ApiParamsLogInfo -> ApiParamsLogInfo
addParamLogInfo :: Text -> ApiParamsLogInfo -> ApiParamsLogInfo
addParamLogInfo Text
_ failed :: ApiParamsLogInfo
failed@ApiNoParamsLogInfo{} = ApiParamsLogInfo
failed
addParamLogInfo Text
paramInfo (ApiParamsLogInfo Bool
False [Text]
path []) =
    Bool -> [Text] -> [Text] -> ApiParamsLogInfo
ApiParamsLogInfo Bool
False (Text
paramInfo Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
path) []
addParamLogInfo Text
paramInfo (ApiParamsLogInfo Bool
inPrefix [Text]
path [Text]
infos) =
    Bool -> [Text] -> [Text] -> ApiParamsLogInfo
ApiParamsLogInfo Bool
inPrefix [Text]
path (Text
paramInfo Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
infos)

setInPrefix :: ApiParamsLogInfo -> ApiParamsLogInfo
setInPrefix :: ApiParamsLogInfo -> ApiParamsLogInfo
setInPrefix failed :: ApiParamsLogInfo
failed@ApiNoParamsLogInfo{}     = ApiParamsLogInfo
failed
setInPrefix infos :: ApiParamsLogInfo
infos@(ApiParamsLogInfo Bool
_ [] [Text]
_) = ApiParamsLogInfo
infos
setInPrefix (ApiParamsLogInfo Bool
_ [Text]
path [Text]
info)  = Bool -> [Text] -> [Text] -> ApiParamsLogInfo
ApiParamsLogInfo Bool
True [Text]
path [Text]
info

-- | When it comes to logging responses, returned data may be very large.
-- Log space is valuable (already in testnet we got truncated logs),
-- so we have to care about printing only whose data which may be useful.
newtype ForResponseLog a = ForResponseLog { ForResponseLog a -> a
unForResponseLog :: a }

buildListForResponse
    :: Buildable (ForResponseLog x)
    => (forall a. [a] -> [a]) -> ForResponseLog [x] -> Builder
buildListForResponse :: (forall a. [a] -> [a]) -> ForResponseLog [x] -> Builder
buildListForResponse forall a. [a] -> [a]
truncList (ForResponseLog [x]
l) =
    let startNf :: Builder
startNf = if [x] -> Bool
forall t. Container t => t -> Bool
null [x]
l then Builder
"" else Builder
"\n"
        lt :: [x]
lt = [x] -> [x]
forall a. [a] -> [a]
truncList [x]
l
        diff :: Int
diff = [x] -> Int
forall t. Container t => t -> Int
length [x]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
- [x] -> Int
forall t. Container t => t -> Int
length [x]
lt
        mMore :: Builder
mMore | Int
diff Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = Builder
""
              | Bool
otherwise = Builder
"\n    and " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Int
diff Int -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" entries more..."
    in  Builder
startNf Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| [ForResponseLog x] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
blockListF ((x -> ForResponseLog x) -> [x] -> [ForResponseLog x]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map x -> ForResponseLog x
forall a. a -> ForResponseLog a
ForResponseLog [x]
lt) Builder -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
mMore

buildForResponse :: Buildable a => ForResponseLog a -> Builder
buildForResponse :: ForResponseLog a -> Builder
buildForResponse = a -> Builder
forall p. Buildable p => p -> Builder
build (a -> Builder)
-> (ForResponseLog a -> a) -> ForResponseLog a -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForResponseLog a -> a
forall a. ForResponseLog a -> a
unForResponseLog

instance ( HasServer (LoggingApiRec config EmptyLoggingContext api) ctx
         , HasServer api ctx
         ) =>
         HasServer (LoggingApi config api) ctx where
    type ServerT (LoggingApi config api) m = ServerT api m

    route :: Proxy (LoggingApi config api)
-> Context ctx
-> Delayed env (Server (LoggingApi config api))
-> Router env
route = (Proxy (LoggingApiRec config EmptyLoggingContext api)
 -> Context ctx
 -> Delayed
      env (Server (LoggingApiRec config EmptyLoggingContext api))
 -> Router env)
-> (Server (LoggingApi config api)
    -> Server (LoggingApiRec config EmptyLoggingContext api))
-> Proxy (LoggingApi config api)
-> Context ctx
-> Delayed env (Server (LoggingApi config api))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(LoggingApiRec config EmptyLoggingContext api) Proxy (LoggingApiRec config EmptyLoggingContext api)
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config EmptyLoggingContext api))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route
            (ApiParamsLogInfo
forall a. Default a => a
def, )

    hoistServerWithContext :: Proxy (LoggingApi config api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (LoggingApi config api) m
-> ServerT (LoggingApi config api) n
hoistServerWithContext Proxy (LoggingApi config api)
_ = Proxy api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api)

-- | Version of 'HasServer' which is assumed to perform logging.
-- It's helpful because 'ServerT (LoggingApi ...)' is already defined for us
-- in actual 'HasServer' instance once and forever.
class HasServer api ctx => HasLoggingServer config (lcontext :: LoggingContext) api ctx where
    routeWithLog
        :: Proxy (LoggingApiRec config lcontext api)
        -> SI.Context ctx
        -> SI.Delayed env (Server (LoggingApiRec config lcontext api))
        -> SI.Router env

instance HasLoggingServer config lcontext api ctx =>
         HasServer (LoggingApiRec config lcontext api) ctx where
    type ServerT (LoggingApiRec config lcontext api) m =
         (ApiParamsLogInfo, ServerT api m)

    route :: Proxy (LoggingApiRec config lcontext api)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext api))
-> Router env
route = Proxy (LoggingApiRec config lcontext api)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext api))
-> Router env
forall k k (config :: k) (lcontext :: LoggingContext) (api :: k)
       (ctx :: [*]) env.
HasLoggingServer config lcontext api ctx =>
Proxy (LoggingApiRec config lcontext api)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext api))
-> Router env
routeWithLog

    hoistServerWithContext :: Proxy (LoggingApiRec config lcontext api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (LoggingApiRec config lcontext api) m
-> ServerT (LoggingApiRec config lcontext api) n
hoistServerWithContext Proxy (LoggingApiRec config lcontext api)
_ Proxy ctx
pc forall x. m x -> n x
nt ServerT (LoggingApiRec config lcontext api) m
s =
        Proxy api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy api
forall k (t :: k). Proxy t
Proxy :: Proxy api) Proxy ctx
pc forall x. m x -> n x
nt (ServerT api m -> ServerT api n)
-> (ApiParamsLogInfo, ServerT api m)
-> (ApiParamsLogInfo, ServerT api n)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ApiParamsLogInfo, ServerT api m)
ServerT (LoggingApiRec config lcontext api) m
s

instance ( HasLoggingServer config lcontext api1 ctx
         , HasLoggingServer config lcontext api2 ctx
         ) =>
         HasLoggingServer config lcontext (api1 :<|> api2) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (api1 :<|> api2))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (api1 :<|> api2)))
-> Router env
routeWithLog =
        (Proxy
   (LoggingApiRec config lcontext api1
    :<|> LoggingApiRec config lcontext api2)
 -> Context ctx
 -> Delayed
      env
      (Server
         (LoggingApiRec config lcontext api1
          :<|> LoggingApiRec config lcontext api2))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (api1 :<|> api2))
    -> Server
         (LoggingApiRec config lcontext api1
          :<|> LoggingApiRec config lcontext api2))
-> Proxy (LoggingApiRec config lcontext (api1 :<|> api2))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (api1 :<|> api2)))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer
            @(LoggingApiRec config lcontext api1 :<|> LoggingApiRec config lcontext api2)
            Proxy
  (LoggingApiRec config lcontext api1
   :<|> LoggingApiRec config lcontext api2)
-> Context ctx
-> Delayed
     env
     (Server
        (LoggingApiRec config lcontext api1
         :<|> LoggingApiRec config lcontext api2))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route ((Server (LoggingApiRec config lcontext (api1 :<|> api2))
  -> Server
       (LoggingApiRec config lcontext api1
        :<|> LoggingApiRec config lcontext api2))
 -> Proxy (LoggingApiRec config lcontext (api1 :<|> api2))
 -> Context ctx
 -> Delayed
      env (Server (LoggingApiRec config lcontext (api1 :<|> api2)))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (api1 :<|> api2))
    -> Server
         (LoggingApiRec config lcontext api1
          :<|> LoggingApiRec config lcontext api2))
-> Proxy (LoggingApiRec config lcontext (api1 :<|> api2))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (api1 :<|> api2)))
-> Router env
forall a b. (a -> b) -> a -> b
$
            \(paramsInfo, f1 :<|> f2) ->
                let paramsInfo' :: ApiParamsLogInfo
paramsInfo' = ApiParamsLogInfo -> ApiParamsLogInfo
setInPrefix ApiParamsLogInfo
paramsInfo
                in (ApiParamsLogInfo
paramsInfo', ServerT api1 Handler
f1) (ApiParamsLogInfo, ServerT api1 Handler)
-> (ApiParamsLogInfo, ServerT api2 Handler)
-> (ApiParamsLogInfo, ServerT api1 Handler)
   :<|> (ApiParamsLogInfo, ServerT api2 Handler)
forall a b. a -> b -> a :<|> b
:<|> (ApiParamsLogInfo
paramsInfo', ServerT api2 Handler
f2)

instance ( KnownSymbol path
         , HasLoggingServer config lcontext res ctx
         ) =>
         HasLoggingServer config lcontext (path :> res) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (path :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (path :> res)))
-> Router env
routeWithLog =
        (Proxy (path :> LoggingApiRec config lcontext res)
 -> Context ctx
 -> Delayed env (Server (path :> LoggingApiRec config lcontext res))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (path :> res))
    -> Server (path :> LoggingApiRec config lcontext res))
-> Proxy (LoggingApiRec config lcontext (path :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (path :> res)))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(path :> LoggingApiRec config lcontext res) Proxy (path :> LoggingApiRec config lcontext res)
-> Context ctx
-> Delayed env (Server (path :> LoggingApiRec config lcontext res))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route ((Server (LoggingApiRec config lcontext (path :> res))
  -> Server (path :> LoggingApiRec config lcontext res))
 -> Proxy (LoggingApiRec config lcontext (path :> res))
 -> Context ctx
 -> Delayed
      env (Server (LoggingApiRec config lcontext (path :> res)))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (path :> res))
    -> Server (path :> LoggingApiRec config lcontext res))
-> Proxy (LoggingApiRec config lcontext (path :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (path :> res)))
-> Router env
forall a b. (a -> b) -> a -> b
$
        (ApiParamsLogInfo -> ApiParamsLogInfo)
-> (ApiParamsLogInfo, ServerT res Handler)
-> (ApiParamsLogInfo, ServerT res Handler)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ApiParamsLogInfo -> ApiParamsLogInfo
updateParamsInfo
      where
        updateParamsInfo :: ApiParamsLogInfo -> ApiParamsLogInfo
updateParamsInfo =
            let path :: Text
path = String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (Proxy path -> String) -> Proxy path -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy path -> String
forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (Proxy path -> Text) -> Proxy path -> Text
forall a b. (a -> b) -> a -> b
$ Proxy path
forall k (t :: k). Proxy t
Proxy @path
            in  Text -> ApiParamsLogInfo -> ApiParamsLogInfo
addParamLogInfo Text
path

-- | Describes a way to log a single parameter.
class ApiHasArgClass subApi =>
      ApiCanLogArg subApi where
    type ApiArgToLog subApi :: Type
    type ApiArgToLog subApi = ApiArg subApi

    toLogParamInfo
        :: Buildable (ApiArgToLog subApi)
        => Proxy subApi -> ApiArg subApi -> Text
    default toLogParamInfo
        :: Buildable (ApiArg subApi)
        => Proxy subApi -> ApiArg subApi -> Text
    toLogParamInfo Proxy subApi
_ ApiArg subApi
param = ApiArg subApi -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty ApiArg subApi
param

instance KnownSymbol s => ApiCanLogArg (Capture s a)

instance ApiCanLogArg (ReqBody ct a)

instance ( Buildable a
         , KnownSymbol cs
         , SBoolI (FoldRequired mods)
         ) =>
         ApiCanLogArg (QueryParam' mods cs a) where
    type ApiArgToLog (QueryParam' mods cs a) = a
    toLogParamInfo :: Proxy (QueryParam' mods cs a)
-> ApiArg (QueryParam' mods cs a) -> Text
toLogParamInfo Proxy (QueryParam' mods cs a)
_ ApiArg (QueryParam' mods cs a)
mparam = Proxy mods
-> (a -> Text)
-> (Maybe a -> Text)
-> RequiredArgument mods a
-> Text
forall (mods :: [*]) a r.
SBoolI (FoldRequired mods) =>
Proxy mods
-> (a -> r) -> (Maybe a -> r) -> RequiredArgument mods a -> r
foldRequiredArgument (Proxy mods
forall k (t :: k). Proxy t
Proxy :: Proxy mods) (\(a
a :: a) -> a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty a
a)
      (\case
        Just a
a  -> a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty a
a
        Maybe a
Nothing -> Text
noEntry) RequiredArgument mods a
ApiArg (QueryParam' mods cs a)
mparam
      where
        noEntry :: Text
noEntry = Text -> Text
gray Text
"-"

instance KnownSymbol cs => ApiCanLogArg (QueryFlag cs) where
    type ApiArgToLog (QueryFlag cs) = Bool

paramRouteWithLog
    :: forall config lcontext api subApi res ctx env.
       ( api ~ (subApi :> res)
       , HasServer (subApi :> LoggingApiRec config lcontext res) ctx
       , ApiHasArg subApi res
       , ApiHasArg subApi (LoggingApiRec config lcontext res)
       , ApiCanLogArg subApi
       , Buildable (ApiArgToLog subApi)
       )
    => Proxy (LoggingApiRec config lcontext api)
    -> SI.Context ctx
    -> SI.Delayed env (Server (LoggingApiRec config lcontext api))
    -> SI.Router env
paramRouteWithLog :: Proxy (LoggingApiRec config lcontext api)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext api))
-> Router env
paramRouteWithLog =
    (Proxy (subApi :> LoggingApiRec config lcontext res)
 -> Context ctx
 -> Delayed
      env (Server (subApi :> LoggingApiRec config lcontext res))
 -> Router env)
-> (Server (LoggingApiRec config lcontext api)
    -> Server (subApi :> LoggingApiRec config lcontext res))
-> Proxy (LoggingApiRec config lcontext api)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext api))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(subApi :> LoggingApiRec config lcontext res) Proxy (subApi :> LoggingApiRec config lcontext res)
-> Context ctx
-> Delayed
     env (Server (subApi :> LoggingApiRec config lcontext res))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route ((Server (LoggingApiRec config lcontext api)
  -> Server (subApi :> LoggingApiRec config lcontext res))
 -> Proxy (LoggingApiRec config lcontext api)
 -> Context ctx
 -> Delayed env (Server (LoggingApiRec config lcontext api))
 -> Router env)
-> (Server (LoggingApiRec config lcontext api)
    -> Server (subApi :> LoggingApiRec config lcontext res))
-> Proxy (LoggingApiRec config lcontext api)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext api))
-> Router env
forall a b. (a -> b) -> a -> b
$
        \(paramsInfo, f) ApiArg subApi
a -> (ApiArg subApi
a ApiArg subApi -> ApiParamsLogInfo -> ApiParamsLogInfo
`updateParamsInfo` ApiParamsLogInfo
paramsInfo, ApiArg subApi -> ServerT res Handler
f ApiArg subApi
a)
  where
    updateParamsInfo :: ApiArg subApi -> ApiParamsLogInfo -> ApiParamsLogInfo
updateParamsInfo ApiArg subApi
a =
        let paramVal :: Text
paramVal = Proxy subApi -> ApiArg subApi -> Text
forall subApi.
(ApiCanLogArg subApi, Buildable (ApiArgToLog subApi)) =>
Proxy subApi -> ApiArg subApi -> Text
toLogParamInfo (Proxy subApi
forall k (t :: k). Proxy t
Proxy @subApi) ApiArg subApi
a
            paramName :: String
paramName = Proxy subApi -> String
forall api. ApiHasArgClass api => Proxy api -> String
apiArgName (Proxy subApi -> String) -> Proxy subApi -> String
forall a b. (a -> b) -> a -> b
$ Proxy subApi
forall k (t :: k). Proxy t
Proxy @subApi
            paramInfo :: Text
paramInfo = String
paramName String -> Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
": " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
paramVal Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
        in Text -> ApiParamsLogInfo -> ApiParamsLogInfo
addParamLogInfo Text
paramInfo (ApiParamsLogInfo -> ApiParamsLogInfo)
-> (ApiParamsLogInfo -> ApiParamsLogInfo)
-> ApiParamsLogInfo
-> ApiParamsLogInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ApiParamsLogInfo -> ApiParamsLogInfo
setInPrefix

instance ( HasServer (subApi :> res) ctx
         , HasServer (subApi :> LoggingApiRec config lcontext res) ctx
         , ApiHasArg subApi res
         , ApiHasArg subApi (LoggingApiRec config lcontext res)
         , ApiCanLogArg subApi
         , Buildable (ApiArgToLog subApi)
         , subApi ~ apiType (a :: Type)
         ) =>
         HasLoggingServer config lcontext (apiType a :> res) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (apiType a :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (apiType a :> res)))
-> Router env
routeWithLog = Proxy (LoggingApiRec config lcontext (apiType a :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (apiType a :> res)))
-> Router env
forall k (config :: k) (lcontext :: LoggingContext) api subApi res
       (ctx :: [*]) env.
(api ~ (subApi :> res),
 HasServer (subApi :> LoggingApiRec config lcontext res) ctx,
 ApiHasArg subApi res,
 ApiHasArg subApi (LoggingApiRec config lcontext res),
 ApiCanLogArg subApi, Buildable (ApiArgToLog subApi)) =>
Proxy (LoggingApiRec config lcontext api)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext api))
-> Router env
paramRouteWithLog

instance ( HasLoggingServer config lcontext res ctx
         , KnownSymbol s
         ) =>
         HasLoggingServer config lcontext (QueryFlag s :> res) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (QueryFlag s :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (QueryFlag s :> res)))
-> Router env
routeWithLog = Proxy (LoggingApiRec config lcontext (QueryFlag s :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (QueryFlag s :> res)))
-> Router env
forall k (config :: k) (lcontext :: LoggingContext) api subApi res
       (ctx :: [*]) env.
(api ~ (subApi :> res),
 HasServer (subApi :> LoggingApiRec config lcontext res) ctx,
 ApiHasArg subApi res,
 ApiHasArg subApi (LoggingApiRec config lcontext res),
 ApiCanLogArg subApi, Buildable (ApiArgToLog subApi)) =>
Proxy (LoggingApiRec config lcontext api)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext api))
-> Router env
paramRouteWithLog

instance HasLoggingServer config lcontext res ctx =>
         HasLoggingServer config lcontext (Summary s :> res) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (Summary s :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (Summary s :> res)))
-> Router env
routeWithLog = (Proxy (Summary s :> LoggingApiRec config lcontext res)
 -> Context ctx
 -> Delayed
      env (Server (Summary s :> LoggingApiRec config lcontext res))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (Summary s :> res))
    -> Server (Summary s :> LoggingApiRec config lcontext res))
-> Proxy (LoggingApiRec config lcontext (Summary s :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (Summary s :> res)))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(Summary s :> LoggingApiRec config lcontext res) Proxy (Summary s :> LoggingApiRec config lcontext res)
-> Context ctx
-> Delayed
     env (Server (Summary s :> LoggingApiRec config lcontext res))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route Server (LoggingApiRec config lcontext (Summary s :> res))
-> Server (Summary s :> LoggingApiRec config lcontext res)
forall a. a -> a
id

instance HasLoggingServer config lcontext res ctx =>
         HasLoggingServer config lcontext (Description d :> res) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (Description d :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (Description d :> res)))
-> Router env
routeWithLog = (Proxy (Description d :> LoggingApiRec config lcontext res)
 -> Context ctx
 -> Delayed
      env (Server (Description d :> LoggingApiRec config lcontext res))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (Description d :> res))
    -> Server (Description d :> LoggingApiRec config lcontext res))
-> Proxy (LoggingApiRec config lcontext (Description d :> res))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (Description d :> res)))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(Description d :> LoggingApiRec config lcontext res) Proxy (Description d :> LoggingApiRec config lcontext res)
-> Context ctx
-> Delayed
     env (Server (Description d :> LoggingApiRec config lcontext res))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route Server (LoggingApiRec config lcontext (Description d :> res))
-> Server (Description d :> LoggingApiRec config lcontext res)
forall a. a -> a
id

instance ( HasLoggingServer config (ApplyLoggingMod lcontext mod) res ctx
         , HasServer res ctx
         ) =>
         HasLoggingServer config lcontext (LoggingMod mod :> res) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (LoggingMod mod :> res))
-> Context ctx
-> Delayed
     env
     (Server (LoggingApiRec config lcontext (LoggingMod mod :> res)))
-> Router env
routeWithLog = (Proxy (LoggingApiRec config (ApplyLoggingMod lcontext mod) res)
 -> Context ctx
 -> Delayed
      env
      (Server (LoggingApiRec config (ApplyLoggingMod lcontext mod) res))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (LoggingMod mod :> res))
    -> Server
         (LoggingApiRec config (ApplyLoggingMod lcontext mod) res))
-> Proxy (LoggingApiRec config lcontext (LoggingMod mod :> res))
-> Context ctx
-> Delayed
     env
     (Server (LoggingApiRec config lcontext (LoggingMod mod :> res)))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(LoggingApiRec config (ApplyLoggingMod lcontext mod) res) Proxy (LoggingApiRec config (ApplyLoggingMod lcontext mod) res)
-> Context ctx
-> Delayed
     env
     (Server (LoggingApiRec config (ApplyLoggingMod lcontext mod) res))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route Server (LoggingApiRec config lcontext (LoggingMod mod :> res))
-> Server (LoggingApiRec config (ApplyLoggingMod lcontext mod) res)
forall a. a -> a
id

-- | Unique identifier for request-response pair.
newtype RequestId = RequestId Integer

instance Buildable RequestId where
    build :: RequestId -> Builder
build (RequestId Integer
i) = Builder
"#" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Integer
i Integer -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""

-- | We want all servant servers to have non-overlapping ids,
-- so using singleton counter here.
requestsCounter :: TVar Integer
requestsCounter :: TVar Integer
requestsCounter = IO (TVar Integer) -> TVar Integer
forall a. IO a -> a
unsafePerformIO (IO (TVar Integer) -> TVar Integer)
-> IO (TVar Integer) -> TVar Integer
forall a b. (a -> b) -> a -> b
$ Integer -> IO (TVar Integer)
forall (m :: * -> *) a. MonadIO m => a -> m (TVar a)
newTVarIO Integer
0
{-# NOINLINE requestsCounter #-}

nextRequestId :: MonadIO m => m RequestId
nextRequestId :: m RequestId
nextRequestId = STM RequestId -> m RequestId
forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically (STM RequestId -> m RequestId) -> STM RequestId -> m RequestId
forall a b. (a -> b) -> a -> b
$ do
    TVar Integer -> (Integer -> Integer) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar Integer
requestsCounter (Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+Integer
1)
    Integer -> RequestId
RequestId (Integer -> RequestId) -> STM Integer -> STM RequestId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar Integer -> STM Integer
forall a. TVar a -> STM a
readTVar TVar Integer
requestsCounter

-- | Modify an action so that it performs all the required logging.
applyServantLogging
    :: ( Reifies config ServantLogConfig
       , Demote (lcontext :: LoggingContext)
       , Demote (LcResponsesEnabled lcontext)
       , ReflectMethod (method :: k)
       )
    => Proxy config
    -> Proxy lcontext
    -> Proxy method
    -> ApiParamsLogInfo
    -> If (LcResponsesEnabled lcontext) (a -> Text) ()
    -> Handler a
    -> Handler a
applyServantLogging :: Proxy config
-> Proxy lcontext
-> Proxy method
-> ApiParamsLogInfo
-> If (LcResponsesEnabled lcontext) (a -> Text) ()
-> Handler a
-> Handler a
applyServantLogging Proxy config
configP (Proxy lcontext
contextP :: Proxy lcontext) Proxy method
methodP ApiParamsLogInfo
paramsInfo If (LcResponsesEnabled lcontext) (a -> Text) ()
showResponse Handler a
action = do
    Handler Text
timer <- Handler (Handler Text)
forall (m :: * -> *). MonadIO m => m (m Text)
mkTimer
    RequestId
reqId <- Handler RequestId
forall (m :: * -> *). MonadIO m => m RequestId
nextRequestId
    RequestId -> Handler Text -> Handler a -> Handler a
forall a a a.
(Buildable a, Buildable a) =>
a -> Handler a -> Handler a -> Handler a
catchErrors RequestId
reqId Handler Text
timer (Handler a -> Handler a) -> Handler a -> Handler a
forall a b. (a -> b) -> a -> b
$ do
        RequestId -> Handler ()
reportRequest RequestId
reqId
        a
res <- Handler a
action
        RequestId -> Handler Text -> a -> Handler ()
reportResponse RequestId
reqId Handler Text
timer a
res
        a -> Handler a
forall (m :: * -> *) a. Monad m => a -> m a
return a
res
  where
    method :: Text
method = Method -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (Method -> Text) -> Method -> Text
forall a b. (a -> b) -> a -> b
$ Proxy method -> Method
forall k (a :: k). ReflectMethod a => Proxy a -> Method
reflectMethod Proxy method
methodP :: Text
    cmethod :: Text
cmethod =
        let c :: Color
c = case Text
method of
              Text
"GET"    -> Color
Cyan
              Text
"POST"   -> Color
Yellow
              Text
"PUT"    -> Color
Green
              Text
"DELETE" -> Color
Red
              Text
_        -> Color
Magenta
        in Style -> Text -> Text
forall a. Pretty a => Style -> a -> a
style Style
Faint (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Color -> Text -> Text
forall a. Pretty a => Color -> a -> a
color Color
c Text
method
    mkTimer :: MonadIO m => m (m Text)
    mkTimer :: m (m Text)
mkTimer = do
        POSIXTime
startTime <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
        m Text -> m (m Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (m Text -> m (m Text)) -> m Text -> m (m Text)
forall a b. (a -> b) -> a -> b
$ do
            POSIXTime
endTime <- IO POSIXTime -> m POSIXTime
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO POSIXTime
getPOSIXTime
            Text -> m Text
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> m Text) -> (POSIXTime -> Text) -> POSIXTime -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. POSIXTime -> Text
forall b a. (Show a, IsString b) => a -> b
show (POSIXTime -> m Text) -> POSIXTime -> m Text
forall a b. (a -> b) -> a -> b
$ POSIXTime
endTime POSIXTime -> POSIXTime -> POSIXTime
forall a. Num a => a -> a -> a
- POSIXTime
startTime
    logContext :: Demoted LoggingContext
logContext = Proxy lcontext -> Demoted LoggingContext
forall k (ty :: k). Demote ty => Proxy ty -> Demoted k
demote Proxy lcontext
contextP
    logEntryContext :: LogContext
logEntryContext = LogContext :: Maybe Natural -> LogContext
LogContext
      { lecRecommendedLevel :: Maybe Natural
lecRecommendedLevel = LogFullContext -> Maybe Natural
lcRecommendedLevel Demoted LoggingContext
LogFullContext
logContext
      }
    log :: Text -> Handler ()
    log :: Text -> Handler ()
log Text
txt = IO () -> Handler ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ()) -> IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ ServantLogConfig -> LogContext -> Text -> IO ()
clcLog (Proxy config -> ServantLogConfig
forall k (s :: k) a (proxy :: k -> *). Reifies s a => proxy s -> a
reflect Proxy config
configP) LogContext
logEntryContext Text
txt
    eParamLogs :: Either Text Text
    eParamLogs :: Either Text Text
eParamLogs = case ApiParamsLogInfo
paramsInfo of
        ApiParamsLogInfo Bool
_ [Text]
path [Text]
infos -> Text -> Either Text Text
forall a b. b -> Either a b
Right (Text -> Either Text Text) -> Text -> Either Text Text
forall a b. (a -> b) -> a -> b
$
            let pathPart :: Text
pathPart =
                    Text
"    " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
gray Text
":>" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>
                    Text -> [Text] -> Text
T.intercalate (Text -> Text
gray Text
"/") ([Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
path)
                infoPart :: [Text]
infoPart = [Text] -> [Text]
forall a. [a] -> [a]
reverse [Text]
infos [Text] -> (Text -> Text) -> [Text]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
info ->
                    Builder
"    " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Text -> Text
gray Text
":>"
                    Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
info Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
            in Text -> [Text] -> Text
T.intercalate Text
"\n" (Text
pathPart Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
infoPart)
        ApiNoParamsLogInfo Text
why -> Text -> Either Text Text
forall a b. a -> Either a b
Left Text
why
    reportRequest :: RequestId -> Handler ()
    reportRequest :: RequestId -> Handler ()
reportRequest RequestId
reqId =
      Bool -> Handler () -> Handler ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (LogFullContext -> Bool
lcRequestsEnabled Demoted LoggingContext
LogFullContext
logContext) (Handler () -> Handler ()) -> Handler () -> Handler ()
forall a b. (a -> b) -> a -> b
$
        case Either Text Text
eParamLogs of
            Left Text
e ->
                Text -> Handler ()
log (Text -> Handler ()) -> Text -> Handler ()
forall a b. (a -> b) -> a -> b
$ Builder
"\n" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Color -> Text -> Text
dullColor Color
Red Text
"Unexecuted request due to error"
                    Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
e
                    Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
            Right Text
paramLogs -> do
                Text -> Handler ()
log (Text -> Handler ()) -> Text -> Handler ()
forall a b. (a -> b) -> a -> b
$  Builder
"\n" Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
cmethod
                    Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" "  Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text -> Text
gray (Text
"Request " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RequestId -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty RequestId
reqId)
                    Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
"\n" Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
paramLogs Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    responseTag :: a -> a
responseTag a
reqId = a
"Response " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a -> a
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty a
reqId
    reportResponse :: RequestId -> Handler Text -> a -> Handler ()
reportResponse RequestId
reqId Handler Text
timer a
resp =
      case Proxy (LcResponsesEnabled lcontext)
-> Either
     (Dict (LcResponsesEnabled lcontext ~ 'False))
     (Dict (LcResponsesEnabled lcontext ~ 'True))
forall (b :: Bool).
Demote b =>
Proxy b -> Either (Dict (b ~ 'False)) (Dict (b ~ 'True))
tyBoolCase (Proxy (LcResponsesEnabled lcontext)
forall k (t :: k). Proxy t
Proxy @(LcResponsesEnabled lcontext)) of
        Left Dict (LcResponsesEnabled lcontext ~ 'False)
_ -> Handler ()
forall (f :: * -> *). Applicative f => f ()
pass
        Right Dict (LcResponsesEnabled lcontext ~ 'True)
Dict -> do
          Text
durationText <- Handler Text
timer
          Text -> Handler ()
log (Text -> Handler ()) -> Text -> Handler ()
forall a b. (a -> b) -> a -> b
$
              Builder
"\n    " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Text -> Text
gray (RequestId -> Text
forall a a.
(Semigroup a, IsString a, Buildable a, FromBuilder a) =>
a -> a
responseTag RequestId
reqId)
                Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Color -> Text -> Text
dullColor Color
Green Text
"OK"
                Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text
durationText
                Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Text -> Text
gray Text
">"
                Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| If (LcResponsesEnabled lcontext) (a -> Text) ()
a -> Text
showResponse a
resp
                Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
    catchErrors :: a -> Handler a -> Handler a -> Handler a
catchErrors a
reqId Handler a
st =
        (Handler a -> (ServerError -> Handler a) -> Handler a)
-> (ServerError -> Handler a) -> Handler a -> Handler a
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handler a -> (ServerError -> Handler a) -> Handler a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (a -> Handler a -> ServerError -> Handler a
forall a a b.
(Buildable a, Buildable a) =>
a -> Handler a -> ServerError -> Handler b
servantErrHandler a
reqId Handler a
st) (Handler a -> Handler a)
-> (Handler a -> Handler a) -> Handler a -> Handler a
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        (SomeException -> Handler a) -> Handler a -> Handler a
forall (m :: * -> *) a.
MonadCatch m =>
(SomeException -> m a) -> m a -> m a
handleAny (a -> Handler a -> SomeException -> Handler a
forall e a a b.
(Buildable a, Buildable a, Exception e) =>
a -> Handler a -> e -> Handler b
exceptionsHandler a
reqId Handler a
st)
    servantErrHandler :: a -> Handler a -> ServerError -> Handler b
servantErrHandler a
reqId Handler a
timer err :: ServerError
err@ServerError{Int
String
[Header]
ByteString
errHTTPCode :: ServerError -> Int
errReasonPhrase :: ServerError -> String
errBody :: ServerError -> ByteString
errHeaders :: ServerError -> [Header]
errHeaders :: [Header]
errBody :: ByteString
errReasonPhrase :: String
errHTTPCode :: Int
..} = do
        a
durationText <- Handler a
timer
        let errMsg :: Text
errMsg = Int
errHTTPCode Int -> Builder -> Text
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" "  Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| String
errReasonPhrase String -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
":"
        Text -> Handler ()
log (Text -> Handler ()) -> Text -> Handler ()
forall a b. (a -> b) -> a -> b
$
            Builder
"\n    " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Text -> Text
gray (a -> Text
forall a a.
(Semigroup a, IsString a, Buildable a, FromBuilder a) =>
a -> a
responseTag a
reqId)
              Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
durationText
              a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| Color -> Text -> Text
dullColor Color
Red Text
errMsg
              Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 @Text ByteString
errBody
              Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
        ServerError -> Handler b
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError ServerError
err
    exceptionsHandler :: a -> Handler a -> e -> Handler b
exceptionsHandler a
reqId Handler a
timer e
e = do
        a
durationText <- Handler a
timer
        Text -> Handler ()
log (Text -> Handler ()) -> Text -> Handler ()
forall a b. (a -> b) -> a -> b
$
            Builder
"\n    " Builder -> Builder -> Text
forall b. FromBuilder b => Builder -> Builder -> b
+| Color -> Text -> Text
dullColor Color
Red (a -> Text
forall a a.
(Semigroup a, IsString a, Buildable a, FromBuilder a) =>
a -> a
responseTag a
reqId)
              Text -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| e
e
             e -> Builder -> Builder
forall a b. (Show a, FromBuilder b) => a -> Builder -> b
||+ Builder
" " Builder -> Builder -> Builder
forall b. FromBuilder b => Builder -> Builder -> b
+| a
durationText
              a -> Builder -> Builder
forall a b. (Buildable a, FromBuilder b) => a -> Builder -> b
|+ Builder
""
        e -> Handler b
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM e
e

applyLoggingToHandler
    :: forall k config lcontext method a.
       ( Reifies config ServantLogConfig
       , Demote lcontext
       , BuildableForResponseIfNecessary lcontext a
       , Demote lcontext
       , ReflectMethod method
       )
    => Proxy config -> Proxy (lcontext :: LoggingContext) -> Proxy (method :: k)
    -> (ApiParamsLogInfo, Handler a) -> Handler a
applyLoggingToHandler :: Proxy config
-> Proxy lcontext
-> Proxy method
-> (ApiParamsLogInfo, Handler a)
-> Handler a
applyLoggingToHandler Proxy config
configP Proxy lcontext
contextP Proxy method
methodP (ApiParamsLogInfo
paramsInfo, Handler a
handler) = do
    let apply :: If (LcResponsesEnabled lcontext) (a -> Text) () -> Handler a
apply If (LcResponsesEnabled lcontext) (a -> Text) ()
format =
          Proxy config
-> Proxy lcontext
-> Proxy method
-> ApiParamsLogInfo
-> If (LcResponsesEnabled lcontext) (a -> Text) ()
-> Handler a
-> Handler a
forall k (config :: k) (lcontext :: LoggingContext) k (method :: k)
       a.
(Reifies config ServantLogConfig, Demote lcontext,
 Demote (LcResponsesEnabled lcontext), ReflectMethod method) =>
Proxy config
-> Proxy lcontext
-> Proxy method
-> ApiParamsLogInfo
-> If (LcResponsesEnabled lcontext) (a -> Text) ()
-> Handler a
-> Handler a
applyServantLogging Proxy config
configP Proxy lcontext
contextP Proxy method
methodP ApiParamsLogInfo
paramsInfo If (LcResponsesEnabled lcontext) (a -> Text) ()
format Handler a
handler
    case Proxy (LcResponsesEnabled lcontext)
-> Either
     (Dict (LcResponsesEnabled lcontext ~ 'False))
     (Dict (LcResponsesEnabled lcontext ~ 'True))
forall (b :: Bool).
Demote b =>
Proxy b -> Either (Dict (b ~ 'False)) (Dict (b ~ 'True))
tyBoolCase (Proxy (LcResponsesEnabled lcontext)
 -> Either
      (Dict (LcResponsesEnabled lcontext ~ 'False))
      (Dict (LcResponsesEnabled lcontext ~ 'True)))
-> Proxy (LcResponsesEnabled lcontext)
-> Either
     (Dict (LcResponsesEnabled lcontext ~ 'False))
     (Dict (LcResponsesEnabled lcontext ~ 'True))
forall a b. (a -> b) -> a -> b
$ Proxy (LcResponsesEnabled lcontext)
forall k (t :: k). Proxy t
Proxy @(LcResponsesEnabled lcontext) of
        Right Dict (LcResponsesEnabled lcontext ~ 'True)
Dict -> If (LcResponsesEnabled lcontext) (a -> Text) () -> Handler a
apply (ForResponseLog a -> Text
forall a b. (Buildable a, FromBuilder b) => a -> b
pretty (ForResponseLog a -> Text) -> (a -> ForResponseLog a) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ForResponseLog a
forall a. a -> ForResponseLog a
ForResponseLog)
        Left Dict (LcResponsesEnabled lcontext ~ 'False)
Dict  -> If (LcResponsesEnabled lcontext) (a -> Text) () -> Handler a
apply ()

skipLogging :: (ApiParamsLogInfo, action) -> action
skipLogging :: (ApiParamsLogInfo, action) -> action
skipLogging = (ApiParamsLogInfo, action) -> action
forall a b. (a, b) -> b
snd

instance ( HasServer (Verb mt st ct a) ctx
         , Reifies config ServantLogConfig
         , Demote lcontext
         , ReflectMethod mt
         , BuildableForResponseIfNecessary lcontext a
         ) =>
         HasLoggingServer config lcontext (Verb (mt :: k) (st :: Nat) (ct :: [Type]) a) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (Verb mt st ct a))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (Verb mt st ct a)))
-> Router env
routeWithLog =
        (Proxy (Verb mt st ct a)
 -> Context ctx
 -> Delayed env (Server (Verb mt st ct a))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (Verb mt st ct a))
    -> Server (Verb mt st ct a))
-> Proxy (LoggingApiRec config lcontext (Verb mt st ct a))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (Verb mt st ct a)))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(Verb mt st ct a) Proxy (Verb mt st ct a)
-> Context ctx
-> Delayed env (Server (Verb mt st ct a))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route ((Server (LoggingApiRec config lcontext (Verb mt st ct a))
  -> Server (Verb mt st ct a))
 -> Proxy (LoggingApiRec config lcontext (Verb mt st ct a))
 -> Context ctx
 -> Delayed
      env (Server (LoggingApiRec config lcontext (Verb mt st ct a)))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (Verb mt st ct a))
    -> Server (Verb mt st ct a))
-> Proxy (LoggingApiRec config lcontext (Verb mt st ct a))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (Verb mt st ct a)))
-> Router env
forall a b. (a -> b) -> a -> b
$
        Proxy config
-> Proxy lcontext
-> Proxy mt
-> (ApiParamsLogInfo, Handler a)
-> Handler a
forall k k (config :: k) (lcontext :: LoggingContext) (method :: k)
       a.
(Reifies config ServantLogConfig, Demote lcontext,
 BuildableForResponseIfNecessary lcontext a, Demote lcontext,
 ReflectMethod method) =>
Proxy config
-> Proxy lcontext
-> Proxy method
-> (ApiParamsLogInfo, Handler a)
-> Handler a
applyLoggingToHandler (Proxy config
forall k (t :: k). Proxy t
Proxy @config) (Proxy lcontext
forall k (t :: k). Proxy t
Proxy @lcontext) (Proxy mt
forall k (t :: k). Proxy t
Proxy @mt)

instance ( HasServer (NoContentVerb mt) ctx
         , Reifies config ServantLogConfig
         , Demote lcontext
         , ReflectMethod mt
         , BuildableForResponseIfNecessary lcontext NoContent
         ) =>
         HasLoggingServer config lcontext (NoContentVerb (mt :: k)) ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext (NoContentVerb mt))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (NoContentVerb mt)))
-> Router env
routeWithLog =
        (Proxy (NoContentVerb mt)
 -> Context ctx
 -> Delayed env (Server (NoContentVerb mt))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (NoContentVerb mt))
    -> Server (NoContentVerb mt))
-> Proxy (LoggingApiRec config lcontext (NoContentVerb mt))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (NoContentVerb mt)))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @(NoContentVerb mt) Proxy (NoContentVerb mt)
-> Context ctx
-> Delayed env (Server (NoContentVerb mt))
-> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route ((Server (LoggingApiRec config lcontext (NoContentVerb mt))
  -> Server (NoContentVerb mt))
 -> Proxy (LoggingApiRec config lcontext (NoContentVerb mt))
 -> Context ctx
 -> Delayed
      env (Server (LoggingApiRec config lcontext (NoContentVerb mt)))
 -> Router env)
-> (Server (LoggingApiRec config lcontext (NoContentVerb mt))
    -> Server (NoContentVerb mt))
-> Proxy (LoggingApiRec config lcontext (NoContentVerb mt))
-> Context ctx
-> Delayed
     env (Server (LoggingApiRec config lcontext (NoContentVerb mt)))
-> Router env
forall a b. (a -> b) -> a -> b
$
        Proxy config
-> Proxy lcontext
-> Proxy mt
-> (ApiParamsLogInfo, Handler NoContent)
-> Handler NoContent
forall k k (config :: k) (lcontext :: LoggingContext) (method :: k)
       a.
(Reifies config ServantLogConfig, Demote lcontext,
 BuildableForResponseIfNecessary lcontext a, Demote lcontext,
 ReflectMethod method) =>
Proxy config
-> Proxy lcontext
-> Proxy method
-> (ApiParamsLogInfo, Handler a)
-> Handler a
applyLoggingToHandler (Proxy config
forall k (t :: k). Proxy t
Proxy @config) (Proxy lcontext
forall k (t :: k). Proxy t
Proxy @lcontext) (Proxy mt
forall k (t :: k). Proxy t
Proxy @mt)

instance HasLoggingServer config lcontext Raw ctx where
    routeWithLog :: Proxy (LoggingApiRec config lcontext Raw)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext Raw))
-> Router env
routeWithLog = (Proxy Raw
 -> Context ctx -> Delayed env (Server Raw) -> Router env)
-> (Server (LoggingApiRec config lcontext Raw) -> Server Raw)
-> Proxy (LoggingApiRec config lcontext Raw)
-> Context ctx
-> Delayed env (Server (LoggingApiRec config lcontext Raw))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @Raw Proxy Raw -> Context ctx -> Delayed env (Server Raw) -> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route Server (LoggingApiRec config lcontext Raw) -> Server Raw
forall action. (ApiParamsLogInfo, action) -> action
skipLogging

instance Buildable (ForResponseLog NoContent) where
    build :: ForResponseLog NoContent -> Builder
build ForResponseLog NoContent
_ = Builder
"<no response>"

instance Buildable (ForResponseLog ()) where
    build :: ForResponseLog () -> Builder
build ForResponseLog ()
_ = Builder
"<no response>"

instance Buildable (ForResponseLog Integer) where
    build :: ForResponseLog Integer -> Builder
build = ForResponseLog Integer -> Builder
forall a. Buildable a => ForResponseLog a -> Builder
buildForResponse

instance Buildable (ForResponseLog Swagger) where
    build :: ForResponseLog Swagger -> Builder
build ForResponseLog Swagger
_ = Builder
"Swagger specification"

instance Buildable (ForResponseLog (SwaggerUiHtml dir api)) where
    build :: ForResponseLog (SwaggerUiHtml dir api) -> Builder
build ForResponseLog (SwaggerUiHtml dir api)
_ = Builder
"Accessed documentation UI"

instance HasServer api ctx =>
         HasServer (LoggingMod mod :> api) ctx where
    type ServerT (LoggingMod mod :> api) m = ServerT api m
    route :: Proxy (LoggingMod mod :> api)
-> Context ctx
-> Delayed env (Server (LoggingMod mod :> api))
-> Router env
route = (Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server (LoggingMod mod :> api) -> Server api)
-> Proxy (LoggingMod mod :> api)
-> Context ctx
-> Delayed env (Server (LoggingMod mod :> api))
-> Router env
forall api api' (ctx :: [*]) env.
(Proxy api
 -> Context ctx -> Delayed env (Server api) -> Router env)
-> (Server api' -> Server api)
-> Proxy api'
-> Context ctx
-> Delayed env (Server api')
-> Router env
inRouteServer @api Proxy api -> Context ctx -> Delayed env (Server api) -> Router env
forall k (api :: k) (context :: [*]) env.
HasServer api context =>
Proxy api
-> Context context -> Delayed env (Server api) -> Router env
route Server (LoggingMod mod :> api) -> Server api
forall a. a -> a
id
    hoistServerWithContext :: Proxy (LoggingMod mod :> api)
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT (LoggingMod mod :> api) m
-> ServerT (LoggingMod mod :> api) n
hoistServerWithContext Proxy (LoggingMod mod :> api)
_ = Proxy api
-> Proxy ctx
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall k (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
hoistServerWithContext (Proxy api
forall k (t :: k). Proxy t
Proxy @api)

instance HasClient m api =>
         HasClient m (LoggingMod mod :> api) where
    type Client m (LoggingMod mod :> api) = Client m api
    clientWithRoute :: Proxy m
-> Proxy (LoggingMod mod :> api)
-> Request
-> Client m (LoggingMod mod :> api)
clientWithRoute Proxy m
mp Proxy (LoggingMod mod :> api)
_ = Proxy m -> Proxy api -> Request -> Client m api
forall (m :: * -> *) api.
HasClient m api =>
Proxy m -> Proxy api -> Request -> Client m api
clientWithRoute Proxy m
mp (Proxy api
forall k (t :: k). Proxy t
Proxy @api)
    hoistClientMonad :: Proxy m
-> Proxy (LoggingMod mod :> api)
-> (forall x. mon x -> mon' x)
-> Client mon (LoggingMod mod :> api)
-> Client mon' (LoggingMod mod :> api)
hoistClientMonad Proxy m
mp Proxy (LoggingMod mod :> api)
_ = Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
forall (m :: * -> *) api (mon :: * -> *) (mon' :: * -> *).
HasClient m api =>
Proxy m
-> Proxy api
-> (forall x. mon x -> mon' x)
-> Client mon api
-> Client mon' api
hoistClientMonad Proxy m
mp (Proxy api
forall k (t :: k). Proxy t
Proxy @api)

instance HasSwagger api =>
         HasSwagger (LoggingMod mod :> api) where
    toSwagger :: Proxy (LoggingMod mod :> api) -> Swagger
toSwagger Proxy (LoggingMod mod :> api)
_ = Proxy api -> Swagger
forall k (api :: k). HasSwagger api => Proxy api -> Swagger
toSwagger (Proxy api
forall k (t :: k). Proxy t
Proxy @api)

-- | Apply logging to the given server.
serverWithLogging
    :: forall api a.
       ServantLogConfig
    -> Proxy api
    -> (forall (config :: Type). Reifies config ServantLogConfig =>
        Proxy (LoggingApi config api) -> a)
    -> a
serverWithLogging :: ServantLogConfig
-> Proxy api
-> (forall config.
    Reifies config ServantLogConfig =>
    Proxy (LoggingApi config api) -> a)
-> a
serverWithLogging ServantLogConfig
config Proxy api
_ forall config.
Reifies config ServantLogConfig =>
Proxy (LoggingApi config api) -> a
f =
    ServantLogConfig
-> (forall s. Reifies s ServantLogConfig => Proxy s -> a) -> a
forall a r. a -> (forall s. Reifies s a => Proxy s -> r) -> r
reify ServantLogConfig
config ((forall s. Reifies s ServantLogConfig => Proxy s -> a) -> a)
-> (forall s. Reifies s ServantLogConfig => Proxy s -> a) -> a
forall a b. (a -> b) -> a -> b
$ \(Proxy s
Proxy :: Proxy config) -> Proxy (LoggingApi s api) -> a
forall config.
Reifies config ServantLogConfig =>
Proxy (LoggingApi config api) -> a
f (Proxy (LoggingApi s api)
forall k (t :: k). Proxy t
Proxy @(LoggingApi config api))