module Katip.Wai.Middleware
  ( ApplicationT
  , MiddlewareT
  , runApplication
  , middlewareCustom
  , middleware
  ) where

import Katip.Wai.Options (Options)
import qualified Katip.Wai.Options as Options
import qualified Katip.Wai.Request as Request
import qualified Katip.Wai.Response as Response

import Control.Monad.IO.Class (MonadIO (liftIO))
import qualified Katip
import qualified Network.Wai as Wai


-- | Just like 'Wai.Application' except it runs in @m@ instead of 'IO'
type ApplicationT m = Wai.Request -> (Wai.Response -> m Wai.ResponseReceived) -> m Wai.ResponseReceived


-- | Just like 'Wai.Middleware' except it runs in @m@ instead of 'IO'
type MiddlewareT m = ApplicationT m -> ApplicationT m


-- | Converts an 'ApplicationT' to a normal 'Wai.Application'
runApplication :: MonadIO m => (forall a. m a -> IO a) -> ApplicationT m -> Wai.Application
runApplication :: forall (m :: * -> *).
MonadIO m =>
(forall a. m a -> IO a) -> ApplicationT m -> Application
runApplication forall a. m a -> IO a
toIO ApplicationT m
application Request
request Response -> IO ResponseReceived
send =
  m ResponseReceived -> IO ResponseReceived
forall a. m a -> IO a
toIO (m ResponseReceived -> IO ResponseReceived)
-> m ResponseReceived -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ ApplicationT m
application Request
request (IO ResponseReceived -> m ResponseReceived
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ResponseReceived -> m ResponseReceived)
-> (Response -> IO ResponseReceived)
-> Response
-> m ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> IO ResponseReceived
send)


-- | Same as 'middleware', but allows you to customize how the 'Request.Request'
-- and 'Response.Response' are handled.
middlewareCustom
  :: MonadIO m
  => Options m
  -> MiddlewareT m
middlewareCustom :: forall (m :: * -> *). MonadIO m => Options m -> MiddlewareT m
middlewareCustom Options m
options ApplicationT m
application Request
request Response -> m ResponseReceived
send = do
  Request
tracedRequest <- Request -> m Request
forall (m :: * -> *). MonadIO m => Request -> m Request
Request.traceRequest Request
request
  Options m -> forall a. Request -> m a -> m a
forall (m :: * -> *). Options m -> forall a. Request -> m a -> m a
Options.handleRequest Options m
options Request
tracedRequest (m ResponseReceived -> m ResponseReceived)
-> m ResponseReceived -> m ResponseReceived
forall a b. (a -> b) -> a -> b
$
    ApplicationT m
application Request
request ((Response -> m ResponseReceived) -> m ResponseReceived)
-> (Response -> m ResponseReceived) -> m ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
response -> do
      Response
tracedResponse <- Request -> Response -> m Response
forall (m :: * -> *).
MonadIO m =>
Request -> Response -> m Response
Response.traceResponse Request
tracedRequest Response
response
      Options m -> forall a. Response -> m a -> m a
forall (m :: * -> *). Options m -> forall a. Response -> m a -> m a
Options.handleResponse Options m
options Response
tracedResponse (m ResponseReceived -> m ResponseReceived)
-> m ResponseReceived -> m ResponseReceived
forall a b. (a -> b) -> a -> b
$
        Response -> m ResponseReceived
send Response
response


-- | Add the request and response to the 'Katip.LogContexts', and log a message
-- when a request is received and when a response is sent.
--
-- This uses the default format: 'Options.defaultRequestFormat' and 'Options.defaultResponseFormat' with milliseconds for the response time.
--
-- If you want more customization see 'middlewareCustom'.
middleware :: Katip.KatipContext m => Katip.Severity -> MiddlewareT m
middleware :: forall (m :: * -> *). KatipContext m => Severity -> MiddlewareT m
middleware =
  Options m -> MiddlewareT m
forall (m :: * -> *). MonadIO m => Options m -> MiddlewareT m
middlewareCustom (Options m -> MiddlewareT m)
-> (Severity -> Options m) -> Severity -> MiddlewareT m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Severity -> Options m
forall (m :: * -> *). KatipContext m => Severity -> Options m
Options.defaultOptions