Select.hs

---------------------------------------------------------

---------------------------------------------------------

-- |
-- 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
    { applySelectedMiddleware :: Request -> Maybe Middleware
    }

instance Semigroup MiddlewareSelection where
    MiddlewareSelection f <> MiddlewareSelection g =
        MiddlewareSelection $ \req -> f req <|> g req

instance Monoid MiddlewareSelection where
    mempty = MiddlewareSelection $ const Nothing

-- | Create the 'Middleware' dynamically applying 'MiddlewareSelection'.
selectMiddleware :: MiddlewareSelection -> Middleware
selectMiddleware selection app request respond =
    mw app request respond
  where
    mw :: Middleware
    mw = fromMaybe passthroughMiddleware (applySelectedMiddleware selection request)

--------------------------------------------------

-- * Helpers

--------------------------------------------------

passthroughMiddleware :: Middleware
passthroughMiddleware = id

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

-- | Use the `Middleware` for the given 'rawPathInfo'.
selectMiddlewareOnRawPathInfo :: ByteString -> Middleware -> MiddlewareSelection
selectMiddlewareOnRawPathInfo path = selectMiddlewareOn ((== path) . rawPathInfo)

-- | Use the `Middleware` for all 'rawPathInfo' except then given one.
selectMiddlewareExceptRawPathInfo
    :: ByteString -> Middleware -> MiddlewareSelection
selectMiddlewareExceptRawPathInfo path = selectMiddlewareOn ((/= path) . rawPathInfo)