{-# LANGUAGE BlockArguments #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Network.Wai.Middleware.Context
  ( -- * Middlewares
    -- ** Request-specific
    addRequestContext
  , addRequestContextMay

    -- ** General
  , addContext
  ) where

import Prelude
import qualified Context
import qualified Network.Wai as Wai

-- | Register request-specific context into the provided 'Context.Store', for
-- subsequent use in your 'Wai.Application'. This middleware expects to be able
-- to build a context value from every request. Use the 'addRequestContextMay'
-- variant in your application instead if only some requests will result in a
-- context value.
--
-- Endpoints can access their context from the middleware via `Context.mine'
-- and friends.
--
-- @since 0.1.0.0
addRequestContext
  :: Context.Store ctx
  -> (Wai.Request -> IO ctx)
  -> Wai.Middleware
addRequestContext :: Store ctx -> (Request -> IO ctx) -> Middleware
addRequestContext Store ctx
contextStore Request -> IO ctx
mkContext Application
app = \Request
request Response -> IO ResponseReceived
sendResponse -> do
  ctx
context <- Request -> IO ctx
mkContext Request
request
  Store ctx -> ctx -> IO ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> ctx -> m a -> m a
Context.use Store ctx
contextStore ctx
context do
    Application
app Request
request Response -> IO ResponseReceived
sendResponse

-- | Register request-specific context into the provided 'Context.Store', for
-- subsequent use in your 'Wai.Application'. This middleware does not expect to
-- be able to build a context value from every request. Use the
-- 'addRequestContext' variant in your application instead if all requests will
-- result in a context value.
--
-- Endpoints can access their context from the middleware via `Context.mineMay'
-- and friends.
--
-- @since 0.1.0.0
addRequestContextMay
  :: Context.Store ctx
  -> (Wai.Request -> IO (Maybe ctx))
  -> Wai.Middleware
addRequestContextMay :: Store ctx -> (Request -> IO (Maybe ctx)) -> Middleware
addRequestContextMay Store ctx
contextStore Request -> IO (Maybe ctx)
mkContext Application
app = \Request
request Response -> IO ResponseReceived
sendResponse -> do
  Request -> IO (Maybe ctx)
mkContext Request
request IO (Maybe ctx)
-> (Maybe ctx -> IO ResponseReceived) -> IO ResponseReceived
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe ctx
Nothing -> Application
app Request
request Response -> IO ResponseReceived
sendResponse
    Just ctx
context ->
      Store ctx -> ctx -> IO ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> ctx -> m a -> m a
Context.use Store ctx
contextStore ctx
context do
        Application
app Request
request Response -> IO ResponseReceived
sendResponse

-- | Register arbitrary context into the provided 'Context.Store', for
-- subsequent use in your 'Wai.Application'. This middleware ignores requests
-- when building context values. Use 'addRequestContext'/'addRequestContextMay'
-- in your application instead if you would like to register request-specific
-- context.
--
-- Endpoints can access their context from the middleware via `Context.mine'
-- and friends.
--
-- @since 0.1.0.0
addContext :: Context.Store ctx -> IO ctx -> Wai.Middleware
addContext :: Store ctx -> IO ctx -> Middleware
addContext Store ctx
contextStore IO ctx
mkContext Application
app = \Request
request Response -> IO ResponseReceived
sendResponse -> do
  ctx
context <- IO ctx
mkContext
  Store ctx -> ctx -> IO ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) ctx a.
(MonadIO m, MonadMask m) =>
Store ctx -> ctx -> m a -> m a
Context.use Store ctx
contextStore ctx
context do
    Application
app Request
request Response -> IO ResponseReceived
sendResponse