6037c38 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Making put sallower.

6037c38Kazu Yamamoto14 years ago

warp/Network/Wai/Handler/Warp/Request.hs+60−58

compare with master

unifiedsplit

@@ -15,6 +15,7 @@ import Data.Conduit

15import qualified Data.IORef as I

16import Data.Maybe (fromMaybe)

17import Data.Monoid (mempty)

18+import Data.Void (Void)

18import Data.Word (Word8)

19import Data.Word (Word8)

19import qualified Network.HTTP.Types as H

20import qualified Network.HTTP.Types as H

20import Network.Socket (SockAddr)

21import Network.Socket (SockAddr)

@@ -142,68 +143,69 @@ data THStatus = THStatus

142takeHeaders :: Sink ByteString (ResourceT IO) [ByteString]

143takeHeaders :: Sink ByteString (ResourceT IO) [ByteString]

143takeHeaders =

144takeHeaders =

144 await >>= maybe (throwIO ConnectionClosedByPeer) (push (THStatus 0 id id))

145 await >>= maybe (throwIO ConnectionClosedByPeer) (push (THStatus 0 id id))

145− where

146− close :: Sink ByteString (ResourceT IO) a

147− close = throwIO IncompleteHeaders

148

146

147+close :: Sink ByteString (ResourceT IO) a

148+close = throwIO IncompleteHeaders

149+

150+push :: THStatus -> ByteString -> Pipe ByteString ByteString Void () (ResourceT IO) [ByteString]

149− push (THStatus len lines prepend) bs

151+push (THStatus len lines prepend) bs

150 -- Too many bytes

152 -- Too many bytes

151 | len > maxTotalHeaderLength = throwIO OverLargeHeader

153 | len > maxTotalHeaderLength = throwIO OverLargeHeader

152− | otherwise =

154+ | otherwise = push' mnl

155+ where

156+ bsLen = S.length bs

153− case mnl of

157+ mnl = do

158+ nl <- S.elemIndex 10 bs

159+ -- check if there are two more bytes in the bs

160+ -- if so, see if the second of those is a horizontal space

161+ if bsLen > nl + 1 then

162+ let c = S.index bs (nl + 1)

163+ in Just (nl, c == 32 || c == 9)

164+ else

165+ Just (nl, False)

166+

167+ {-# INLINE push' #-}

154− -- No newline find in this chunk. Add it to the prepend,

168+ -- No newline find in this chunk. Add it to the prepend,

155− -- update the length, and continue processing.

169+ -- update the length, and continue processing.

156− Nothing ->

170+ push' Nothing = await >>= maybe close (push status)

171+ where

157− let len' = len + bsLen

172+ len' = len + bsLen

158− prepend' = prepend . S.append bs

173+ prepend' = prepend . S.append bs

159− status = THStatus len' lines prepend'

174+ status = THStatus len' lines prepend'

160− in await >>= maybe close (push status)

161− -- Found a newline, but next line continues as a multiline header

175+ -- Found a newline, but next line continues as a multiline header

162− Just (end, True) ->

176+ push' (Just (end, True)) = push status rest

177+ where

163− let rest = S.drop (end + 1) bs

178+ rest = S.drop (end + 1) bs

164− prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs)

179+ prepend' = prepend . S.append (SU.unsafeTake (checkCR bs end) bs)

165− len' = len + end

180+ len' = len + end

166− status = THStatus len' lines prepend'

181+ status = THStatus len' lines prepend'

167− in push status rest

168− -- Found a newline at position end.

182+ -- Found a newline at position end.

169− Just (end, False) ->

183+ push' (Just (end, False))

170− let start = end + 1 -- start of next chunk

184+ -- leftover

171− line

172− -- There were some bytes before the newline, get them

173− | end > 0 = prepend $ SU.unsafeTake (checkCR bs end) bs

174− -- No bytes before the newline

175− | otherwise = prepend S.empty

176− in if S.null line

177− -- no more headers

178− then

179− let lines' = lines []

185+ | S.null line = let lines' = lines []

180− -- leftover

181− rest = if start < bsLen

186+ rest = if start < bsLen then

182− then Just (SU.unsafeDrop start bs)

187+ Just (SU.unsafeDrop start bs)

188+ else

