{-# LANGUAGE Rank2Types #-}
{-# LANGUAGE CPP #-}
module Network.Wai
(
Application
, Middleware
, ResponseReceived
, Request
, defaultRequest
, RequestBodyLength (..)
, requestMethod
, httpVersion
, rawPathInfo
, rawQueryString
, requestHeaders
, isSecure
, remoteHost
, pathInfo
, queryString
, requestBody
, vault
, requestBodyLength
, requestHeaderHost
, requestHeaderRange
, lazyRequestBody
, Response
, StreamingBody
, FilePart (..)
, responseFile
, responseBuilder
, responseLBS
, responseStream
, responseRaw
, responseStatus
, responseHeaders
, responseToStream
) where
import Blaze.ByteString.Builder (Builder, fromLazyByteString)
import Blaze.ByteString.Builder (fromByteString)
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 Data.Monoid (mempty)
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 = ResponseFile
responseBuilder :: H.Status -> H.ResponseHeaders -> Builder -> Response
responseBuilder = ResponseBuilder
responseLBS :: H.Status -> H.ResponseHeaders -> L.ByteString -> Response
responseLBS s h = ResponseBuilder s h . fromLazyByteString
responseStream :: H.Status
-> H.ResponseHeaders
-> StreamingBody
-> Response
responseStream = ResponseStream
responseRaw :: (IO B.ByteString -> (B.ByteString -> IO ()) -> IO ())
-> Response
-> Response
responseRaw = ResponseRaw
responseStatus :: Response -> H.Status
responseStatus (ResponseFile s _ _ _) = s
responseStatus (ResponseBuilder s _ _ ) = s
responseStatus (ResponseStream s _ _ ) = s
responseStatus (ResponseRaw _ res ) = responseStatus res
responseHeaders :: Response -> H.ResponseHeaders
responseHeaders (ResponseFile _ hs _ _) = hs
responseHeaders (ResponseBuilder _ hs _ ) = hs
responseHeaders (ResponseStream _ hs _ ) = hs
responseHeaders (ResponseRaw _ res) = responseHeaders res
responseToStream :: Response
-> ( H.Status
, H.ResponseHeaders
, (StreamingBody -> IO a) -> IO a
)
responseToStream (ResponseStream s h b) = (s, h, ($ b))
responseToStream (ResponseFile s h fp (Just part)) =
( s
, h
, \withBody -> IO.withBinaryFile fp IO.ReadMode $ \handle -> withBody $ \sendChunk _flush -> do
IO.hSeek handle IO.AbsoluteSeek $ filePartOffset part
let loop remaining | remaining <= 0 = return ()
loop remaining = do
bs <- B.hGetSome handle defaultChunkSize
unless (B.null bs) $ do
let x = B.take remaining bs
sendChunk $ fromByteString x
loop $ remaining - B.length x
loop $ fromIntegral $ filePartByteCount part
)
responseToStream (ResponseFile s h fp Nothing) =
( s
, h
, \withBody -> IO.withBinaryFile fp IO.ReadMode $ \handle ->
withBody $ \sendChunk _flush -> fix $ \loop -> do
bs <- B.hGetSome handle defaultChunkSize
unless (B.null bs) $ do
sendChunk $ fromByteString bs
loop
)
responseToStream (ResponseBuilder s h b) =
(s, h, \withBody -> withBody $ \sendChunk _flush -> sendChunk b)
responseToStream (ResponseRaw _ res) = responseToStream res
type Application = Request -> (Response -> IO ResponseReceived) -> IO ResponseReceived
type Middleware = Application -> Application
defaultRequest :: Request
defaultRequest = Request
{ requestMethod = H.methodGet
, httpVersion = H.http10
, rawPathInfo = B.empty
, rawQueryString = B.empty
, requestHeaders = []
, isSecure = False
, remoteHost = SockAddrInet 0 0
, pathInfo = []
, queryString = []
, requestBody = return B.empty
, vault = mempty
, requestBodyLength = KnownLength 0
, requestHeaderHost = Nothing
, requestHeaderRange = Nothing
}
lazyRequestBody :: Request -> IO L.ByteString
lazyRequestBody req =
loop
where
loop = unsafeInterleaveIO $ do
bs <- requestBody req
if B.null bs
then return LI.Empty
else do
bss <- loop
return $ LI.Chunk bs bss