@@ -10,6 +10,7 @@ module Network.Wai.Handler.Warp.Request (
1010import Control.Applicative
1111import Control.Exception.Lifted (throwIO)
1212import Control.Monad.IO.Class (liftIO)
13+import Data.Array ((!))
1314import Data.ByteString (ByteString)
1415import qualified Data.ByteString as S
1516import qualified Data.ByteString.Unsafe as SU
@@ -21,6 +22,7 @@ import qualified Network.HTTP.Types as H
2122import Network.Socket (SockAddr)
2223import Network.Wai
2324import Network.Wai.Handler.Warp.Conduit
25+import Network.Wai.Handler.Warp.Header
2426import Network.Wai.Handler.Warp.ReadInt
2527import Network.Wai.Handler.Warp.RequestHeader
2628import qualified Network.Wai.Handler.Warp.Timeout as Timeout
@@ -43,9 +45,12 @@ recvRequest :: Connection
4345 -> IO (Request, IO (ResumableSource IO ByteString))
4446recvRequest conn timeoutHandle remoteHost' src0 = do
4547 (src, hdrlines) <- src0 $$+ headerLines
46− (method, rpath, gets, httpversion, hdr') <- parseHeaderLines hdrlines
47− hdr <- liftIO $ handleExpect conn httpversion id hdr'
48− (rbody, bodyLength, getSource) <- bodyAndSource src hdr
48+ (method, rpath, gets, httpversion, hdr) <- parseHeaderLines hdrlines
49+ let idxhdr = indexRequestHeader hdr
50+ liftIO $ handleExpect conn httpversion (idxhdr ! idxExpect)
51+ (rbody, bodyLength, getSource) <- bodyAndSource src
52+ (idxhdr ! idxContentLength)
53+ (idxhdr ! idxTransferEncoding)
4954
5055 return (Request
5156 { requestMethod = method
@@ -72,41 +77,42 @@ headerLines =
7277
7378handleExpect :: Connection
7479 -> H.HttpVersion
75− -> (H.RequestHeaders -> H.RequestHeaders)
76− -> H.RequestHeaders
77− -> IO H.RequestHeaders
78−handleExpect _ _ front [] = return $ front []
79−handleExpect conn hv front (("expect", "100-continue"):rest) = do
80− connSendAll conn $
81− if hv == H.http11
82− then "HTTP/1.1 100 Continue\r\n\r\n"
83− else "HTTP/1.0 100 Continue\r\n\r\n"
84− return $ front rest
85−handleExpect conn hv front (x:xs) = handleExpect conn hv (front . (x:)) xs
80+ -> Maybe HeaderValue
81+ -> IO ()
82+handleExpect conn ver (Just "100-continue") = connSendAll conn continue
83+ where
84+ continue
85+ | ver == H.http11 = "HTTP/1.1 100 Continue\r\n\r\n"
86+ | otherwise = "HTTP/1.0 100 Continue\r\n\r\n"
87+handleExpect _ _ _ = return ()
8688
8789----------------------------------------------------------------
8890
8991bodyAndSource :: ResumableSource IO ByteString
90− -> H.RequestHeaders
92+ -> Maybe HeaderValue
93+ -> Maybe HeaderValue
9194 -> IO (Source IO ByteString
9295 ,RequestBodyLength
9396 ,IO (ResumableSource IO ByteString))
94−bodyAndSource src hdr
97+bodyAndSource src cl te
9598 | chunked = do
9699 ref <- I.newIORef (src, NeedLen)
97100 return (chunkedSource ref, ChunkedBody, fst <$> I.readIORef ref)
98101 | otherwise = do
99− ibs <- IsolatedBSSource <$> I.newIORef (len0, src)
102+ ibs <- IsolatedBSSource <$> I.newIORef (len, src)
100103 return (ibsIsolate ibs, bodyLen, ibsDone ibs)
101104 where
102− len0 = case lookup H.hContentLength hdr of
103− Nothing -> 0
104− Just bs -> readInt bs
105− bodyLen = KnownLength $ fromIntegral len0
106− chunked = isChunked hdr
107−
108−isChunked :: H.RequestHeaders -> Bool
109−isChunked hdr = maybe False ((== "chunked") . CI.foldCase) $ lookup hTransferEncoding hdr
105+ len = toLength cl
106+ bodyLen = KnownLength $ fromIntegral len
107+ chunked = isChunked te
108+
109+toLength :: Maybe HeaderValue -> Int
110+toLength Nothing = 0
111+toLength (Just bs) = readInt bs
112+
113+isChunked :: Maybe HeaderValue -> Bool
114+isChunked (Just bs) = CI.foldCase bs == "chunked"
115+isChunked _ = False
110116
111117----------------------------------------------------------------
112118