---------------------------------------------------------
-- |
-- Module        : Network.Wai.Middleware.Select
-- Copyright     : Michael Snoyman
-- License       : BSD3
--
-- Maintainer    : Michael Snoyman <michael@snoyman.com>
-- Stability     : Unstable
-- Portability   : portable
--
-- Dynamically choose between Middlewares
--
-- It's useful when you want some 'Middleware's applied selectively.
--
-- Example: do not log health check calls:
--
-- > import Network.Wai
-- > import Network.Wai.Middleware.HealthCheckEndpoint
-- > import Network.Wai.Middleware.RequestLogger
-- >
-- > app' :: Application
-- > app' =
-- >   selectMiddleware (selectMiddlewareExceptRawPathInfo "/_healthz" logStdout)
-- >     $ healthCheck app
--
-- @since 3.1.10
--
---------------------------------------------------------
module Network.Wai.Middleware.Select
  ( -- * Middleware selection
    MiddlewareSelection (..),
    selectMiddleware,

    -- * Helpers
    selectMiddlewareOn,
    selectMiddlewareOnRawPathInfo,
    selectMiddlewareExceptRawPathInfo,
    passthroughMiddleware,
  )
where

import Control.Applicative ((<|>))
import Data.ByteString (ByteString)
import Data.Maybe (fromMaybe)
import Network.Wai

--------------------------------------------------
-- * Middleware selection
--------------------------------------------------

-- | Relevant Middleware for a given 'Request'.
newtype MiddlewareSelection = MiddlewareSelection
  { MiddlewareSelection -> Request -> Maybe Middleware
applySelectedMiddleware :: Request -> Maybe Middleware
  }

instance Semigroup MiddlewareSelection where
  MiddlewareSelection Request -> Maybe Middleware
f <> :: MiddlewareSelection -> MiddlewareSelection -> MiddlewareSelection
<> MiddlewareSelection Request -> Maybe Middleware
g =
    (Request -> Maybe Middleware) -> MiddlewareSelection
MiddlewareSelection ((Request -> Maybe Middleware) -> MiddlewareSelection)
-> (Request -> Maybe Middleware) -> MiddlewareSelection
forall a b. (a -> b) -> a -> b
$ \Request
req -> Request -> Maybe Middleware
f Request
req Maybe Middleware -> Maybe Middleware -> Maybe Middleware
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Request -> Maybe Middleware
g Request
req

instance Monoid MiddlewareSelection where
  mempty :: MiddlewareSelection
mempty = (Request -> Maybe Middleware) -> MiddlewareSelection
MiddlewareSelection ((Request -> Maybe Middleware) -> MiddlewareSelection)
-> (Request -> Maybe Middleware) -> MiddlewareSelection
forall a b. (a -> b) -> a -> b
$ Maybe Middleware -> Request -> Maybe Middleware
forall a b. a -> b -> a
const Maybe Middleware
forall a. Maybe a
Nothing

-- | Create the 'Middleware' dynamically applying 'MiddlewareSelection'.
selectMiddleware :: MiddlewareSelection -> Middleware
selectMiddleware :: MiddlewareSelection -> Middleware
selectMiddleware MiddlewareSelection
selection Application
app Request
request Response -> IO ResponseReceived
respond =
  Middleware
mw Application
app Request
request Response -> IO ResponseReceived
respond
  where
    mw :: Middleware
    mw :: Middleware
mw = Middleware -> Maybe Middleware -> Middleware
forall a. a -> Maybe a -> a
fromMaybe Middleware
passthroughMiddleware (MiddlewareSelection -> Request -> Maybe Middleware
applySelectedMiddleware MiddlewareSelection
selection Request
request)

--------------------------------------------------
-- * Helpers
--------------------------------------------------

passthroughMiddleware :: Middleware
passthroughMiddleware :: Middleware
passthroughMiddleware = Middleware
forall a. a -> a
id

-- | Use the 'Middleware' when the predicate holds.
selectMiddlewareOn :: (Request -> Bool) -> Middleware -> MiddlewareSelection
selectMiddlewareOn :: (Request -> Bool) -> Middleware -> MiddlewareSelection
selectMiddlewareOn Request -> Bool
doesApply Middleware
mw = (Request -> Maybe Middleware) -> MiddlewareSelection
MiddlewareSelection ((Request -> Maybe Middleware) -> MiddlewareSelection)
-> (Request -> Maybe Middleware) -> MiddlewareSelection
forall a b. (a -> b) -> a -> b
$ \Request
request ->
  if Request -> Bool
doesApply Request
request
    then Middleware -> Maybe Middleware
forall a. a -> Maybe a
Just Middleware
mw
    else Maybe Middleware
forall a. Maybe a
Nothing

-- | Use the `Middleware` for the given 'rawPathInfo'.
selectMiddlewareOnRawPathInfo :: ByteString -> Middleware -> MiddlewareSelection
selectMiddlewareOnRawPathInfo :: ByteString -> Middleware -> MiddlewareSelection
selectMiddlewareOnRawPathInfo ByteString
path = (Request -> Bool) -> Middleware -> MiddlewareSelection
selectMiddlewareOn ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
path) (ByteString -> Bool) -> (Request -> ByteString) -> Request -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
rawPathInfo)

-- | Use the `Middleware` for all 'rawPathInfo' except then given one.
selectMiddlewareExceptRawPathInfo :: ByteString -> Middleware -> MiddlewareSelection
selectMiddlewareExceptRawPathInfo :: ByteString -> Middleware -> MiddlewareSelection
selectMiddlewareExceptRawPathInfo ByteString
path = (Request -> Bool) -> Middleware -> MiddlewareSelection
selectMiddlewareOn ((ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
path) (ByteString -> Bool) -> (Request -> ByteString) -> Request -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> ByteString
rawPathInfo)