git.iko.soy/typeable/wai
on master help sign in
Spliting Request.hs.
commit65e17d667b7668ec92e062d721d2d492cb7367f9 authorKazu Yamamoto <kazu@iij.ad.jp> dateTue 29 Oct 2013, 14:00 (13 years ago) parent9baf973
3 files changed+62−49
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/Request.hs+4−49 warp/Network/Wai/Handler/Warp/RequestHeader.hs+57 warp/warp.cabal+1
warp/Network/Wai/Handler/Warp/Request.hs+4−49
@@ -12,7 +12,6 @@ import Control.Exception.Lifted (throwIO)
1212import Control.Monad.IO.Class (liftIO)
1313import Data.ByteString (ByteString)
1414import qualified Data.ByteString as S
15−import qualified Data.ByteString.Char8 as B (unpack)
1615import qualified Data.ByteString.Unsafe as SU
1716import qualified Data.CaseInsensitive as CI
1817import Data.Conduit
@@ -21,12 +20,13 @@ import Data.Monoid (mempty)
2120import qualified Network.HTTP.Types as H
2221import Network.Socket (SockAddr)
2322import Network.Wai
24−import Network.Wai.Internal
2523import Network.Wai.Handler.Warp.Conduit
2624import Network.Wai.Handler.Warp.ReadInt
25+import Network.Wai.Handler.Warp.RequestHeader
26+import qualified Network.Wai.Handler.Warp.Timeout as Timeout
2727import Network.Wai.Handler.Warp.Types
28+import Network.Wai.Internal
2829import Prelude hiding (lines)
29−import qualified Network.Wai.Handler.Warp.Timeout as Timeout
3030
3131----------------------------------------------------------------
3232
@@ -70,51 +70,6 @@ headerLines =
7070
7171----------------------------------------------------------------
7272
73−parseHeaderLines :: [ByteString] -> IO (ByteString, ByteString, ByteString, H.HttpVersion, H.RequestHeaders)
74−parseHeaderLines [] = throwIO $ NotEnoughLines []
75−parseHeaderLines (firstLine:otherLines) = do
76− (method, rpath', gets, httpversion) <- parseFirst firstLine
77− let rpath = parseRpath rpath'
78− hdr = map parseHeaderNoAttr otherLines
79− return (method, rpath, gets, httpversion, hdr)
80−
81−----------------------------------------------------------------
82−
83−parseFirst :: ByteString
84− -> IO (ByteString, ByteString, ByteString, H.HttpVersion)
85−parseFirst s =
86− case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- ' '
87− (method:query:http'') -> do
88− let http' = S.concat http''
89− (hfirst, hsecond) = S.splitAt 5 http'
90− if hfirst == "HTTP/"
91− then let (rpath, qstring) = S.breakByte 63 query -- '?'
92− hv =
93− case hsecond of
94− "1.1" -> H.http11
95− _ -> H.http10
96− in return (method, rpath, qstring, hv)
97− else throwIO NonHttp
98− _ -> throwIO $ BadFirstLine $ B.unpack s
99−
100−----------------------------------------------------------------
101−
102−parseHeaderNoAttr :: ByteString -> H.Header
103−parseHeaderNoAttr s =
104− let (k, rest) = S.breakByte 58 s -- ':'
105− rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
106− in (CI.mk k, rest')
107−
108−----------------------------------------------------------------
109−
110−parseRpath :: ByteString -> ByteString
111−parseRpath rpath'
112− | S.null rpath' = "/"
113− | "http://" `S.isPrefixOf` rpath' = snd $ S.breakByte 47 $ S.drop 7 rpath'
114− | otherwise = rpath'
115−
116−----------------------------------------------------------------
117−
11873handleExpect :: Connection
11974 -> H.HttpVersion
12075 -> (H.RequestHeaders -> H.RequestHeaders)
@@ -199,7 +154,7 @@ push (THStatus len lines prepend) bs
199154 0 -> True
200155 1 -> S.index bs 0 == 13
201156 _ -> False
202− in Just (nl, (not b) && (c == 32 || c == 9))
157+ in Just (nl, not b && (c == 32 || c == 9))
203158 else
204159 Just (nl, False)
205160
warp/Network/Wai/Handler/Warp/RequestHeader.hsnew file+57
@@ -0,0 +1,57 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+
3+module Network.Wai.Handler.Warp.RequestHeader (parseHeaderLines) where
4+
5+import Control.Exception.Lifted (throwIO)
6+import Data.ByteString (ByteString)
7+import qualified Data.ByteString as S
8+import qualified Data.ByteString.Char8 as B (unpack)
9+import qualified Data.CaseInsensitive as CI
10+import qualified Network.HTTP.Types as H
11+import Network.Wai.Handler.Warp.Types
12+import Prelude hiding (lines)
13+
14+----------------------------------------------------------------
15+
16+parseHeaderLines :: [ByteString] -> IO (ByteString, ByteString, ByteString, H.HttpVersion, H.RequestHeaders)
17+parseHeaderLines [] = throwIO $ NotEnoughLines []
18+parseHeaderLines (firstLine:otherLines) = do
19+ (method, rpath', gets, httpversion) <- parseFirst firstLine
20+ let rpath = parseRpath rpath'
21+ hdr = map parseHeaderNoAttr otherLines
22+ return (method, rpath, gets, httpversion, hdr)
23+
24+----------------------------------------------------------------
25+
26+parseFirst :: ByteString
27+ -> IO (ByteString, ByteString, ByteString, H.HttpVersion)
28+parseFirst s =
29+ case filter (not . S.null) $ S.splitWith (\c -> c == 32 || c == 9) s of -- ' '
30+ (method:query:http'') -> do
31+ let http' = S.concat http''
32+ (hfirst, hsecond) = S.splitAt 5 http'
33+ if hfirst == "HTTP/"
34+ then let (rpath, qstring) = S.breakByte 63 query -- '?'
35+ hv =
36+ case hsecond of
37+ "1.1" -> H.http11
38+ _ -> H.http10
39+ in return (method, rpath, qstring, hv)
40+ else throwIO NonHttp
41+ _ -> throwIO $ BadFirstLine $ B.unpack s
42+
43+----------------------------------------------------------------
44+
45+parseHeaderNoAttr :: ByteString -> H.Header
46+parseHeaderNoAttr s =
47+ let (k, rest) = S.breakByte 58 s -- ':'
48+ rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest
49+ in (CI.mk k, rest')
50+
51+----------------------------------------------------------------
52+
53+parseRpath :: ByteString -> ByteString
54+parseRpath rpath'
55+ | S.null rpath' = "/"
56+ | "http://" `S.isPrefixOf` rpath' = snd $ S.breakByte 47 $ S.drop 7 rpath'
57+ | otherwise = rpath'
warp/warp.cabal+1
@@ -58,6 +58,7 @@ Library
5858 Network.Wai.Handler.Warp.ReadInt
5959 Network.Wai.Handler.Warp.Recv
6060 Network.Wai.Handler.Warp.Request
61+ Network.Wai.Handler.Warp.RequestHeader
6162 Network.Wai.Handler.Warp.Response
6263 Network.Wai.Handler.Warp.ResponseHeader
6364 Network.Wai.Handler.Warp.Run