    {-# LANGUAGE RecordWildCards #-}
    -- NOTE: Due to https://github.com/yesodweb/wai/issues/192, this module should
    -- not use CPP.
    module Network.Wai.Middleware.RequestLogger
        ( -- * Basic stdout logging
          logStdout
        , logStdoutDev
          -- * Create more versions
        , mkRequestLogger
        , RequestLoggerSettings
        , outputFormat
        , autoFlush
        , destination
        , OutputFormat (..)
        , OutputFormatter
        , OutputFormatterWithDetails
        , OutputFormatterWithDetailsAndHeaders
        , Destination (..)
        , Callback
        , IPAddrSource (..)
        ) where

    import System.IO (Handle, hFlush, stdout)
    import qualified Data.ByteString.Builder as B (Builder, byteString)
    import qualified Data.ByteString as BS
    import Data.ByteString.Char8 (pack)
    import Control.Monad (when)
    import Control.Monad.IO.Class (liftIO)
    import Network.Wai
      ( Request(..), requestBodyLength, RequestBodyLength(..)
      , Middleware
      , Response, responseStatus, responseHeaders
      )
    import System.Log.FastLogger
    import Network.HTTP.Types as H
    import Data.Maybe (fromMaybe)
    import Data.Monoid (mconcat, (<>))
    import Data.Time (getCurrentTime, diffUTCTime, NominalDiffTime)
    import Network.Wai.Parse (sinkRequestBody, lbsBackEnd, fileName, Param, File
                             , getRequestBodyType)
    import qualified Data.ByteString.Lazy as LBS
    import qualified Data.ByteString.Char8 as S8
    import System.Console.ANSI
    import Data.IORef
    import System.IO.Unsafe
    import Network.Wai.Internal (Response (..))
    import Data.Default.Class (Default (def))
    import Network.Wai.Logger
    import Network.Wai.Middleware.RequestLogger.Internal
    import Network.Wai.Header (contentLength)
    import Data.Text.Encoding (decodeUtf8')

    data OutputFormat
      = Apache IPAddrSource
      | Detailed Bool -- ^ use colors?
      | CustomOutputFormat OutputFormatter
      | CustomOutputFormatWithDetails OutputFormatterWithDetails
      | CustomOutputFormatWithDetailsAndHeaders OutputFormatterWithDetailsAndHeaders

    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
        }

    instance Default RequestLoggerSettings where
        def :: RequestLoggerSettings
    def = RequestLoggerSettings :: OutputFormat -> Bool -> Destination -> RequestLoggerSettings
    RequestLoggerSettings
            { outputFormat :: OutputFormat
    outputFormat = Bool -> OutputFormat
    Detailed Bool
    True
            , autoFlush :: Bool
    autoFlush = Bool
    True
            , destination :: Destination
    destination = Handle -> Destination
    Handle Handle
    stdout
            }

    mkRequestLogger :: RequestLoggerSettings -> IO Middleware
    mkRequestLogger :: RequestLoggerSettings -> IO Middleware
    mkRequestLogger RequestLoggerSettings{..} = do
        let (callback :: LogStr -> IO ()
    callback, flusher :: IO ()
    flusher) =
                case Destination
    destination of
                    Handle h :: 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 l :: 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 c :: LogStr -> IO ()
    c -> (LogStr -> IO ()
    c, () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
            callbackAndFlush :: LogStr -> IO ()
    callbackAndFlush str :: LogStr
    str = LogStr -> IO ()
    callback LogStr
    str IO () -> IO () -> IO ()
    forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> IO ()
    flusher
        case OutputFormat
    outputFormat of
            Apache ipsrc :: 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 (m :: * -> *) a. Monad m => a -> m a
    return (Middleware -> IO Middleware) -> Middleware -> IO Middleware
    forall a b. (a -> b) -> a -> b
    $ ApacheLoggerActions -> Middleware
    apacheMiddleware ApacheLoggerActions
    apache
            Detailed useColors :: Bool
    useColors -> (LogStr -> IO ()) -> Bool -> IO Middleware
    detailedMiddleware LogStr -> IO ()
    callbackAndFlush Bool
    useColors
            CustomOutputFormat formatter :: OutputFormatter
    formatter -> do
                IO ByteString
    getDate <- IO () -> IO (IO ByteString)
    getDateGetter IO ()
    flusher
                Middleware -> IO Middleware
    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 formatter :: OutputFormatterWithDetails
    formatter -> do
                IO ByteString
    getdate <- IO () -> IO (IO ByteString)
    getDateGetter IO ()
    flusher
                Middleware -> IO Middleware
    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 formatter :: OutputFormatterWithDetailsAndHeaders
    formatter -> do
                IO ByteString
    getdate <- IO () -> IO (IO ByteString)
    getDateGetter IO ()
    flusher
                Middleware -> IO Middleware
    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 :: ApacheLoggerActions -> Middleware
    apacheMiddleware :: ApacheLoggerActions -> Middleware
    apacheMiddleware ala :: ApacheLoggerActions
    ala app :: Application
    app req :: Request
    req sendResponse :: 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
    $ \res :: Response
    res -> do
        let msize :: Maybe Integer
    msize = [(HeaderName, ByteString)] -> Maybe Integer
    contentLength (Response -> [(HeaderName, ByteString)]
    responseHeaders Response
    res)
        ApacheLoggerActions -> ApacheLogger
    apacheLogger ApacheLoggerActions
    ala Request
    req (Response -> Status
    responseStatus Response
    res) Maybe Integer
    msize
        Response -> IO ResponseReceived
    sendResponse Response
    res

    customMiddleware :: Callback -> IO ZonedDate -> OutputFormatter -> Middleware
    customMiddleware :: (LogStr -> IO ()) -> IO ByteString -> OutputFormatter -> Middleware
    customMiddleware cb :: LogStr -> IO ()
    cb getdate :: IO ByteString
    getdate formatter :: OutputFormatter
    formatter app :: Application
    app req :: Request
    req sendResponse :: 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
    $ \res :: Response
    res -> do
        ByteString
    date <- IO ByteString -> IO ByteString
    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 (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 cb :: LogStr -> IO ()
    cb getdate :: IO ByteString
    getdate formatter :: OutputFormatterWithDetails
    formatter app :: Application
    app req :: Request
    req sendResponse :: Response -> IO ResponseReceived
    sendResponse = do
      (req' :: Request
    req', reqBody :: [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
    $ \res :: Response
    res -> do
        UTCTime
    t1 <- IO UTCTime
    getCurrentTime
        ByteString
    date <- IO ByteString -> IO ByteString
    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 ""
        Response
    res' <- IORef Builder -> Response -> IO Response
    recordChunks IORef Builder
    builderIO Response
    res
        ResponseReceived
    rspRcv <- Response -> IO ResponseReceived
    sendResponse Response
    res'
        ()
    _ <- IO () -> IO ()
    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 (m :: * -> *) a. Monad m => a -> m a
    return ResponseReceived
    rspRcv

    customMiddlewareWithDetailsAndHeaders :: Callback -> IO ZonedDate -> OutputFormatterWithDetailsAndHeaders -> Middleware
    customMiddlewareWithDetailsAndHeaders :: (LogStr -> IO ())
    -> IO ByteString
    -> OutputFormatterWithDetailsAndHeaders
    -> Middleware
    customMiddlewareWithDetailsAndHeaders cb :: LogStr -> IO ()
    cb getdate :: IO ByteString
    getdate formatter :: OutputFormatterWithDetailsAndHeaders
    formatter app :: Application
    app req :: Request
    req sendResponse :: Response -> IO ResponseReceived
    sendResponse = do
      (req' :: Request
    req', reqBody :: [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
    $ \res :: Response
    res -> do
        UTCTime
    t1 <- IO UTCTime
    getCurrentTime
        ByteString
    date <- IO ByteString -> IO ByteString
    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 ""
        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 (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 (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 -> Bool -> IO Middleware
    detailedMiddleware :: (LogStr -> IO ()) -> Bool -> IO Middleware
    detailedMiddleware cb :: LogStr -> IO ()
    cb useColors :: Bool
    useColors =
        let (ansiColor :: Color -> ByteString -> [ByteString]
    ansiColor, ansiMethod :: ByteString -> [ByteString]
    ansiMethod, ansiStatusCode :: ByteString -> ByteString -> [ByteString]
    ansiStatusCode) =
              if Bool
    useColors
                then (Color -> ByteString -> [ByteString]
    ansiColor', ByteString -> [ByteString]
    ansiMethod', ByteString -> ByteString -> [ByteString]
    ansiStatusCode')
                else (\_ t :: ByteString
    t -> [ByteString
    t], (ByteString -> [ByteString] -> [ByteString]
    forall a. a -> [a] -> [a]
    :[]), \_ t :: ByteString
    t -> [ByteString
    t])

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

    ansiColor' :: Color -> BS.ByteString -> [BS.ByteString]
    ansiColor' :: Color -> ByteString -> [ByteString]
    ansiColor' color :: Color
    color bs :: 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' m :: ByteString
    m = case ByteString
    m of
        "GET"    -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Cyan ByteString
    m
        "HEAD"   -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Cyan ByteString
    m
        "PUT"    -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Green ByteString
    m
        "POST"   -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Yellow ByteString
    m
        "DELETE" -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Red ByteString
    m
        _        -> Color -> ByteString -> [ByteString]
    ansiColor' Color
    Magenta ByteString
    m

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

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

    getRequestBody :: Request -> IO (Request, [S8.ByteString])
    getRequestBody :: Request -> IO (Request, [ByteString])
    getRequestBody req :: Request
    req = do
      let loop :: ([ByteString] -> c) -> IO c
    loop front :: [ByteString] -> c
    front = do
             ByteString
    bs <- Request -> IO ByteString
    requestBody Request
    req
             if ByteString -> Bool
    S8.null ByteString
    bs
                 then c -> IO c
    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
    $ \chunks :: [ByteString]
    chunks ->
             case [ByteString]
    chunks of
                 [] -> ([], ByteString
    S8.empty)
                 x :: ByteString
    x:y :: [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 (m :: * -> *) a. Monad m => a -> m a
    return (Request
    req', [ByteString]
    body)

    detailedMiddleware' :: Callback
                        -> (Color -> BS.ByteString -> [BS.ByteString])
                        -> (BS.ByteString -> [BS.ByteString])
                        -> (BS.ByteString -> BS.ByteString -> [BS.ByteString])
                        -> Middleware
    detailedMiddleware' :: (LogStr -> IO ())
    -> (Color -> ByteString -> [ByteString])
    -> (ByteString -> [ByteString])
    -> (ByteString -> ByteString -> [ByteString])
    -> Middleware
    detailedMiddleware' cb :: LogStr -> IO ()
    cb ansiColor :: Color -> ByteString -> [ByteString]
    ansiColor ansiMethod :: ByteString -> [ByteString]
    ansiMethod ansiStatusCode :: ByteString -> ByteString -> [ByteString]
    ansiStatusCode app :: Application
    app req :: Request
    req sendResponse :: Response -> IO ResponseReceived
    sendResponse = do
        (req' :: Request
    req', body :: [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 len :: Word64
    len, _) | Word64
    len Word64 -> Word64 -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 2048 -> Request -> IO (Request, [ByteString])
    getRequestBody Request
    req
                (_, Just len :: Integer
    len)        | Integer
    len Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    <= 2048 -> Request -> IO (Request, [ByteString])
    getRequestBody Request
    req
                _ -> (Request, [ByteString]) -> IO (Request, [ByteString])
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Request
    req, [])

        let reqbodylog :: p -> [ByteString]
    reqbodylog _ = if [ByteString] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [ByteString]
    body then [""] else Color -> ByteString -> [ByteString]
    ansiColor Color
    White "  Request Body: " [ByteString] -> [ByteString] -> [ByteString]
    forall a. Semigroup a => a -> a -> a
    <> [ByteString]
    body [ByteString] -> [ByteString] -> [ByteString]
    forall a. Semigroup a => a -> a -> a
    <> ["\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 [""]) 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 (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` ["GET", "HEAD"]
            then [Param] -> IO [Param]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
            else do ([Param], [File ByteString])
    postParams <- IO ([Param], [File ByteString]) -> IO ([Param], [File ByteString])
    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
                    [Param] -> IO [Param]
    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], [File ByteString])
    postParams

        let getParams :: [Param]
    getParams = ((ByteString, Maybe ByteString) -> Param)
    -> [(ByteString, Maybe ByteString)] -> [Param]
    forall a b. (a -> b) -> [a] -> [b]
    map (ByteString, Maybe ByteString) -> Param
    emptyGetParam ([(ByteString, Maybe ByteString)] -> [Param])
    -> [(ByteString, Maybe ByteString)] -> [Param]
    forall a b. (a -> b) -> a -> b
    $ Request -> [(ByteString, Maybe ByteString)]
    queryString Request
    req
            accept :: ByteString
    accept = ByteString -> Maybe ByteString -> ByteString
    forall a. a -> Maybe a -> a
    fromMaybe "" (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 (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 (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 (t :: * -> *) a. Foldable t => t a -> Bool
    null [ByteString]
    par then [""] else Color -> ByteString -> [ByteString]
    ansiColor Color
    White "  Params: " [ByteString] -> [ByteString] -> [ByteString]
    forall a. Semigroup a => a -> a -> a
    <> [ByteString]
    par [ByteString] -> [ByteString] -> [ByteString]
    forall a. Semigroup a => a -> a -> a
    <> ["\n"]

        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
    $ \rsp :: Response
    rsp -> do
            let isRaw :: Bool
    isRaw =
                    case Response
    rsp of
                        ResponseRaw{} -> Bool
    True
                        _ -> 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
    $ [LogStr] -> LogStr
    forall a. Monoid a => [a] -> a
    mconcat ([LogStr] -> LogStr) -> [LogStr] -> LogStr
    forall a b. (a -> b) -> a -> b
    $ (ByteString -> LogStr) -> [ByteString] -> [LogStr]
    forall a b. (a -> b) -> [a] -> [b]
    map ByteString -> LogStr
    forall msg. ToLogStr msg => msg -> LogStr
    toLogStr ([ByteString] -> [LogStr]) -> [ByteString] -> [LogStr]
    forall a b. (a -> b) -> a -> b
    $
                ByteString -> [ByteString]
    ansiMethod (Request -> ByteString
    requestMethod Request
    req) [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++ [" ", Request -> ByteString
    rawPathInfo Request
    req, "\n"] [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++
                [ByteString]
    params [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++ [ByteString]
    reqbody [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++
                Color -> ByteString -> [ByteString]
    ansiColor Color
    White "  Accept: " [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++ [ByteString
    accept, "\n"] [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++
                if Bool
    isRaw then [] else
                    Color -> ByteString -> [ByteString]
    ansiColor Color
    White "  Status: " [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++
                    ByteString -> ByteString -> [ByteString]
    ansiStatusCode ByteString
    stCode (ByteString
    stCode ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> " " ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    stMsg) [ByteString] -> [ByteString] -> [ByteString]
    forall a. [a] -> [a] -> [a]
    ++
                    [" ", 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, "\n"]

            Response -> IO ResponseReceived
    sendResponse Response
    rsp
      where
        allPostParams :: [ByteString] -> IO ([Param], [File ByteString])
    allPostParams body :: [ByteString]
    body =
            case Request -> Maybe RequestBodyType
    getRequestBodyType Request
    req of
                Nothing -> ([Param], [File ByteString]) -> IO ([Param], [File ByteString])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
                Just rbt :: 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
    $ \chunks :: [ByteString]
    chunks ->
                            case [ByteString]
    chunks of
                                [] -> ([], ByteString
    S8.empty)
                                x: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 :: (ByteString, Maybe ByteString) -> Param
    emptyGetParam (k :: ByteString
    k, Just v :: ByteString
    v) = (ByteString
    k,ByteString
    v)
        emptyGetParam (k :: ByteString
    k, Nothing) = (ByteString
    k,"")

        collectPostParams :: ([Param], [File LBS.ByteString]) -> [Param]
        collectPostParams :: ([Param], [File ByteString]) -> [Param]
    collectPostParams (postParams :: [Param]
    postParams, files :: [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 (\(k :: ByteString
    k,v :: FileInfo ByteString
    v) -> (ByteString
    k, "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

    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