{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | This module is designed to be imported as follows:
--
-- @
-- import qualified "Di.Wai"
-- @
module Di.Wai (middleware, middleware') where

import Data.Foldable
import Data.IORef
import Data.Word
import Df1.Wai qualified
import Di.Df1 qualified as Di
import Network.Wai qualified as Wai
import System.Clock qualified as Clock
import System.IO.Unsafe

refReqId :: IORef Word64
refReqId :: IORef Word64
refReqId = IO (IORef Word64) -> IORef Word64
forall a. IO a -> a
unsafePerformIO (IO (IORef Word64) -> IORef Word64)
-> IO (IORef Word64) -> IORef Word64
forall a b. (a -> b) -> a -> b
$ Word64 -> IO (IORef Word64)
forall a. a -> IO (IORef a)
newIORef Word64
0
{-# NOINLINE refReqId #-}

-- | Like 'middleware', but it exposes the 'Di.Df1' that includes 'Df1.Path'
-- data about 'Wai.Request' to the underlying 'Wai.Application'.
middleware'
   :: Di.Df1
   -> (Di.Df1 -> Wai.Application)
   -> Wai.Application
middleware' :: Df1 -> (Df1 -> Application) -> Application
middleware' Df1
di0 = \Df1 -> Application
fapp Request
req Response -> IO ResponseReceived
respond -> do
   TimeSpec
t0 <- Clock -> IO TimeSpec
Clock.getTime Clock
Clock.Monotonic
   Word64
reqId <- IORef Word64 -> (Word64 -> (Word64, Word64)) -> IO Word64
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Word64
refReqId ((Word64 -> (Word64, Word64)) -> IO Word64)
-> (Word64 -> (Word64, Word64)) -> IO Word64
forall a b. (a -> b) -> a -> b
$ \Word64
ol -> (Word64
ol Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
1, Word64
ol)
   let di1 :: Df1
di1 =
         (Df1 -> (Key, Value) -> Df1) -> Df1 -> [(Key, Value)] -> Df1
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
            (\Df1
di (Key
k, Value
v) -> Key -> Value -> Df1 -> Df1
forall value level msg.
ToValue value =>
Key -> value -> Di level Path msg -> Di level Path msg
Di.attr Key
k Value
v Df1
di)
            (Segment -> Df1 -> Df1
forall level msg. Segment -> Di level Path msg -> Di level Path msg
Di.push Segment
"http" Df1
di0)
            ((Key
"request", Word64 -> Value
forall a. ToValue a => a -> Value
Di.value Word64
reqId) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: Request -> [(Key, Value)]
Df1.Wai.request Request
req)
   Df1 -> Message -> IO ()
forall (m :: * -> *) path.
MonadIO m =>
Di Level path Message -> Message -> m ()
Di.info_ Df1
di1 Message
"Request coming in"
   Df1 -> Application
fapp Df1
di1 Request
req ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
res -> do
      TimeSpec
t1 <- Clock -> IO TimeSpec
Clock.getTime Clock
Clock.Monotonic
      let td :: Integer
td = TimeSpec -> Integer
Clock.toNanoSecs TimeSpec
t1 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- TimeSpec -> Integer
Clock.toNanoSecs TimeSpec
t0
          di2 :: Df1
di2 =
            (Df1 -> (Key, Value) -> Df1) -> Df1 -> [(Key, Value)] -> Df1
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl'
               (\Df1
di (Key
k, Value
v) -> Key -> Value -> Df1 -> Df1
forall value level msg.
ToValue value =>
Key -> value -> Di level Path msg -> Di level Path msg
Di.attr Key
k Value
v Df1
di)
               Df1
di1
               ((Key
"nanoseconds", Integer -> Value
forall a. ToValue a => a -> Value
Di.value Integer
td) (Key, Value) -> [(Key, Value)] -> [(Key, Value)]
forall a. a -> [a] -> [a]
: Response -> [(Key, Value)]
Df1.Wai.response Response
res)
      Df1 -> Message -> IO ()
forall (m :: * -> *) path.
MonadIO m =>
Di Level path Message -> Message -> m ()
Di.info_ Df1
di2 Message
"Response going out"
      Response -> IO ResponseReceived
respond Response
res

-- | Obtain a 'Wai.Middleware' that will log incomming 'Wai.Request's
-- and outgoing 'Wai.Response's through the given 'Di.Df1'.
--
-- If your 'Wai.Application' needs access to the 'Di.Df1' uniquely tied
-- to the current 'Wai.Request', then use 'middleware'' instead.
middleware :: Di.Df1 -> Wai.Middleware
middleware :: Df1 -> Middleware
middleware Df1
di = Df1 -> (Df1 -> Application) -> Application
middleware' Df1
di ((Df1 -> Application) -> Application)
-> (Application -> Df1 -> Application) -> Middleware
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Application -> Df1 -> Application
forall a b. a -> b -> a
const