-- Ignore deprecations, because this module needs to use the deprecated requestBody to construct a response.
{-# OPTIONS_GHC -fno-warn-deprecations #-}

-- |
--
-- This module defines a generic web application interface. It is a common
-- protocol between web servers and web applications.
--
-- The overriding design principles here are performance and generality. To
-- address performance, this library uses a streaming interface for request and
-- response bodies, paired with bytestring's 'Builder' type.  The advantages of a
-- streaming API over lazy IO have been debated elsewhere and so will not be
-- addressed here.  However, helper functions like 'responseLBS' allow you to
-- continue using lazy IO if you so desire.
--
-- Generality is achieved by removing many variables commonly found in similar
-- projects that are not universal to all servers. The goal is that the 'Request'
-- object contains only data which is meaningful in all circumstances.
--
-- Please remember when using this package that, while your application may
-- compile without a hitch against many different servers, there are other
-- considerations to be taken when moving to a new backend. For example, if you
-- transfer from a CGI application to a FastCGI one, you might suddenly find you
-- have a memory leak. Conversely, a FastCGI application would be well served to
-- preload all templates from disk when first starting; this would kill the
-- performance of a CGI application.
--
-- This package purposely provides very little functionality. You can find various
-- middlewares, backends and utilities on Hackage. Some of the most commonly used
-- include:
--
-- [warp] <http://hackage.haskell.org/package/warp>
--
-- [wai-extra] <http://hackage.haskell.org/package/wai-extra>
module Network.Wai (
    -- * Types
    Application,
    Middleware,
    ResponseReceived,

    -- * Request
    Request,
    defaultRequest,
    RequestBodyLength (..),

    -- ** Request accessors
    requestMethod,
    httpVersion,
    rawPathInfo,
    rawQueryString,
    requestHeaders,
    isSecure,
    remoteHost,
    pathInfo,
    queryString,
    getRequestBodyChunk,
    requestBody,
    vault,
    requestBodyLength,
    requestHeaderHost,
    requestHeaderRange,
    requestHeaderReferer,
    requestHeaderUserAgent,
    requestSendEarlyHints,
    -- $streamingRequestBodies
    strictRequestBody,
    consumeRequestBodyStrict,
    lazyRequestBody,
    consumeRequestBodyLazy,

    -- ** Request modifiers
    setRequestBodyChunks,
    mapRequestHeaders,

    -- * Response
    Response,
    StreamingBody,
    FilePart (..),

    -- ** Response composers
    responseFile,
    responseBuilder,
    responseLBS,
    responseStream,
    responseRaw,

    -- ** Response accessors
    responseStatus,
    responseHeaders,

    -- ** Response modifiers
    responseToStream,
    mapResponseHeaders,
    mapResponseStatus,

    -- * Middleware composition
    ifRequest,
    modifyRequest,
    modifyResponse,
) where

import Control.Monad (unless)
import qualified Data.ByteString as B
import Data.ByteString.Builder (
    Builder,
    byteString,
    lazyByteString,
 )
import qualified Data.ByteString.Lazy as L
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import qualified Data.ByteString.Lazy.Internal as LI
import Data.Function (fix)
import qualified Network.HTTP.Types as H
import Network.Socket (SockAddr (SockAddrInet))
import Network.Wai.Internal
import qualified System.IO as IO
import System.IO.Unsafe (unsafeInterleaveIO)

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

-- | Creating 'Response' from a file.
--
-- Server implementations like @warp@ might disregard the t'Status' when
-- using 'responseFile', since the server might rework the response based on
-- headers or presence/absence of the file.
-- @warp@ does not do do any extra processing when sending file parts, though,
-- so be mindful of how each server implementation handles file responses.
--
-- /The above was written when @warp-3.4.14@ was the newest version/
--
-- @since 2.0.0
responseFile
    :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response
responseFile :: Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
responseFile = Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
ResponseFile

-- | Creating 'Response' from 'Builder'.
--
-- Some questions and answers about the usage of 'Builder' here:
--
-- Q1. Shouldn't it be at the user's discretion to use Builders internally and
-- then create a stream of ByteStrings?
--
-- A1. That would be less efficient, as we wouldn't get cheap concatenation
-- with the response headers.
--
-- Q2. Isn't it really inefficient to convert from ByteString to Builder, and
-- then right back to ByteString?
--
-- A2. No. If the ByteStrings are small, then they will be copied into a larger
-- buffer, which should be a performance gain overall (less system calls). If
-- they are already large, then an insert operation is used
-- to avoid copying.
--
-- Q3. Doesn't this prevent us from creating comet-style servers, since data
-- will be cached?
--
-- A3. You can force a Builder to output a ByteString before it is an
-- optimal size by sending a flush command.
--
-- @since 2.0.0
responseBuilder :: H.Status -> H.ResponseHeaders -> Builder -> Response
responseBuilder :: Status -> ResponseHeaders -> Builder -> Response
responseBuilder = Status -> ResponseHeaders -> Builder -> Response
ResponseBuilder

-- | Creating 'Response' from 'L.ByteString'. This is a wrapper for
--   'responseBuilder'.
--
-- @since 0.3.0
responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response
responseLBS :: Status -> ResponseHeaders -> ByteString -> Response
responseLBS Status
s ResponseHeaders
h = Status -> ResponseHeaders -> Builder -> Response
ResponseBuilder Status
s ResponseHeaders
h (Builder -> Response)
-> (ByteString -> Builder) -> ByteString -> Response
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Builder
lazyByteString

-- | Creating 'Response' from a stream of values.
--
-- In order to allocate resources in an exception-safe manner, you can use the
-- @bracket@ pattern outside of the call to @responseStream@. As a trivial
-- example:
--
-- @
-- app :: Application
-- app req respond = bracket_
--     (putStrLn \"Allocating scarce resource\")
--     (putStrLn \"Cleaning up\")
--     $ respond $ responseStream status200 [] $ \\write flush -> do
--         write $ byteString \"Hello\\n\"
--         flush
--         write $ byteString \"World\\n\"
-- @
--
-- Note that in some cases you can use @bracket@ from inside @responseStream@
-- as well. However, placing the call on the outside allows your status value
-- and response headers to depend on the scarce resource.
--
-- @since 3.0.0
responseStream
    :: H.Status
    -> H.ResponseHeaders
    -> StreamingBody
    -> Response
responseStream :: Status -> ResponseHeaders -> StreamingBody -> Response
responseStream = Status -> ResponseHeaders -> StreamingBody -> Response
ResponseStream

-- | Create a response for a raw application. This is useful for \"upgrade\"
-- situations such as WebSockets, where an application requests for the server
-- to grant it raw network access.
--
-- This function requires a backup response to be provided, for the case where
-- the handler in question does not support such upgrading (e.g., CGI apps).
--
-- In the event that you read from the request body before returning a
-- @responseRaw@, behavior is undefined.
--
-- @since 2.1.0
responseRaw
    :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ())
    -> Response
    -> Response
responseRaw :: (IO ByteString -> (ByteString -> IO ()) -> IO ())
-> Response -> Response
responseRaw = (IO ByteString -> (ByteString -> IO ()) -> IO ())
-> Response -> Response
ResponseRaw

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

-- | Accessing 'H.Status' in 'Response'.
--
-- @since 1.2.0
responseStatus :: Response -> H.Status
responseStatus :: Response -> Status
responseStatus (ResponseFile Status
s ResponseHeaders
_ FilePath
_ Maybe FilePart
_) = Status
s
responseStatus (ResponseBuilder Status
s ResponseHeaders
_ Builder
_) = Status
s
responseStatus (ResponseStream Status
s ResponseHeaders
_ StreamingBody
_) = Status
s
responseStatus (ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
_ Response
res) = Response -> Status
responseStatus Response
res

-- | Accessing 'H.ResponseHeaders' in 'Response'.
--
-- @since 2.0.0
responseHeaders :: Response -> H.ResponseHeaders
responseHeaders :: Response -> ResponseHeaders
responseHeaders (ResponseFile Status
_ ResponseHeaders
hs FilePath
_ Maybe FilePart
_) = ResponseHeaders
hs
responseHeaders (ResponseBuilder Status
_ ResponseHeaders
hs Builder
_) = ResponseHeaders
hs
responseHeaders (ResponseStream Status
_ ResponseHeaders
hs StreamingBody
_) = ResponseHeaders
hs
responseHeaders (ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
_ Response
res) = Response -> ResponseHeaders
responseHeaders Response
res

-- | Converting the body information in 'Response' to a 'StreamingBody'.
--
-- @since 3.0.0
responseToStream
    :: Response
    -> ( H.Status
       , H.ResponseHeaders
       , (StreamingBody -> IO a) -> IO a
       )
responseToStream :: forall a.
Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
responseToStream (ResponseStream Status
s ResponseHeaders
h StreamingBody
b) = (Status
s, ResponseHeaders
h, ((StreamingBody -> IO a) -> StreamingBody -> IO a
forall a b. (a -> b) -> a -> b
$ StreamingBody
b))
responseToStream (ResponseFile Status
s ResponseHeaders
h FilePath
fp (Just FilePart
part)) =
    ( Status
s
    , ResponseHeaders
h
    , \StreamingBody -> IO a
withBody -> FilePath -> IOMode -> (Handle -> IO a) -> IO a
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile FilePath
fp IOMode
IO.ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> StreamingBody -> IO a
withBody (StreamingBody -> IO a) -> StreamingBody -> IO a
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
sendChunk IO ()
_flush -> do
        Handle -> SeekMode -> Integer -> IO ()
IO.hSeek Handle
handle SeekMode
IO.AbsoluteSeek (Integer -> IO ()) -> Integer -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePart -> Integer
filePartOffset FilePart
part
        let loop :: Int -> IO ()
loop Int
remaining | Int
remaining Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            loop Int
remaining = do
                ByteString
bs <- Handle -> Int -> IO ByteString
B.hGetSome Handle
handle Int
defaultChunkSize
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    let x :: ByteString
x = Int -> ByteString -> ByteString
B.take Int
remaining ByteString
bs
                    Builder -> IO ()
sendChunk (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
x
                    Int -> IO ()
loop (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
remaining Int -> Int -> Int
forall a. Num a => a -> a -> a
- ByteString -> Int
B.length ByteString
x
        Int -> IO ()
loop (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> Integer -> Int
forall a b. (a -> b) -> a -> b
$ FilePart -> Integer
filePartByteCount FilePart
part
    )
responseToStream (ResponseFile Status
s ResponseHeaders
h FilePath
fp Maybe FilePart
Nothing) =
    ( Status
s
    , ResponseHeaders
h
    , \StreamingBody -> IO a
withBody -> FilePath -> IOMode -> (Handle -> IO a) -> IO a
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
IO.withBinaryFile FilePath
fp IOMode
IO.ReadMode ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
handle ->
        StreamingBody -> IO a
withBody (StreamingBody -> IO a) -> StreamingBody -> IO a
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
sendChunk IO ()
_flush -> (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO ()
loop -> do
            ByteString
bs <- Handle -> Int -> IO ByteString
B.hGetSome Handle
handle Int
defaultChunkSize
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Builder -> IO ()
sendChunk (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
byteString ByteString
bs
                IO ()
loop
    )
responseToStream (ResponseBuilder Status
s ResponseHeaders
h Builder
b) =
    (Status
s, ResponseHeaders
h, \StreamingBody -> IO a
withBody -> StreamingBody -> IO a
withBody (StreamingBody -> IO a) -> StreamingBody -> IO a
forall a b. (a -> b) -> a -> b
$ \Builder -> IO ()
sendChunk IO ()
_flush -> Builder -> IO ()
sendChunk Builder
b)
responseToStream (ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
_ Response
res) = Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
forall a.
Response
-> (Status, ResponseHeaders, (StreamingBody -> IO a) -> IO a)
responseToStream Response
res

-- | Apply the provided function to the response header list of the Response.
--
-- @since 3.0.3.0
mapResponseHeaders
    :: (H.ResponseHeaders -> H.ResponseHeaders) -> Response -> Response
mapResponseHeaders :: (ResponseHeaders -> ResponseHeaders) -> Response -> Response
mapResponseHeaders ResponseHeaders -> ResponseHeaders
f (ResponseFile Status
s ResponseHeaders
h FilePath
b1 Maybe FilePart
b2) = Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
ResponseFile Status
s (ResponseHeaders -> ResponseHeaders
f ResponseHeaders
h) FilePath
b1 Maybe FilePart
b2
mapResponseHeaders ResponseHeaders -> ResponseHeaders
f (ResponseBuilder Status
s ResponseHeaders
h Builder
b) = Status -> ResponseHeaders -> Builder -> Response
ResponseBuilder Status
s (ResponseHeaders -> ResponseHeaders
f ResponseHeaders
h) Builder
b
mapResponseHeaders ResponseHeaders -> ResponseHeaders
f (ResponseStream Status
s ResponseHeaders
h StreamingBody
b) = Status -> ResponseHeaders -> StreamingBody -> Response
ResponseStream Status
s (ResponseHeaders -> ResponseHeaders
f ResponseHeaders
h) StreamingBody
b
mapResponseHeaders ResponseHeaders -> ResponseHeaders
_ r :: Response
r@(ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
_ Response
_) = Response
r

-- | Apply the provided function to the response status of the Response.
--
-- @since 3.2.1
mapResponseStatus :: (H.Status -> H.Status) -> Response -> Response
mapResponseStatus :: (Status -> Status) -> Response -> Response
mapResponseStatus Status -> Status
f (ResponseFile Status
s ResponseHeaders
h FilePath
b1 Maybe FilePart
b2) = Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
ResponseFile (Status -> Status
f Status
s) ResponseHeaders
h FilePath
b1 Maybe FilePart
b2
mapResponseStatus Status -> Status
f (ResponseBuilder Status
s ResponseHeaders
h Builder
b) = Status -> ResponseHeaders -> Builder -> Response
ResponseBuilder (Status -> Status
f Status
s) ResponseHeaders
h Builder
b
mapResponseStatus Status -> Status
f (ResponseStream Status
s ResponseHeaders
h StreamingBody
b) = Status -> ResponseHeaders -> StreamingBody -> Response
ResponseStream (Status -> Status
f Status
s) ResponseHeaders
h StreamingBody
b
mapResponseStatus Status -> Status
_ r :: Response
r@(ResponseRaw IO ByteString -> (ByteString -> IO ()) -> IO ()
_ Response
_) = Response
r

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

-- | The WAI application.
--
-- Note that, since WAI 3.0, this type is structured in continuation passing
-- style to allow for proper safe resource handling. This was handled in the
-- past via other means (e.g., @ResourceT@). As a demonstration:
--
-- @
-- app :: Application
-- app req respond = bracket_
--     (putStrLn \"Allocating scarce resource\")
--     (putStrLn \"Cleaning up\")
--     (respond $ responseLBS status200 [] \"Hello World\")
-- @
type Application =
    Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived

-- | A default, blank request.
--
-- @since 2.0.0
defaultRequest :: Request
defaultRequest :: Request
defaultRequest =
    Request
        { requestMethod :: ByteString
requestMethod = ByteString
H.methodGet
        , httpVersion :: HttpVersion
httpVersion = HttpVersion
H.http10
        , rawPathInfo :: ByteString
rawPathInfo = ByteString
B.empty
        , rawQueryString :: ByteString
rawQueryString = ByteString
B.empty
        , requestHeaders :: ResponseHeaders
requestHeaders = []
        , isSecure :: Bool
isSecure = Bool
False
        , remoteHost :: SockAddr
remoteHost = PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
0 HostAddress
0
        , pathInfo :: [Text]
pathInfo = []
        , queryString :: Query
queryString = []
        , requestBody :: IO ByteString
requestBody = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
        , vault :: Vault
vault = Vault
forall a. Monoid a => a
mempty
        , requestBodyLength :: RequestBodyLength
requestBodyLength = Word64 -> RequestBodyLength
KnownLength Word64
0
        , requestHeaderHost :: Maybe ByteString
requestHeaderHost = Maybe ByteString
forall a. Maybe a
Nothing
        , requestHeaderRange :: Maybe ByteString
requestHeaderRange = Maybe ByteString
forall a. Maybe a
Nothing
        , requestHeaderReferer :: Maybe ByteString
requestHeaderReferer = Maybe ByteString
forall a. Maybe a
Nothing
        , requestHeaderUserAgent :: Maybe ByteString
requestHeaderUserAgent = Maybe ByteString
forall a. Maybe a
Nothing
        , requestSendEarlyHints :: ResponseHeaders -> IO ()
requestSendEarlyHints = \ResponseHeaders
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        }

-- | A @Middleware@ is a component that sits between the server and application.
--
-- It can modify both the 'Request' and 'Response',
-- to provide simple transformations that are required for all (or most of)
-- your web server’s routes.
--
-- = Users of middleware
--
-- If you are trying to apply one or more 'Middleware's to your 'Application',
-- just call them as functions.
--
-- For example, if you have @corsMiddleware@ and @authorizationMiddleware@,
-- and you want to authorize first, you can do:
--
-- @
-- let allMiddleware app = authorizationMiddleware (corsMiddleware app)
-- @
--
-- to get a new 'Middleware', which first authorizes, then sets, CORS headers.
-- The “outer” middleware is called first.
--
-- You can also chain them via '(.)':
--
-- @
-- let allMiddleware =
--         authorizationMiddleware
--       . corsMiddleware
--       . … more middleware here …
-- @
--
-- Then, once you have an @app :: Application@, you can wrap it
-- in your middleware:
--
-- @
-- let myApp = allMiddleware app :: Application
-- @
--
-- and run it as usual:
--
-- @
-- Warp.run port myApp
-- @
--
-- = Authors of middleware
--
-- When fully expanded, 'Middleware' has the type signature:
--
-- > (Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived) -> Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
--
-- or if we shorten to @type Respond = Response -> IO ResponseReceived@:
--
-- > (Request -> Respond -> IO ResponseReceived) -> Request -> Respond -> IO ResponseReceived
--
-- so a middleware definition takes 3 arguments, an inner application, a request and a response callback.
--
-- Compare with the type of a simple `Application`:
--
-- > Request -> Respond -> IO ResponseReceived
--
-- It takes the 'Request' and @Respond@, but not the extra application.
--
-- Said differently, a middleware has the power of a normal 'Application'
-- — it can inspect the 'Request' and return a 'Response' —
-- but it can (and in many cases it /should/) also call the 'Application' which was passed to it.
--
-- == Modifying the 'Request'
--
-- A lot of middleware just looks at the request and does something based on its values.
--
-- For example, the @authorizationMiddleware@ from above could look at the @Authorization@
-- HTTP header and run <https://jwt.io/ JWT> verification logic against the database.
--
-- @
-- authorizationMiddleware app req respond = do
--   case verifyJWT ('requestHeaders' req) of
--     InvalidJWT err -> respond (invalidJWTResponse err)
--     ValidJWT -> app req respond
-- @
--
-- Notice how the inner app is called when the validation was successful.
-- If it was not, we can respond
-- e.g. with <https://developer.mozilla.org/en-US/docs/Web/HTTP/Status/401 HTTP 401 Unauthorized>,
-- by constructing a 'Response' with 'responseLBS' and passing it to @respond@.
--
-- == Passing arguments to and from your 'Middleware'
--
-- Middleware must often be configurable.
-- Let’s say you have a type @JWTSettings@ that you want to be passed to the middleware.
-- Simply pass an extra argument to your middleware. Then your middleware type turns into:
--
-- @
-- authorizationMiddleware :: JWTSettings -> Application -> Request -> Respond -> IO ResponseReceived
-- authorizationMiddleware jwtSettings req respond =
--   case verifyJWT jwtSettings ('requestHeaders' req) of
--     InvalidJWT err -> respond (invalidJWTResponse err)
--     ValidJWT -> app req respond
-- @
--
-- or alternatively:
--
-- @
-- authorizationMiddleware :: JWTSettings -> Middleware
-- @
--
-- Perhaps less intuitively, you can also /pass on/ data from middleware to the wrapped 'Application':
--
-- @
-- authorizationMiddleware :: JWTSettings -> (JWT -> Application) -> Request -> Respond -> IO ResponseReceived
-- authorizationMiddleware jwtSettings req respond =
--   case verifyJWT jwtSettings ('requestHeaders' req) of
--     InvalidJWT err -> respond (invalidJWTResponse err)
--     ValidJWT jwt -> app jwt req respond
-- @
--
-- although then, chaining different middleware has to take this extra argument into account:
--
-- @
-- let finalApp =
--       authorizationMiddleware
--         (\\jwt -> corsMiddleware
--            (… more middleware here …
--              (app jwt)))
-- @
--
-- == Modifying the 'Response'
--
-- 'Middleware' can also modify the 'Response' that is returned by the inner application.
--
-- This is done by taking the @respond@ callback, using it to define a new @respond'@,
-- and passing this new @respond'@ to the @app@:
--
-- @
-- gzipMiddleware app req respond = do
--   let respond' resp = do
--         resp' <- gzipResponseBody resp
--         respond resp'
--   app req respond'
-- @
--
-- However, modifying the response (especially the response body) is not trivial,
-- so in order to get a sense of how to do it (dealing with the type of 'responseToStream'),
-- it’s best to look at an example, for example <https://hackage.haskell.org/package/wai-extra/docs/src/Network.Wai.Middleware.Gzip.html#gzip the GZIP middleware of wai-extra>.
type Middleware = Application -> Application

-- | Apply a function that modifies a request as a 'Middleware'
--
-- @since 3.2.4
modifyRequest :: (Request -> Request) -> Middleware
modifyRequest :: (Request -> Request) -> Middleware
modifyRequest Request -> Request
f Application
app = Application
app Application -> (Request -> Request) -> Application
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Request -> Request
f

-- | Apply a function that modifies a response as a 'Middleware'
--
-- @since 3.0.3.0
modifyResponse :: (Response -> Response) -> Middleware
modifyResponse :: (Response -> Response) -> Middleware
modifyResponse Response -> Response
f Application
app Request
req Response -> IO ResponseReceived
respond = Application
app Request
req ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ Response -> IO ResponseReceived
respond (Response -> IO ResponseReceived)
-> (Response -> Response) -> Response -> IO ResponseReceived
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response -> Response
f

-- | Conditionally apply a 'Middleware'
--
-- @since 3.0.3.0
ifRequest :: (Request -> Bool) -> Middleware -> Middleware
ifRequest :: (Request -> Bool) -> Middleware -> Middleware
ifRequest Request -> Bool
rpred Middleware
middle Application
app Request
req
    | Request -> Bool
rpred Request
req = Middleware
middle Application
app Request
req
    | Bool
otherwise = Application
app Request
req

-- $streamingRequestBodies
--
-- == Streaming Request Bodies
--
-- WAI is designed for streaming in request bodies, which allows you to process them incrementally.
-- You can stream in the request body using functions like 'getRequestBodyChunk',
-- the @wai-conduit@ package, or Yesod's @rawRequestBody@.
--
-- In the normal case, incremental processing is more efficient, since it
-- reduces maximum total memory usage.
-- In the worst case, it helps protect your server against denial-of-service (DOS) attacks, in which
-- an attacker sends huge request bodies to your server.
--
-- Consider these tips to avoid reading the entire request body into memory:
--
-- * Look for library functions that support incremental processing. Sometimes these will use streaming
-- libraries like @conduit@, @pipes@, or @streaming@.
-- * Any attoparsec parser supports streaming input. For an example of this, see the
-- "Data.Conduit.Attoparsec" module in @conduit-extra@.
-- * Consider streaming directly to a file on disk. For an example of this, see the
-- "Data.Conduit.Binary" module in @conduit-extra@.
-- * If you need to direct the request body to multiple destinations, you can stream to both those
-- destinations at the same time.
-- For example, if you wanted to run an HMAC on the request body as well as parse it into JSON,
-- you could use Conduit's @zipSinks@ to send the data to @cryptonite-conduit@'s 'sinkHMAC' and
-- @aeson@'s Attoparsec parser.
-- * If possible, avoid processing large data on your server at all.
-- For example, instead of uploading a file to your server and then to AWS S3,
-- you can have the browser upload directly to S3.
--
-- That said, sometimes it is convenient, or even necessary to read the whole request body into memory.
-- For these purposes, functions like 'strictRequestBody' or 'lazyRequestBody' can be used.
-- When this is the case, consider these strategies to mitigating potential DOS attacks:
--
-- * Set a limit on the request body size you allow.
-- If certain endpoints need larger bodies, whitelist just those endpoints for the large size.
-- Be especially cautious about endpoints that don't require authentication, since these are easier to DOS.
-- You can accomplish this with @wai-extra@'s @requestSizeLimitMiddleware@ or Yesod's @maximumContentLength@.
-- * Consider rate limiting not just on total requests, but also on total bytes sent in.
-- * Consider using services that allow you to identify and blacklist attackers.
-- * Minimize the amount of time the request body stays in memory.
-- * If you need to share request bodies across middleware and your application, you can do so using Wai's 'vault'.
-- If you do this, remove the request body from the vault as soon as possible.
--
-- Warning: Incremental processing will not always be sufficient to prevent a DOS attack.
-- For example, if an attacker sends you a JSON body with a 2MB long string inside,
-- even if you process the body incrementally, you'll still end up with a 2MB-sized 'Text'.
--
-- To mitigate this, employ some of the countermeasures listed above,
-- and try to reject such payloads as early as possible in your codebase.

-- | Get the request body as a lazy ByteString. However, do /not/ use any lazy
-- I\/O, instead reading the entire body into memory strictly.
--
-- Note: Since this function consumes the request body, future calls to it will return the empty string.
--
-- @since 3.0.1
strictRequestBody :: Request -> IO L.ByteString
strictRequestBody :: Request -> IO ByteString
strictRequestBody Request
req =
    (ByteString -> ByteString) -> IO ByteString
forall {c}. (ByteString -> c) -> IO c
loop ByteString -> ByteString
forall a. a -> a
id
  where
    loop :: (ByteString -> c) -> IO c
loop ByteString -> c
front = do
        ByteString
bs <- Request -> IO ByteString
getRequestBodyChunk Request
req
        if ByteString -> Bool
B.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 ByteString
LI.Empty
            else (ByteString -> c) -> IO c
loop (ByteString -> c
front (ByteString -> c) -> (ByteString -> ByteString) -> ByteString -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString -> ByteString
LI.Chunk ByteString
bs)

-- | Synonym for 'strictRequestBody'.
-- This function name is meant to signal the non-idempotent nature of 'strictRequestBody'.
--
-- @since 3.2.3
consumeRequestBodyStrict :: Request -> IO L.ByteString
consumeRequestBodyStrict :: Request -> IO ByteString
consumeRequestBodyStrict = Request -> IO ByteString
strictRequestBody

-- | Get the request body as a lazy ByteString. This uses lazy I\/O under the
-- surface, and therefore all typical warnings regarding lazy I/O apply.
--
-- Note: Since this function consumes the request body, future calls to it will return the empty string.
--
-- @since 1.4.1
lazyRequestBody :: Request -> IO L.ByteString
lazyRequestBody :: Request -> IO ByteString
lazyRequestBody Request
req =
    IO ByteString
loop
  where
    loop :: IO ByteString
loop = IO ByteString -> IO ByteString
forall a. IO a -> IO a
unsafeInterleaveIO (IO ByteString -> IO ByteString) -> IO ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ do
        ByteString
bs <- Request -> IO ByteString
getRequestBodyChunk Request
req
        if ByteString -> Bool
B.null ByteString
bs
            then ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
LI.Empty
            else do
                ByteString
bss <- IO ByteString
loop
                ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString -> ByteString
LI.Chunk ByteString
bs ByteString
bss

-- | Synonym for 'lazyRequestBody'.
-- This function name is meant to signal the non-idempotent nature of 'lazyRequestBody'.
--
-- @since 3.2.3
consumeRequestBodyLazy :: Request -> IO L.ByteString
consumeRequestBodyLazy :: Request -> IO ByteString
consumeRequestBodyLazy = Request -> IO ByteString
lazyRequestBody

-- | Apply the provided function to the request header list of the 'Request'.
--
-- @since 3.2.4
mapRequestHeaders
    :: (H.RequestHeaders -> H.RequestHeaders) -> Request -> Request
mapRequestHeaders :: (ResponseHeaders -> ResponseHeaders) -> Request -> Request
mapRequestHeaders ResponseHeaders -> ResponseHeaders
f Request
request = Request
request{requestHeaders = f (requestHeaders request)}