module Network.Wai.Middleware.Environment
  ( withEnvironment,
    environment,
  )
where

import Data.Default (Default, def)
import Data.Maybe (fromMaybe)
import qualified Data.Vault.Lazy as V
import Network.Wai (Middleware, Request (..))
import System.IO.Unsafe (unsafePerformIO)

vaultKey :: Default a => V.Key a
vaultKey :: Key a
vaultKey = IO (Key a) -> Key a
forall a. IO a -> a
unsafePerformIO IO (Key a)
forall a. IO (Key a)
V.newKey
{-# NOINLINE vaultKey #-}

-- | Parametize subsequent requests with environment.
withEnvironment :: Default a => a -> Middleware
withEnvironment :: a -> Middleware
withEnvironment a
env Application
app Request
req Response -> IO ResponseReceived
respond = do
  let req' :: Request
req' = Request
req {vault :: Vault
vault = Key a -> a -> Vault -> Vault
forall a. Key a -> a -> Vault -> Vault
V.insert Key a
forall a. Default a => Key a
vaultKey a
env (Request -> Vault
vault Request
req)}
  Application
app Request
req' Response -> IO ResponseReceived
respond

-- | Retrieve request environment.
environment :: Default a => Request -> a
environment :: Request -> a
environment = a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe a
forall a. Default a => a
def (Maybe a -> a) -> (Request -> Maybe a) -> Request -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key a -> Vault -> Maybe a
forall a. Key a -> Vault -> Maybe a
V.lookup Key a
forall a. Default a => Key a
vaultKey (Vault -> Maybe a) -> (Request -> Vault) -> Request -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Vault
vault