git.iko.soy/typeable/wai
on master help sign in
making more strict.
commite2c87a27b9567b36b7ca5fc8d9aee33357a5dae9 authorKazu Yamamoto <kazu@iij.ad.jp> dateThu 10 Dec 2015, 14:42 (11 years ago) parent2d6b19e
2 files changed+16−15
compare with master
unifiedsplit
warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+1−1 warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+15−14
warp/Network/Wai/Handler/Warp/HTTP2/Receiver.hs+1−1
@@ -184,7 +184,7 @@ control FrameSettings header@FrameHeader{flags} bs Context{http2settings, output
184184 Just x -> E.throwIO x
185185 Nothing -> return ()
186186 unless (testAck flags) $ do
187− modifyIORef http2settings $ \old -> updateSettings old alist
187+ modifyIORef' http2settings $ \old -> updateSettings old alist
188188 let frame = settingsFrame setAck []
189189 enqueueControl outputQ 0 $ OSettings frame alist
190190 return True
warp/Network/Wai/Handler/Warp/HTTP2/Request.hs+15−14
@@ -1,4 +1,5 @@
11{-# LANGUAGE OverloadedStrings, CPP #-}
2+{-# LANGUAGE BangPatterns #-}
23
34module Network.Wai.Handler.Warp.HTTP2.Request (
45 mkRequest
@@ -38,11 +39,11 @@ import qualified Network.Wai.Handler.Warp.Settings as S (Settings, settingsNoPar
3839import qualified Network.Wai.Handler.Warp.Timeout as Timeout
3940
4041data ValidHeaders = ValidHeaders {
41− vhMethod :: ByteString
42− , vhPath :: ByteString
43− , vhAuth :: Maybe ByteString
44− , vhCL :: Maybe Int
45− , vhHeader :: RequestHeaders
42+ vhMethod :: !ByteString
43+ , vhPath :: !ByteString
44+ , vhAuth :: !(Maybe ByteString)
45+ , vhCL :: !(Maybe Int)
46+ , vhHeader :: !RequestHeaders
4647 }
4748
4849type MkReq = ValidHeaders -> IO ByteString -> Request
@@ -51,8 +52,8 @@ mkRequest :: InternalInfo -> S.Settings -> SockAddr -> MkReq
5152mkRequest ii settings addr (ValidHeaders m p ma _ hdr) body = req
5253 where
5354 (unparsedPath,query) = B8.break (=='?') p
54− path = H.extractPath unparsedPath
55− req = Request {
55+ !path = H.extractPath unparsedPath
56+ !req = Request {
5657 requestMethod = m
5758 , httpVersion = http2ver
5859 , rawPathInfo = if S.settingsNoParsePath settings then unparsedPath else path
@@ -70,8 +71,8 @@ mkRequest ii settings addr (ValidHeaders m p ma _ hdr) body = req
7071 , requestHeaderHost = ma
7172 , requestHeaderRange = lookup hRange hdr
7273 }
73− th = threadHandle ii
74− vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)
74+ !th = threadHandle ii
75+ !vaultValue = Vault.insert pauseTimeoutKey (Timeout.pause th)
7576 $ Vault.insert getFileInfoKey (fileInfo ii)
7677 Vault.empty
7778
@@ -90,11 +91,11 @@ emptyPseudo = Pseudo Nothing Nothing Nothing Nothing
9091validateHeaders :: HeaderList -> Maybe ValidHeaders
9192validateHeaders hs = case pseudo hs (emptyPseudo,id) of
9293 Just (Pseudo (Just m) (Just p) ma mcl, h)
93− -> Just $ ValidHeaders m p ma (readInt <$> mcl) h
94+ -> Just $! ValidHeaders m p ma (readInt <$> mcl) h
9495 _ -> Nothing
9596 where
96− pseudo [] (p,b) = Just (p,b [])
97− pseudo h@((k,v):kvs) (p,b)
97+ pseudo [] (!p,!b) = Just (p,b [])
98+ pseudo h@((k,v):kvs) (!p,!b)
9899 | k == ":method" = if isJust (colonMethod p) then
99100 Nothing
100101 else
@@ -111,8 +112,8 @@ validateHeaders hs = case pseudo hs (emptyPseudo,id) of
111112 | isPseudo k = Nothing
112113 | otherwise = normal h (p,b)
113114
114− normal [] (p,b) = Just (p,b [])
115− normal ((k,v):kvs) (p,b)
115+ normal [] (!p,!b) = Just (p,b [])
116+ normal ((k,v):kvs) (!p,!b)
116117 | isPseudo k = Nothing
117118 | k == "connection" = Nothing
118119 | k == "te" = if v == "trailers" then