{-# OPTIONS_GHC -fno-warn-deprecations #-}
module Network.Wai
(
Application
, Middleware
, ResponseReceived
, Request
, defaultRequest
, RequestBodyLength (..)
, requestMethod
, httpVersion
, rawPathInfo
, rawQueryString
, requestHeaders
, isSecure
, remoteHost
, pathInfo
, queryString
, getRequestBodyChunk
, requestBody
, vault
, requestBodyLength
, requestHeaderHost
, requestHeaderRange
, requestHeaderReferer
, requestHeaderUserAgent
, strictRequestBody
, consumeRequestBodyStrict
, lazyRequestBody
, consumeRequestBodyLazy
, Response
, StreamingBody
, FilePart (..)
, responseFile
, responseBuilder
, responseLBS
, responseStream
, responseRaw
, responseStatus
, responseHeaders
, responseToStream
, mapResponseHeaders
, mapResponseStatus
, ifRequest
, modifyResponse
) where
import Data.ByteString.Builder (Builder, lazyByteString)
import Data.ByteString.Builder (byteString)
import Control.Monad (unless)
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Internal as LI
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import Data.ByteString.Lazy.Char8 ()
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)
responseFile :: H.Status -> H.ResponseHeaders -> FilePath -> Maybe FilePart -> Response
responseFile :: Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
responseFile = Status -> ResponseHeaders -> FilePath -> Maybe FilePart -> Response
ResponseFile
responseBuilder :: H.Status -> H.ResponseHeaders -> Builder -> Response
responseBuilder :: Status -> ResponseHeaders -> Builder -> Response
responseBuilder = Status -> ResponseHeaders -> Builder -> Response
ResponseBuilder
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
responseStream :: H.Status
-> H.ResponseHeaders
-> StreamingBody
-> Response
responseStream :: Status -> ResponseHeaders -> StreamingBody -> Response
responseStream = Status -> ResponseHeaders -> StreamingBody -> Response
ResponseStream
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
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
responseHeaders :: Response -> H.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
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
mapResponseHeaders :: (H.ResponseHeaders -> H.ResponseHeaders) -> Response -> Response
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
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
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
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
}
type Middleware = Application -> Application
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
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
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)
consumeRequestBodyStrict :: Request -> IO L.ByteString
consumeRequestBodyStrict :: Request -> IO ByteString
consumeRequestBodyStrict = Request -> IO ByteString
strictRequestBody
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
consumeRequestBodyLazy :: Request -> IO L.ByteString
consumeRequestBodyLazy :: Request -> IO ByteString
consumeRequestBodyLazy = Request -> IO ByteString
lazyRequestBody