183− else Nothing

189+ Nothing

184− in maybe (return ()) leftover rest >> return lines'

190+ in maybe (return ()) leftover rest >> return lines'

185− -- more headers

191+ -- more headers

186− else

187− let len' = len + start

192+ | otherwise = let len' = len + start

188− lines' = lines . (line:)

193+ lines' = lines . (line:)

189− status = THStatus len' lines' id

194+ status = THStatus len' lines' id

190− in if start < bsLen

195+ in if start < bsLen then

191− -- more bytes in this chunk, push again

196+ -- more bytes in this chunk, push again

192− then let bs' = SU.unsafeDrop start bs

197+ let bs' = SU.unsafeDrop start bs

193− in push status bs'

198+ in push status bs'

199+ else

194− -- no more bytes in this chunk, ask for more

200+ -- no more bytes in this chunk, ask for more

195− else await >>= maybe close (push status)

201+ await >>= maybe close (push status)

196 where

202 where

197− bsLen = S.length bs

203+ start = end + 1 -- start of next chunk

198− mnl = do

204+ line

199− nl <- S.elemIndex 10 bs

205+ -- There were some bytes before the newline, get them

200− -- check if there are two more bytes in the bs

206+ | end > 0 = prepend $ SU.unsafeTake (checkCR bs end) bs

201− -- if so, see if the second of those is a horizontal space

207+ -- No bytes before the newline

202− if bsLen > nl + 1 then

208+ | otherwise = prepend S.empty

203− let c = S.index bs (nl + 1)

204− in Just (nl, c == 32 || c == 9)

205− else

206− Just (nl, False)

207

209

208{-# INLINE checkCR #-}

210{-# INLINE checkCR #-}

209checkCR :: ByteString -> Int -> Int

211checkCR :: ByteString -> Int -> Int

warp/warp.cabal+12−11

@@ -18,19 +18,20 @@ Flag network-bytestring

19Library

20 Build-Depends: base >= 3 && < 5

21+ , blaze-builder >= 0.2.1.4 && < 0.4

22+ , blaze-builder-conduit >= 0.5 && < 0.6

21 , bytestring >= 0.9.1.4

23 , bytestring >= 0.9.1.4

22− , wai >= 1.3 && < 1.4

24+ , case-insensitive >= 0.2

23− , transformers >= 0.2.2 && < 0.4

24 , conduit >= 0.5 && < 0.6

25 , conduit >= 0.5 && < 0.6

25− , network-conduit >= 0.5 && < 0.6

26+ , ghc-prim

26− , blaze-builder-conduit >= 0.5 && < 0.6

27+ , http-types >= 0.7 && < 0.8

27 , lifted-base >= 0.1 && < 0.2

28 , lifted-base >= 0.1 && < 0.2

28− , blaze-builder >= 0.2.1.4 && < 0.4

29+ , network-conduit >= 0.5 && < 0.6

29 , simple-sendfile >= 0.2.4 && < 0.3

30 , simple-sendfile >= 0.2.4 && < 0.3

30− , http-types >= 0.7 && < 0.8

31+ , transformers >= 0.2.2 && < 0.4

31− , case-insensitive >= 0.2

32 , unix-compat >= 0.2

33− , ghc-prim

33+ , void

34+ , wai >= 1.3 && < 1.4

34 if flag(network-bytestring)

35 if flag(network-bytestring)

35 Build-Depends: network >= 2.2.1.5 && < 2.2.3

36 Build-Depends: network >= 2.2.1.5 && < 2.2.3

36 , network-bytestring >= 0.1.3 && < 0.1.4

37 , network-bytestring >= 0.1.3 && < 0.1.4

@@ -58,14 +59,14 @@ Test-Suite test

58 Ghc-Options: -Wall

59 Ghc-Options: -Wall

59 Build-Depends: base >= 4 && < 5

60 Build-Depends: base >= 4 && < 5

60 , HUnit

61 , HUnit

61− , hspec

62 , bytestring

63− , warp

64 , conduit

63 , conduit

65− , network

64+ , hspec

66 , http-types

65 , http-types

66+ , network

67 , transformers

68 , wai

69+ , warp

70Source-Repository head

71Source-Repository head

71 Type: git

72 Type: git