git.iko.soy/typeable/wai
on master help sign in
Spliting Request.hs.
65e17d6Kazu Yamamoto
warp/Network/Wai/Handler/Warp/Request.hs+4−49
compare with master
unifiedsplit
@@ -12,7 +12,6 @@ import Control.Exception.Lifted (throwIO)
12import Control.Monad.IO.Class (liftIO)
12import Control.Monad.IO.Class (liftIO)
13import Data.ByteString (ByteString)
13import Data.ByteString (ByteString)
14import qualified Data.ByteString as S
14import qualified Data.ByteString as S
15−import qualified Data.ByteString.Char8 as B (unpack)
16import qualified Data.ByteString.Unsafe as SU
15import qualified Data.ByteString.Unsafe as SU
17import qualified Data.CaseInsensitive as CI
16import qualified Data.CaseInsensitive as CI
18import Data.Conduit
17import Data.Conduit
@@ -21,12 +20,13 @@ import Data.Monoid (mempty)
21import qualified Network.HTTP.Types as H
20import qualified Network.HTTP.Types as H
22import Network.Socket (SockAddr)
21import Network.Socket (SockAddr)
23import Network.Wai
22import Network.Wai
24−import Network.Wai.Internal
25import Network.Wai.Handler.Warp.Conduit
23import Network.Wai.Handler.Warp.Conduit
26import Network.Wai.Handler.Warp.ReadInt
24import Network.Wai.Handler.Warp.ReadInt
25+import Network.Wai.Handler.Warp.RequestHeader
26+import qualified Network.Wai.Handler.Warp.Timeout as Timeout
27import Network.Wai.Handler.Warp.Types
27import Network.Wai.Handler.Warp.Types
28+import Network.Wai.Internal
28import Prelude hiding (lines)
29import Prelude hiding (lines)
29−import qualified Network.Wai.Handler.Warp.Timeout as Timeout
30
30
31----------------------------------------------------------------
31----------------------------------------------------------------
32
32
@@ -70,51 +70,6 @@ headerLines =
70
70
71----------------------------------------------------------------
71----------------------------------------------------------------
72
72
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−
118handleExpect :: Connection
73handleExpect :: Connection
119 -> H.HttpVersion
74 -> H.HttpVersion
120 -> (H.RequestHeaders -> H.RequestHeaders)
75 -> (H.RequestHeaders -> H.RequestHeaders)
@@ -199,7 +154,7 @@ push (THStatus len lines prepend) bs
199 0 -> True
154 0 -> True
200 1 -> S.index bs 0 == 13
155 1 -> S.index bs 0 == 13
201 _ -> False
156 _ -> False
202− in Just (nl, (not b) && (c == 32 || c == 9))
157+ in Just (nl, not b && (c == 32 || c == 9))
203 else
158 else
204 Just (nl, False)
159 Just (nl, False)
205
160
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
58 Network.Wai.Handler.Warp.ReadInt
58 Network.Wai.Handler.Warp.ReadInt
59 Network.Wai.Handler.Warp.Recv
59 Network.Wai.Handler.Warp.Recv
60 Network.Wai.Handler.Warp.Request
60 Network.Wai.Handler.Warp.Request
61+ Network.Wai.Handler.Warp.RequestHeader
61 Network.Wai.Handler.Warp.Response
62 Network.Wai.Handler.Warp.Response
62 Network.Wai.Handler.Warp.ResponseHeader
63 Network.Wai.Handler.Warp.ResponseHeader
63 Network.Wai.Handler.Warp.Run
64 Network.Wai.Handler.Warp.Run