    {-# LANGUAGE CPP #-}
    {-# LANGUAGE RecordWildCards #-}

    -- NOTE: Due to https://github.com/yesodweb/wai/issues/192, this module should
    -- not use CPP.
    -- EDIT: Fixed this by adding two "zero-width spaces" in between the "*/*"
    module Network.Wai.Middleware.RequestLogger
        ( -- * Basic stdout logging
          logStdout
        , logStdoutDev
          -- * Create more versions
        , mkRequestLogger
        , RequestLoggerSettings
        , defaultRequestLoggerSettings
        , outputFormat
        , autoFlush
        , destination
        , OutputFormat (..)
        , ApacheSettings
        , defaultApacheSettings
        , setApacheIPAddrSource
        , setApacheRequestFilter
        , setApacheUserGetter
        , DetailedSettings (..)
        , OutputFormatter
        , OutputFormatterWithDetails
        , OutputFormatterWithDetailsAndHeaders
        , Destination (..)
        , Callback
        , IPAddrSource (..)
        ) where

    import Control.Monad (when)
    import Control.Monad.IO.Class (liftIO)
    import qualified Data.ByteString as BS
    import qualified Data.ByteString.Builder as B (Builder, byteString)
    import Data.ByteString.Char8 (pack)
    import qualified Data.ByteString.Char8 as S8
    import qualified Data.ByteString.Lazy as LBS
    import Data.Default.Class (Default (def))
    import Data.IORef
    import Data.Maybe (fromMaybe, isJust, mapMaybe)
    #if __GLASGOW_HASKELL__ < 804
    import Data.Monoid ((<>))
    #endif
    import Data.Text.Encoding (decodeUtf8')
    import Data.Time (NominalDiffTime, UTCTime, diffUTCTime, getCurrentTime)
    import Network.HTTP.Types as H
    import Network.Wai
      ( Request(..), requestBodyLength, RequestBodyLength(..)
      , Middleware
      , Response, responseStatus, responseHeaders
      , getRequestBodyChunk
      )
    import Network.Wai.Internal (Response (..))
    import Network.Wai.Logger
    import System.Console.ANSI
    import System.IO (Handle, hFlush, stdout)
    import System.IO.Unsafe (unsafePerformIO)
    import System.Log.FastLogger

    import Network.Wai.Header (contentLength)
    import Network.Wai.Middleware.RequestLogger.Internal
    import Network.Wai.Parse
      ( Param
      , File
      , fileName
      , getRequestBodyType
      , lbsBackEnd
      , sinkRequestBody
      )

    -- | The logging format.
    data OutputFormat
      = Apache IPAddrSource
      | ApacheWithSettings ApacheSettings -- ^ @since 3.1.8
      | Detailed Bool -- ^ use colors?
      | DetailedWithSettings DetailedSettings -- ^ @since 3.1.3
      | CustomOutputFormat OutputFormatter
      | CustomOutputFormatWithDetails OutputFormatterWithDetails
      | CustomOutputFormatWithDetailsAndHeaders OutputFormatterWithDetailsAndHeaders

    -- | Settings for the `ApacheWithSettings` `OutputFormat`. This is purposely kept as an abstract data
    -- type so that new settings can be added without breaking backwards
    -- compatibility. In order to create an 'ApacheSettings' value, use 'defaultApacheSettings'
    -- and the various \'setApache\' functions to modify individual fields. For example:
    --
    -- > setApacheIPAddrSource FromHeader defaultApacheSettings
    --
    -- @since 3.1.8
    data ApacheSettings = ApacheSettings
        { ApacheSettings -> IPAddrSource
    apacheIPAddrSource :: IPAddrSource
        , ApacheSettings -> Request -> Maybe ByteString
    apacheUserGetter :: Request -> Maybe BS.ByteString
        , ApacheSettings -> Request -> Response -> Bool
    apacheRequestFilter :: Request -> Response -> Bool
        }

    defaultApacheSettings :: ApacheSettings
    defaultApacheSettings :: ApacheSettings
    defaultApacheSettings = ApacheSettings
        { apacheIPAddrSource :: IPAddrSource
    apacheIPAddrSource = IPAddrSource
    FromSocket
        , apacheRequestFilter :: Request -> Response -> Bool
    apacheRequestFilter = \Request
    _ Response
    _ -> Bool
    True
        , apacheUserGetter :: Request -> Maybe ByteString
    apacheUserGetter = \Request
    _ -> Maybe ByteString
    forall a. Maybe a
    Nothing
        }

    -- | Where to take IP addresses for clients from. See 'IPAddrSource' for more information.
    --
    -- Default value: FromSocket
    --
    -- @since 3.1.8
    setApacheIPAddrSource :: IPAddrSource -> ApacheSettings -> ApacheSettings
    setApacheIPAddrSource :: IPAddrSource -> ApacheSettings -> ApacheSettings
    setApacheIPAddrSource IPAddrSource
    x ApacheSettings
    y = ApacheSettings
    y { apacheIPAddrSource :: IPAddrSource
    apacheIPAddrSource = IPAddrSource
    x }

    -- | Function that allows you to filter which requests are logged, based on
    -- the request and response
    --
    -- Default: log all requests
    --
    -- @since 3.1.8
    setApacheRequestFilter :: (Request -> Response -> Bool) -> ApacheSettings -> ApacheSettings
    setApacheRequestFilter :: (Request -> Response -> Bool) -> ApacheSettings -> ApacheSettings
    setApacheRequestFilter Request -> Response -> Bool
    x ApacheSettings
    y = ApacheSettings
    y { apacheRequestFilter :: Request -> Response -> Bool
    apacheRequestFilter = Request -> Response -> Bool
    x }

    -- | Function that allows you to get the current user from the request, which
    -- will then be added in the log.
    --
    -- Default: return no user
    --
    -- @since 3.1.8
    setApacheUserGetter :: (Request -> Maybe BS.ByteString) -> ApacheSettings -> ApacheSettings
    setApacheUserGetter :: (Request -> Maybe ByteString) -> ApacheSettings -> ApacheSettings
    setApacheUserGetter Request -> Maybe ByteString
    x ApacheSettings
    y = ApacheSettings
    y { apacheUserGetter :: Request -> Maybe ByteString
    apacheUserGetter = Request -> Maybe ByteString
    x }

    -- | Settings for the `Detailed` `OutputFormat`.
    --
    -- `mModifyParams` allows you to pass a function to hide confidential
    -- information (such as passwords) from the logs. If result is `Nothing`, then
    -- the parameter is hidden. For example:
    -- > myformat = Detailed True (Just hidePasswords)
    -- >   where hidePasswords p@(k,v) = if k = "password" then (k, "***REDACTED***") else p
    --
    -- `mFilterRequests` allows you to filter which requests are logged, based on
    -- the request and response.
    --
    -- @since 3.1.3
    data DetailedSettings = DetailedSettings
        { DetailedSettings -> Bool
    useColors :: Bool
        , DetailedSettings -> Maybe (Param -> Maybe Param)
    mModifyParams :: Maybe (Param -> Maybe Param)
        , DetailedSettings -> Maybe (Request -> Response -> Bool)
    mFilterRequests :: Maybe (Request -> Response -> Bool)
        , DetailedSettings -> Bool
    mPrelogRequests :: Bool -- ^ @since 3.1.7
        }

    instance Default DetailedSettings where
        def :: DetailedSettings
    def = DetailedSettings
            { useColors :: Bool
    useColors = Bool
    True
            , mModifyParams :: Maybe (Param -> Maybe Param)
    mModifyParams = Maybe (Param -> Maybe Param)
    forall a. Maybe a
    Nothing
            , mFilterRequests :: Maybe (Request -> Response -> Bool)
    mFilterRequests = Maybe (Request -> Response -> Bool)
    forall a. Maybe a
    Nothing
            , mPrelogRequests :: Bool
    mPrelogRequests = Bool
    False
            }

    type OutputFormatter = ZonedDate -> Request -> Status -> Maybe Integer -> LogStr

    type OutputFormatterWithDetails
       = ZonedDate
      -> Request
      -> Status
      -> Maybe Integer
      -> NominalDiffTime
      -> [S8.ByteString]
      -> B.Builder
      -> LogStr

    -- | Same as @OutputFormatterWithDetails@ but with response headers included
    --
    -- This is useful if you wish to include arbitrary application data in your
    -- logs, e.g., an authenticated user ID, which you would set in a response
    -- header in your application and retrieve in the log formatter.
    --
    -- @since 3.0.27
    type OutputFormatterWithDetailsAndHeaders
       = ZonedDate -- ^ When the log message was generated
      -> Request -- ^ The WAI request
      -> Status -- ^ HTTP status code
      -> Maybe Integer -- ^ Response size
      -> NominalDiffTime -- ^ Duration of the request
      -> [S8.ByteString] -- ^ The request body
      -> B.Builder -- ^ Raw response
      -> [Header] -- ^ The response headers
      -> LogStr

    data Destination = Handle Handle
                     | Logger LoggerSet
                     | Callback Callback

    type Callback = LogStr -> IO ()

    -- | @RequestLoggerSettings@ is an instance of Default. See <https://hackage.haskell.org/package/data-default Data.Default> for more information.
    --
    -- @outputFormat@, @autoFlush@, and @destination@ are record fields
    -- for the record type @RequestLoggerSettings@, so they can be used to
    -- modify settings values using record syntax.
    data RequestLoggerSettings = RequestLoggerSettings
        {
          -- | Default value: @Detailed@ @True@.
          RequestLoggerSettings -> OutputFormat
    outputFormat :: OutputFormat
          -- | Only applies when using the @Handle@ constructor for @destination@.
          --
          -- Default value: @True@.
        , RequestLoggerSettings -> Bool
    autoFlush :: Bool
          -- | Default: @Handle@ @stdout@.
        , RequestLoggerSettings -> Destination
    destination :: Destination
        }

    defaultRequestLoggerSettings :: RequestLoggerSettings
    defaultRequestLoggerSettings :: RequestLoggerSettings
    defaultRequestLoggerSettings = RequestLoggerSettings
        { outputFormat :: OutputFormat
    outputFormat = Bool -> OutputFormat
    Detailed Bool
    True
        , autoFlush :: Bool
    autoFlush = Bool
    True
        , destination :: Destination
    destination = Handle -> Destination
    Handle Handle
    stdout
        }

    instance Default RequestLoggerSettings where
        def :: RequestLoggerSettings
    def = RequestLoggerSettings
    defaultRequestLoggerSettings

    mkRequestLogger :: RequestLoggerSettings -> IO Middleware
    mkRequestLogger :: RequestLoggerSettings -> IO Middleware
    mkRequestLogger RequestLoggerSettings{Bool
    Destination
    OutputFormat
    outputFormat :: RequestLoggerSettings -> OutputFormat
    autoFlush :: RequestLoggerSettings -> Bool
    destination :: RequestLoggerSettings -> Destination
    outputFormat :: OutputFormat
    autoFlush :: Bool
    destination :: Destination
    ..} = do
        let (LogStr -> IO ()
    callback, IO ()
    flusher) =
                case Destination
    destination of
                    Handle Handle
    h -> (Handle -> ByteString -> IO ()
    BS.hPutStr Handle
    h (ByteString -> IO ()) -> (LogStr -> ByteString) -> LogStr -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogStr -> ByteString
    logToByteString, Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    autoFlush (Handle -> IO ()
    hFlush Handle
    h))
                    Logger LoggerSet
    l -> (LoggerSet -> LogStr -> IO ()
    pushLogStr LoggerSet
    l, Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    autoFlush (LoggerSet -> IO ()
    flushLogStr LoggerSet
    l))
                    Callback LogStr -> IO ()
    c -> (LogStr -> IO ()
    c, () -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
            callbackAndFlush :: LogStr -> IO ()
    callbackAndFlush LogStr
    str = LogStr -> IO ()
    callback LogStr
    str IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    flusher
        case OutputFormat
    outputFormat of
            Apache IPAddrSource
    ipsrc -> do
                IO ByteString
    getdate <- IO () -> IO (IO ByteString)
    getDateGetter IO ()
    flusher
                ApacheLoggerActions
    apache <- IPAddrSource -> LogType -> IO ByteString -> IO ApacheLoggerActions
    initLogger IPAddrSource
    ipsrc ((LogStr -> IO ()) -> IO () -> LogType
    forall a. (a -> IO ()) -> IO () -> LogType' a
    LogCallback LogStr -> IO ()
    callback IO ()
    flusher) IO ByteString
    getdate
                Middleware -> IO Middleware
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Middleware -> IO Middleware) -> Middleware -> IO Middleware
    forall a b. (a -> b) -> a -> b
    $ (Request -> Response -> Bool) -> ApacheLoggerActions -> Middleware
    apacheMiddleware (\Request
    _ Response
    _ -> Bool
    True) ApacheLoggerActions
    apache
            ApacheWithSettings ApacheSettings{IPAddrSource
    Request -> Maybe ByteString
    Request -> Response -> Bool
    apacheIPAddrSource :: ApacheSettings -> IPAddrSource
    apacheUserGetter :: ApacheSettings -> Request -> Maybe ByteString
    apacheRequestFilter :: ApacheSettings -> Request -> Response -> Bool
    apacheIPAddrSource :: IPAddrSource
    apacheUserGetter :: Request -> Maybe ByteString
    apacheRequestFilter :: Request -> Response -> Bool
    ..} -> do
                IO ByteString
    getdate <- IO () -> IO (IO ByteString)
    getDateGetter IO ()
    flusher
                ApacheLoggerActions
    apache <- Maybe (Request -> Maybe ByteString)
    -> IPAddrSource
    -> LogType
    -> IO ByteString
    -> IO ApacheLoggerActions
    forall user.
    ToLogStr user =>
    Maybe (Request -> Maybe user)
    -> IPAddrSource
    -> LogType
    -> IO ByteString
    -> IO ApacheLoggerActions
    initLoggerUser ((Request -> Maybe ByteString)
    -> Maybe (Request -> Maybe ByteString)
    forall a. a -> Maybe a
    Just Request -> Maybe ByteString
    apacheUserGetter) IPAddrSource
    apacheIPAddrSource ((LogStr -> IO ()) -> IO () -> LogType
    forall a. (a -> IO ()) -> IO () -> LogType' a
    LogCallback LogStr -> IO ()
    callback IO ()
    flusher) IO ByteString
    getdate
                Middleware -> IO Middleware
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Middleware -> IO Middleware) -> Middleware -> IO Middleware
    forall a b. (a -> b) -> a -> b
    $ (Request -> Response -> Bool) -> ApacheLoggerActions -> Middleware
    apacheMiddleware Request -> Response -> Bool
    apacheRequestFilter ApacheLoggerActions
    apache
            Detailed Bool
    useColors ->
                let settings :: DetailedSettings
    settings = DetailedSettings
    forall a. Default a => a
    def { useColors :: Bool
    useColors = Bool
    useColors}
                in (LogStr -> IO ()) -> DetailedSettings -> IO Middleware
    detailedMiddleware LogStr -> IO ()
    callbackAndFlush DetailedSettings
    settings
            DetailedWithSettings DetailedSettings
    settings ->
                (LogStr -> IO ()) -> DetailedSettings -> IO Middleware
    detailedMiddleware LogStr -> IO ()
    callbackAndFlush DetailedSettings
    settings
            CustomOutputFormat OutputFormatter
    formatter -> do
                IO ByteString
    getDate <- IO () -> IO (IO ByteString)
    getDateGetter IO ()
    flusher
                Middleware -> IO Middleware
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Middleware -> IO Middleware) -> Middleware -> IO Middleware
    forall a b. (a -> b) -> a -> b
    $ (LogStr -> IO ()) -> IO ByteString -> OutputFormatter -> Middleware
    customMiddleware LogStr -> IO ()
    callbackAndFlush IO ByteString
    getDate OutputFormatter
    formatter
            CustomOutputFormatWithDetails OutputFormatterWithDetails
    formatter -> do
                IO ByteString
    getdate <- IO () -> IO (IO ByteString)
    getDateGetter IO ()
    flusher
                Middleware -> IO Middleware
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Middleware -> IO Middleware) -> Middleware -> IO Middleware
    forall a b. (a -> b) -> a -> b
    $ (LogStr -> IO ())
    -> IO ByteString -> OutputFormatterWithDetails -> Middleware
    customMiddlewareWithDetails LogStr -> IO ()
    callbackAndFlush IO ByteString
    getdate OutputFormatterWithDetails
    formatter
            CustomOutputFormatWithDetailsAndHeaders OutputFormatterWithDetailsAndHeaders
    formatter -> do
                IO ByteString
    getdate <- IO () -> IO (IO ByteString)
    getDateGetter IO ()
    flusher
                Middleware -> IO Middleware
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Middleware -> IO Middleware) -> Middleware -> IO Middleware
    forall a b. (a -> b) -> a -> b
    $ (LogStr -> IO ())
    -> IO ByteString
    -> OutputFormatterWithDetailsAndHeaders
    -> Middleware
    customMiddlewareWithDetailsAndHeaders LogStr -> IO ()
    callbackAndFlush IO ByteString
    getdate OutputFormatterWithDetailsAndHeaders
    formatter

    apacheMiddleware :: (Request -> Response -> Bool) -> ApacheLoggerActions -> Middleware
    apacheMiddleware :: (Request -> Response -> Bool) -> ApacheLoggerActions -> Middleware
    apacheMiddleware Request -> Response -> Bool
    applyRequestFilter ApacheLoggerActions
    ala Application
    app Request
    req Response -> IO ResponseReceived
    sendResponse = Application
    app Request
    req ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \Response
    res -> do
        Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Request -> Response -> Bool
    applyRequestFilter Request
    req Response
    res) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
            ApacheLoggerActions -> ApacheLogger
    apacheLogger ApacheLoggerActions
    ala Request
    req (Response -> Status
    responseStatus Response
    res) (Maybe Integer -> IO ()) -> Maybe Integer -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [(HeaderName, ByteString)] -> Maybe Integer
    contentLength (Response -> [(HeaderName, ByteString)]
    responseHeaders Response
    res)
        Response -> IO ResponseReceived
    sendResponse Response
    res

    customMiddleware :: Callback -> IO ZonedDate -> OutputFormatter -> Middleware
    customMiddleware :: (LogStr -> IO ()) -> IO ByteString -> OutputFormatter -> Middleware
    customMiddleware LogStr -> IO ()
    cb IO ByteString
    getdate OutputFormatter
    formatter Application
    app Request
    req Response -> IO ResponseReceived
    sendResponse = Application
    app Request
    req ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \Response
    res -> do
        ByteString
    date <- IO ByteString -> IO ByteString
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ByteString
    getdate
        let msize :: Maybe Integer
    msize = [(HeaderName, ByteString)] -> Maybe Integer
    contentLength (Response -> [(HeaderName, ByteString)]
    responseHeaders Response
    res)
        IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ LogStr -> IO ()
    cb (LogStr -> IO ()) -> LogStr -> IO ()
    forall a b. (a -> b) -> a -> b
    $ OutputFormatter
    formatter ByteString
    date Request
    req (Response -> Status
    responseStatus Response
    res) Maybe Integer
    msize
        Response -> IO ResponseReceived
    sendResponse Response
    res

    customMiddlewareWithDetails :: Callback -> IO ZonedDate -> OutputFormatterWithDetails -> Middleware
    customMiddlewareWithDetails :: (LogStr -> IO ())
    -> IO ByteString -> OutputFormatterWithDetails -> Middleware
    customMiddlewareWithDetails LogStr -> IO ()
    cb IO ByteString
    getdate OutputFormatterWithDetails
    formatter Application
    app Request
    req Response -> IO ResponseReceived
    sendResponse = do
      (Request
    req', [ByteString]
    reqBody) <- Request -> IO (Request, [ByteString])
    getRequestBody Request
    req
      UTCTime
    t0 <- IO UTCTime
    getCurrentTime
      Application
    app Request
    req' ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \Response
    res -> do
        UTCTime
    t1 <- IO UTCTime
    getCurrentTime
        ByteString
    date <- IO ByteString -> IO ByteString
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ByteString
    getdate
        let msize :: Maybe Integer
    msize = [(HeaderName, ByteString)] -> Maybe Integer
    contentLength (Response -> [(HeaderName, ByteString)]
    responseHeaders Response
    res)
        IORef Builder
    builderIO <- Builder -> IO (IORef Builder)
    forall a. a -> IO (IORef a)
    newIORef (Builder -> IO (IORef Builder)) -> Builder -> IO (IORef Builder)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    B.byteString ByteString
    ""
        Response
    res' <- IORef Builder -> Response -> IO Response
    recordChunks IORef Builder
    builderIO Response
    res
        ResponseReceived
    rspRcv <- Response -> IO ResponseReceived
    sendResponse Response
    res'
        ()
    _ <- IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> (Builder -> IO ()) -> Builder -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogStr -> IO ()
    cb (LogStr -> IO ()) -> (Builder -> LogStr) -> Builder -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .
          OutputFormatterWithDetails
    formatter ByteString
    date Request
    req' (Response -> Status
    responseStatus Response
    res') Maybe Integer
    msize (UTCTime
    t1 UTCTime -> UTCTime -> NominalDiffTime
    `diffUTCTime` UTCTime
    t0) [ByteString]
    reqBody (Builder -> IO ()) -> IO Builder -> IO ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<
          IORef Builder -> IO Builder
    forall a. IORef a -> IO a
    readIORef IORef Builder
    builderIO
        ResponseReceived -> IO ResponseReceived
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResponseReceived
    rspRcv

    customMiddlewareWithDetailsAndHeaders :: Callback -> IO ZonedDate -> OutputFormatterWithDetailsAndHeaders -> Middleware
    customMiddlewareWithDetailsAndHeaders :: (LogStr -> IO ())
    -> IO ByteString
    -> OutputFormatterWithDetailsAndHeaders
    -> Middleware
    customMiddlewareWithDetailsAndHeaders LogStr -> IO ()
    cb IO ByteString
    getdate OutputFormatterWithDetailsAndHeaders
    formatter Application
    app Request
    req Response -> IO ResponseReceived
    sendResponse = do
      (Request
    req', [ByteString]
    reqBody) <- Request -> IO (Request, [ByteString])
    getRequestBody Request
    req
      UTCTime
    t0 <- IO UTCTime
    getCurrentTime
      Application
    app Request
    req' ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \Response
    res -> do
        UTCTime
    t1 <- IO UTCTime
    getCurrentTime
        ByteString
    date <- IO ByteString -> IO ByteString
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO IO ByteString
    getdate
        let msize :: Maybe Integer
    msize = [(HeaderName, ByteString)] -> Maybe Integer
    contentLength (Response -> [(HeaderName, ByteString)]
    responseHeaders Response
    res)
        IORef Builder
    builderIO <- Builder -> IO (IORef Builder)
    forall a. a -> IO (IORef a)
    newIORef (Builder -> IO (IORef Builder)) -> Builder -> IO (IORef Builder)
    forall a b. (a -> b) -> a -> b
    $ ByteString -> Builder
    B.byteString ByteString
    ""
        Response
    res' <- IORef Builder -> Response -> IO Response
    recordChunks IORef Builder
    builderIO Response
    res
        ResponseReceived
    rspRcv <- Response -> IO ResponseReceived
    sendResponse Response
    res'
        ()
    _ <- do
          Builder
    rawResponse <- IORef Builder -> IO Builder
    forall a. IORef a -> IO a
    readIORef IORef Builder
    builderIO
          let status :: Status
    status = Response -> Status
    responseStatus Response
    res'
              duration :: NominalDiffTime
    duration = UTCTime
    t1 UTCTime -> UTCTime -> NominalDiffTime
    `diffUTCTime` UTCTime
    t0
              resHeaders :: [(HeaderName, ByteString)]
    resHeaders = Response -> [(HeaderName, ByteString)]
    responseHeaders Response
    res'
          IO () -> IO ()
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> IO ()) -> (LogStr -> IO ()) -> LogStr -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . LogStr -> IO ()
    cb (LogStr -> IO ()) -> LogStr -> IO ()
    forall a b. (a -> b) -> a -> b
    $ OutputFormatterWithDetailsAndHeaders
    formatter ByteString
    date Request
    req' Status
    status Maybe Integer
    msize NominalDiffTime
    duration [ByteString]
    reqBody Builder
    rawResponse [(HeaderName, ByteString)]
    resHeaders
        ResponseReceived -> IO ResponseReceived
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResponseReceived
    rspRcv
    -- | Production request logger middleware.
    --
    -- This uses the 'Apache' logging format, and takes IP addresses for clients from
    -- the socket (see 'IPAddrSource' for more information). It logs to 'stdout'.
    {-# NOINLINE logStdout #-}
    logStdout :: Middleware
    logStdout :: Middleware
    logStdout = IO Middleware -> Middleware
    forall a. IO a -> a
    unsafePerformIO (IO Middleware -> Middleware) -> IO Middleware -> Middleware
    forall a b. (a -> b) -> a -> b
    $ RequestLoggerSettings -> IO Middleware
    mkRequestLogger RequestLoggerSettings
    forall a. Default a => a
    def { outputFormat :: OutputFormat
    outputFormat = IPAddrSource -> OutputFormat
    Apache IPAddrSource
    FromSocket }

    -- | Development request logger middleware.
    --
    -- This uses the 'Detailed' 'True' logging format and logs to 'stdout'.
    {-# NOINLINE logStdoutDev #-}
    logStdoutDev :: Middleware
    logStdoutDev :: Middleware
    logStdoutDev = IO Middleware -> Middleware
    forall a. IO a -> a
    unsafePerformIO (IO Middleware -> Middleware) -> IO Middleware -> Middleware
    forall a b. (a -> b) -> a -> b
    $ RequestLoggerSettings -> IO Middleware
    mkRequestLogger RequestLoggerSettings
    forall a. Default a => a
    def

    -- | Prints a message using the given callback function for each request.
    -- This is not for serious production use- it is inefficient.
    -- It immediately consumes a POST body and fills it back in and is otherwise inefficient
    --
    -- Note that it logs the request immediately when it is received.
    -- This meanst that you can accurately see the interleaving of requests.
    -- And if the app crashes you have still logged the request.
    -- However, if you are simulating 10 simultaneous users you may find this confusing.
    --
    -- This is lower-level - use 'logStdoutDev' unless you need greater control.
    --
    -- Example ouput:
    --
    -- > GET search
    -- >   Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*​/​*;q=0.8
    -- >   Status: 200 OK 0.010555s
    -- >
    -- > GET static/css/normalize.css
    -- >   Params: [("LXwioiBG","")]
    -- >   Accept: text/css,*​/​*;q=0.1
    -- >   Status: 304 Not Modified 0.010555s
    detailedMiddleware :: Callback -> DetailedSettings -> IO Middleware

    -- NB: The *​/​* in the comments above have "zero-width spaces" in them, so the
    -- CPP doesn't screw up everything. So don't copy those; they're technically wrong.
    detailedMiddleware :: (LogStr -> IO ()) -> DetailedSettings -> IO Middleware
    detailedMiddleware LogStr -> IO ()
    cb DetailedSettings
    settings =
        let (Color -> ByteString -> [ByteString]
    ansiColor, ByteString -> [ByteString]
    ansiMethod, ByteString -> ByteString -> [ByteString]
    ansiStatusCode) =
              if DetailedSettings -> Bool
    useColors DetailedSettings
    settings
                then (Color -> ByteString -> [ByteString]
    ansiColor', ByteString -> [ByteString]
    ansiMethod', ByteString -> ByteString -> [ByteString]
    ansiStatusCode')
                else (\Color
    _ ByteString
    t -> [ByteString
    t], (ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[]), \ByteString
    _ ByteString
    t -> [ByteString
    t])

        in Middleware -> IO Middleware
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Middleware -> IO Middleware) -> Middleware -> IO Middleware
    forall a b. (a -> b) -> a -> b
    $ (LogStr -> IO ())
    -> DetailedSettings
    -> (Color -> ByteString -> [ByteString])
    -> (ByteString -> [ByteString])
    -> (ByteString -> ByteString -> [ByteString])
    -> Middleware
    detailedMiddleware' LogStr -> IO ()
    cb DetailedSettings
    settings Color -> ByteString -> [ByteString]
    ansiColor ByteString -> [ByteString]
    ansiMethod ByteString -> ByteString -> [ByteString]
    ansiStatusCode

    ansiColor' :: Color -> BS.ByteString -> [BS.ByteString]
    ansiColor' :: Color -> ByteString -> [ByteString]
    ansiColor' Color
    color ByteString
    bs =
        [ String -> ByteString
    pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [SGR] -> String
    setSGRCode [ConsoleLayer -> ColorIntensity -> Color -> SGR
    SetColor ConsoleLayer
    Foreground ColorIntensity
    Dull Color
    color]
        , ByteString
    bs
        , String -> ByteString
    pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ [SGR] -> String
    setSGRCode [SGR
    Reset]
        ]

    -- | Tags http method with a unique color.
    ansiMethod' :: BS.ByteString -> [BS.ByteString]
    ansiMethod' :: ByteString -> [ByteString]
    ansiMethod' ByteString
    m = case ByteString
    m of
        ByteString
    "GET"    -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Cyan ByteString
    m
        ByteString
    "HEAD"   -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Cyan ByteString
    m
        ByteString
    "PUT"    -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Green ByteString
    m
        ByteString
    "POST"   -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Yellow ByteString
    m
        ByteString
    "DELETE" -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Red ByteString
    m
        ByteString
    _        -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Magenta ByteString
    m

    ansiStatusCode' :: BS.ByteString -> BS.ByteString -> [BS.ByteString]
    ansiStatusCode' :: ByteString -> ByteString -> [ByteString]
    ansiStatusCode' ByteString
    c ByteString
    t = case Int -> ByteString -> ByteString
    S8.take Int
    1 ByteString
    c of
        ByteString
    "2"     -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Green ByteString
    t
        ByteString
    "3"     -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Yellow ByteString
    t
        ByteString
    "4"     -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Red ByteString
    t
        ByteString
    "5"     -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Magenta ByteString
    t
        ByteString
    _       -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Blue ByteString
    t

    recordChunks :: IORef B.Builder -> Response -> IO Response
    recordChunks :: IORef Builder -> Response -> IO Response
    recordChunks IORef Builder
    i (ResponseStream Status
    s [(HeaderName, ByteString)]
    h StreamingBody
    sb) =
      Response -> IO Response
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Response -> IO Response)
    -> (StreamingBody -> Response) -> StreamingBody -> IO Response
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Status -> [(HeaderName, ByteString)] -> StreamingBody -> Response
    ResponseStream Status
    s [(HeaderName, ByteString)]
    h (StreamingBody -> IO Response) -> StreamingBody -> IO Response
    forall a b. (a -> b) -> a -> b
    $ (\Builder -> IO ()
    send IO ()
    flush -> StreamingBody
    sb (\Builder
    b -> IORef Builder -> (Builder -> Builder) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef Builder
    i (Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    b) IO () -> IO () -> IO ()
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Builder -> IO ()
    send Builder
    b) IO ()
    flush)
    recordChunks IORef Builder
    i (ResponseBuilder Status
    s [(HeaderName, ByteString)]
    h Builder
    b) =
      IORef Builder -> (Builder -> Builder) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef Builder
    i (Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    b) IO () -> IO Response -> IO Response
    forall a b. IO a -> IO b -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> Response -> IO Response
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Status -> [(HeaderName, ByteString)] -> Builder -> Response
    ResponseBuilder Status
    s [(HeaderName, ByteString)]
    h Builder
    b)
    recordChunks IORef Builder
    _ Response
    r =
      Response -> IO Response
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Response
    r

    getRequestBody :: Request -> IO (Request, [S8.ByteString])
    getRequestBody :: Request -> IO (Request, [ByteString])
    getRequestBody Request
    req = do
      let loop :: ([ByteString] -> c) -> IO c
    loop [ByteString] -> c
    front = do
             ByteString
    bs <- Request -> IO ByteString
    getRequestBodyChunk Request
    req
             if ByteString -> Bool
    S8.null ByteString
    bs
                 then c -> IO c
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (c -> IO c) -> c -> IO c
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> c
    front []
                 else ([ByteString] -> c) -> IO c
    loop (([ByteString] -> c) -> IO c) -> ([ByteString] -> c) -> IO c
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> c
    front ([ByteString] -> c)
    -> ([ByteString] -> [ByteString]) -> [ByteString] -> c
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (ByteString
    bsByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :)
      [ByteString]
    body <- ([ByteString] -> [ByteString]) -> IO [ByteString]
    forall {c}. ([ByteString] -> c) -> IO c
    loop [ByteString] -> [ByteString]
    forall a. a -> a
    id
      -- logging the body here consumes it, so fill it back up
      -- obviously not efficient, but this is the development logger
      --
      -- Note: previously, we simply used CL.sourceList. However,
      -- that meant that you could read the request body in twice.
      -- While that in itself is not a problem, the issue is that,
      -- in production, you wouldn't be able to do this, and
      -- therefore some bugs wouldn't show up during testing. This
      -- implementation ensures that each chunk is only returned
      -- once.
      IORef [ByteString]
    ichunks <- [ByteString] -> IO (IORef [ByteString])
    forall a. a -> IO (IORef a)
    newIORef [ByteString]
    body
      let rbody :: IO ByteString
    rbody = IORef [ByteString]
    -> ([ByteString] -> ([ByteString], ByteString)) -> IO ByteString
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef [ByteString]
    ichunks (([ByteString] -> ([ByteString], ByteString)) -> IO ByteString)
    -> ([ByteString] -> ([ByteString], ByteString)) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \[ByteString]
    chunks ->
             case [ByteString]
    chunks of
                 [] -> ([], ByteString
    S8.empty)
                 ByteString
    x:[ByteString]
    y -> ([ByteString]
    y, ByteString
    x)
      let req' :: Request
    req' = Request
    req { requestBody :: IO ByteString
    requestBody = IO ByteString
    rbody }
      (Request, [ByteString]) -> IO (Request, [ByteString])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Request
    req', [ByteString]
    body)

    detailedMiddleware' :: Callback
                        -> DetailedSettings
                        -> (Color -> BS.ByteString -> [BS.ByteString])
                        -> (BS.ByteString -> [BS.ByteString])
                        -> (BS.ByteString -> BS.ByteString -> [BS.ByteString])
                        -> Middleware
    detailedMiddleware' :: (LogStr -> IO ())
    -> DetailedSettings
    -> (Color -> ByteString -> [ByteString])
    -> (ByteString -> [ByteString])
    -> (ByteString -> ByteString -> [ByteString])
    -> Middleware
    detailedMiddleware' LogStr -> IO ()
    cb DetailedSettings{Bool
    Maybe (Param -> Maybe Param)
    Maybe (Request -> Response -> Bool)
    mModifyParams :: DetailedSettings -> Maybe (Param -> Maybe Param)
    mFilterRequests :: DetailedSettings -> Maybe (Request -> Response -> Bool)
    useColors :: DetailedSettings -> Bool
    mPrelogRequests :: DetailedSettings -> Bool
    useColors :: Bool
    mModifyParams :: Maybe (Param -> Maybe Param)
    mFilterRequests :: Maybe (Request -> Response -> Bool)
    mPrelogRequests :: Bool
    ..} Color -> ByteString -> [ByteString]
    ansiColor ByteString -> [ByteString]
    ansiMethod ByteString -> ByteString -> [ByteString]
    ansiStatusCode Application
    app Request
    req Response -> IO ResponseReceived
    sendResponse = do
      (Request
    req', [ByteString]
    body) <-
          -- second tuple item should not be necessary, but a test runner might mess it up
          case (Request -> RequestBodyLength
    requestBodyLength Request
    req, [(HeaderName, ByteString)] -> Maybe Integer
    contentLength (Request -> [(HeaderName, ByteString)]
    requestHeaders Request
    req)) of
              -- log the request body if it is small
              (KnownLength Word64
    len, Maybe Integer
    _) | Word64
    len Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Word64
    2048 -> Request -> IO (Request, [ByteString])
    getRequestBody Request
    req
              (RequestBodyLength
    _, Just Integer
    len)        | Integer
    len Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Integer
    2048 -> Request -> IO (Request, [ByteString])
    getRequestBody Request
    req
              (RequestBodyLength, Maybe Integer)
    _ -> (Request, [ByteString]) -> IO (Request, [ByteString])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Request
    req, [])

      let reqbodylog :: p -> [ByteString]
    reqbodylog p
    _ = if [ByteString] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ByteString]
    body Bool -> Bool -> Bool
    || Maybe (Param -> Maybe Param) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (Param -> Maybe Param)
    mModifyParams
                          then [ByteString
    ""]
                          else Color -> ByteString -> [ByteString]
    ansiColor Color
    White ByteString
    "  Request Body: " [ByteString] -> [ByteString] -> [ByteString]
    forall a. Semigroup a => a -> a -> a
    <> [ByteString]
    body [ByteString] -> [ByteString] -> [ByteString]
    forall a. Semigroup a => a -> a -> a
    <> [ByteString
    "\n"]
          reqbody :: [ByteString]
    reqbody = (ByteString -> [ByteString]) -> [ByteString] -> [ByteString]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap ((UnicodeException -> [ByteString])
    -> (Text -> [ByteString])
    -> Either UnicodeException Text
    -> [ByteString]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either ([ByteString] -> UnicodeException -> [ByteString]
    forall a b. a -> b -> a
    const [ByteString
    ""]) Text -> [ByteString]
    forall {p}. p -> [ByteString]
    reqbodylog (Either UnicodeException Text -> [ByteString])
    -> (ByteString -> Either UnicodeException Text)
    -> ByteString
    -> [ByteString]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> Either UnicodeException Text
    decodeUtf8') [ByteString]
    body
      [Param]
    postParams <- if Request -> ByteString
    requestMethod Request
    req ByteString -> [ByteString] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [ByteString
    "GET", ByteString
    "HEAD"]
          then [Param] -> IO [Param]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
          else do ([Param]
    unmodifiedPostParams, [File ByteString]
    files) <- IO ([Param], [File ByteString]) -> IO ([Param], [File ByteString])
    forall a. IO a -> IO a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO ([Param], [File ByteString])
     -> IO ([Param], [File ByteString]))
    -> IO ([Param], [File ByteString])
    -> IO ([Param], [File ByteString])
    forall a b. (a -> b) -> a -> b
    $ [ByteString] -> IO ([Param], [File ByteString])
    allPostParams [ByteString]
    body
                  let postParams :: [Param]
    postParams =
                        case Maybe (Param -> Maybe Param)
    mModifyParams of
                          Just Param -> Maybe Param
    modifyParams -> (Param -> Maybe Param) -> [Param] -> [Param]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe Param -> Maybe Param
    modifyParams [Param]
    unmodifiedPostParams
                          Maybe (Param -> Maybe Param)
    Nothing -> [Param]
    unmodifiedPostParams
                  [Param] -> IO [Param]
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Param] -> IO [Param]) -> [Param] -> IO [Param]
    forall a b. (a -> b) -> a -> b
    $ ([Param], [File ByteString]) -> [Param]
    collectPostParams ([Param]
    postParams, [File ByteString]
    files)

      let getParams :: [Param]
    getParams = (QueryItem -> Param) -> [QueryItem] -> [Param]
    forall a b. (a -> b) -> [a] -> [b]
    map QueryItem -> Param
    emptyGetParam ([QueryItem] -> [Param]) -> [QueryItem] -> [Param]
    forall a b. (a -> b) -> a -> b
    $ Request -> [QueryItem]
    queryString Request
    req
          accept :: ByteString
    accept = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe ByteString
    "" (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ HeaderName -> [(HeaderName, ByteString)] -> Maybe ByteString
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup HeaderName
    H.hAccept ([(HeaderName, ByteString)] -> Maybe ByteString)
    -> [(HeaderName, ByteString)] -> Maybe ByteString
    forall a b. (a -> b) -> a -> b
    $ Request -> [(HeaderName, ByteString)]
    requestHeaders Request
    req
          params :: [ByteString]
    params = let par :: [ByteString]
    par | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Param] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Param]
    postParams = [String -> ByteString
    pack ([Param] -> String
    forall a. Show a => a -> String
    show [Param]
    postParams)]
                          | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ [Param] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Param]
    getParams  = [String -> ByteString
    pack ([Param] -> String
    forall a. Show a => a -> String
    show [Param]
    getParams)]
                          | Bool
    otherwise             = []
                  in if [ByteString] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ByteString]
    par then [ByteString
    ""] else Color -> ByteString -> [ByteString]
    ansiColor Color
    White ByteString
    "  Params: " [ByteString] -> [ByteString] -> [ByteString]
    forall a. Semigroup a => a -> a -> a
    <> [ByteString]
    par [ByteString] -> [ByteString] -> [ByteString]
    forall a. Semigroup a => a -> a -> a
    <> [ByteString
    "\n"]

      UTCTime
    t0 <- IO UTCTime
    getCurrentTime

      -- Optionally prelog the request
      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    mPrelogRequests (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $
        LogStr -> IO ()
    cb (LogStr -> IO ()) -> LogStr -> IO ()
    forall a b. (a -> b) -> a -> b
    $ LogStr
    "PRELOGGING REQUEST: " LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> [ByteString] -> [ByteString] -> ByteString -> LogStr
    forall (t :: * -> *) m.
    (Foldable t, ToLogStr m) =>
    t m -> t m -> m -> LogStr
    mkRequestLog [ByteString]
    params [ByteString]
    reqbody ByteString
    accept

      Application
    app Request
    req' ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \Response
    rsp -> do
          case Maybe (Request -> Response -> Bool)
    mFilterRequests of
            Just Request -> Response -> Bool
    f | Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ Request -> Response -> Bool
    f Request
    req' Response
    rsp -> () -> IO ()
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            Maybe (Request -> Response -> Bool)
    _ -> do
              let isRaw :: Bool
    isRaw =
                      case Response
    rsp of
                          ResponseRaw{} -> Bool
    True
                          Response
    _ -> Bool
    False
                  stCode :: ByteString
    stCode = Response -> ByteString
    statusBS Response
    rsp
                  stMsg :: ByteString
    stMsg = Response -> ByteString
    msgBS Response
    rsp
              UTCTime
    t1 <- IO UTCTime
    getCurrentTime

              -- log the status of the response
              LogStr -> IO ()
    cb (LogStr -> IO ()) -> LogStr -> IO ()
    forall a b. (a -> b) -> a -> b
    $
                [ByteString] -> [ByteString] -> ByteString -> LogStr
    forall (t :: * -> *) m.
    (Foldable t, ToLogStr m) =>
    t m -> t m -> m -> LogStr
    mkRequestLog [ByteString]
    params [ByteString]
    reqbody ByteString
    accept
                LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> Bool -> ByteString -> ByteString -> UTCTime -> UTCTime -> LogStr
    mkResponseLog Bool
    isRaw ByteString
    stCode ByteString
    stMsg UTCTime
    t1 UTCTime
    t0

          Response -> IO ResponseReceived
    sendResponse Response
    rsp
      where
        allPostParams :: [ByteString] -> IO ([Param], [File ByteString])
    allPostParams [ByteString]
    body =
            case Request -> Maybe RequestBodyType
    getRequestBodyType Request
    req of
                Maybe RequestBodyType
    Nothing -> ([Param], [File ByteString]) -> IO ([Param], [File ByteString])
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
                Just RequestBodyType
    rbt -> do
                    IORef [ByteString]
    ichunks <- [ByteString] -> IO (IORef [ByteString])
    forall a. a -> IO (IORef a)
    newIORef [ByteString]
    body
                    let rbody :: IO ByteString
    rbody = IORef [ByteString]
    -> ([ByteString] -> ([ByteString], ByteString)) -> IO ByteString
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef [ByteString]
    ichunks (([ByteString] -> ([ByteString], ByteString)) -> IO ByteString)
    -> ([ByteString] -> ([ByteString], ByteString)) -> IO ByteString
    forall a b. (a -> b) -> a -> b
    $ \[ByteString]
    chunks ->
                            case [ByteString]
    chunks of
                                [] -> ([], ByteString
    S8.empty)
                                ByteString
    x:[ByteString]
    y -> ([ByteString]
    y, ByteString
    x)
                    BackEnd ByteString
    -> RequestBodyType
    -> IO ByteString
    -> IO ([Param], [File ByteString])
    forall y.
    BackEnd y
    -> RequestBodyType -> IO ByteString -> IO ([Param], [File y])
    sinkRequestBody BackEnd ByteString
    forall (m :: * -> *) ignored1 ignored2.
    Monad m =>
    ignored1 -> ignored2 -> m ByteString -> m ByteString
    lbsBackEnd RequestBodyType
    rbt IO ByteString
    rbody

        emptyGetParam :: (BS.ByteString, Maybe BS.ByteString) -> (BS.ByteString, BS.ByteString)
        emptyGetParam :: QueryItem -> Param
    emptyGetParam (ByteString
    k, Just ByteString
    v) = (ByteString
    k,ByteString
    v)
        emptyGetParam (ByteString
    k, Maybe ByteString
    Nothing) = (ByteString
    k,ByteString
    "")

        collectPostParams :: ([Param], [File LBS.ByteString]) -> [Param]
        collectPostParams :: ([Param], [File ByteString]) -> [Param]
    collectPostParams ([Param]
    postParams, [File ByteString]
    files) = [Param]
    postParams [Param] -> [Param] -> [Param]
    forall a. [a] -> [a] -> [a]
    ++
          (File ByteString -> Param) -> [File ByteString] -> [Param]
    forall a b. (a -> b) -> [a] -> [b]
    map (\(ByteString
    k,FileInfo ByteString
    v) -> (ByteString
    k, ByteString
    "FILE: " ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> FileInfo ByteString -> ByteString
    forall c. FileInfo c -> ByteString
    fileName FileInfo ByteString
    v)) [File ByteString]
    files

        mkRequestLog :: (Foldable t, ToLogStr m) => t m -> t m -> m -> LogStr
        mkRequestLog :: forall (t :: * -> *) m.
    (Foldable t, ToLogStr m) =>
    t m -> t m -> m -> LogStr
    mkRequestLog t m
    params t m
    reqbody m
    accept =
            (ByteString -> LogStr) -> [ByteString] -> LogStr
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ByteString -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr (ByteString -> [ByteString]
    ansiMethod (Request -> ByteString
    requestMethod Request
    req))
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> LogStr
    " "
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr (Request -> ByteString
    rawPathInfo Request
    req)
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> LogStr
    "\n"
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> (m -> LogStr) -> t m -> LogStr
    forall m a. Monoid m => (a -> m) -> t a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap m -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr t m
    params
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> (m -> LogStr) -> t m -> LogStr
    forall m a. Monoid m => (a -> m) -> t a -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap m -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr t m
    reqbody
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> (ByteString -> LogStr) -> [ByteString] -> LogStr
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ByteString -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr (Color -> ByteString -> [ByteString]
    ansiColor Color
    White ByteString
    "  Accept: ")
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> m -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr m
    accept
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> LogStr
    "\n"

        mkResponseLog :: Bool -> S8.ByteString -> S8.ByteString -> UTCTime -> UTCTime -> LogStr
        mkResponseLog :: Bool -> ByteString -> ByteString -> UTCTime -> UTCTime -> LogStr
    mkResponseLog Bool
    isRaw ByteString
    stCode ByteString
    stMsg UTCTime
    t1 UTCTime
    t0 =
          if Bool
    isRaw then LogStr
    "" else
            (ByteString -> LogStr) -> [ByteString] -> LogStr
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ByteString -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr (Color -> ByteString -> [ByteString]
    ansiColor Color
    White ByteString
    "  Status: ")
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> (ByteString -> LogStr) -> [ByteString] -> LogStr
    forall m a. Monoid m => (a -> m) -> [a] -> m
    forall (t :: * -> *) m a.
    (Foldable t, Monoid m) =>
    (a -> m) -> t a -> m
    foldMap ByteString -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr (ByteString -> ByteString -> [ByteString]
    ansiStatusCode ByteString
    stCode (ByteString
    stCode ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    " " ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    stMsg))
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> LogStr
    " "
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> ByteString -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr (String -> ByteString
    pack (String -> ByteString) -> String -> ByteString
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> String
    forall a. Show a => a -> String
    show (NominalDiffTime -> String) -> NominalDiffTime -> String
    forall a b. (a -> b) -> a -> b
    $ UTCTime -> UTCTime -> NominalDiffTime
    diffUTCTime UTCTime
    t1 UTCTime
    t0)
            LogStr -> LogStr -> LogStr
    forall a. Semigroup a => a -> a -> a
    <> LogStr
    "\n"

    statusBS :: Response -> BS.ByteString
    statusBS :: Response -> ByteString
    statusBS = String -> ByteString
    pack (String -> ByteString)
    -> (Response -> String) -> Response -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String
    forall a. Show a => a -> String
    show (Int -> String) -> (Response -> Int) -> Response -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Status -> Int
    statusCode (Status -> Int) -> (Response -> Status) -> Response -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Response -> Status
    responseStatus

    msgBS :: Response -> BS.ByteString
    msgBS :: Response -> ByteString
    msgBS = Status -> ByteString
    statusMessage (Status -> ByteString)
    -> (Response -> Status) -> Response -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Response -> Status
    responseStatus