27d7bc1 · typeable/wai

git.iko.soy/typeable/wai

Merge PR #791.

commit27d7bc1dd56b53a23d65be80bbaee94c6271a6db authorKazu Yamamoto <kazu@iij.ad.jp> dateWed 29 Jan 2020, 08:26 (7 years ago) parent9a89f81 70684ae

5 files changed+31−22

compare with master

unifiedsplit

warp/Network/Wai/Handler/Warp/File.hs+7−4 warp/Network/Wai/Handler/Warp/HTTP2/Response.hs+2−1 warp/Network/Wai/Handler/Warp/Header.hs+2 warp/Network/Wai/Handler/Warp/Response.hs+19−16 warp/test/FileSpec.hs+1−1

warp/Network/Wai/Handler/Warp/File.hs+7−4

@@ -34,12 +34,15 @@ data RspFileInfo = WithoutBody H.Status

3434----------------------------------------------------------------

3535

3636conditionalRequest :: I.FileInfo

37− -> H.ResponseHeaders -> IndexedHeader

37+ -> H.ResponseHeaders

38+ -> IndexedHeader -- ^ Response

39+ -> IndexedHeader -- ^ Request

3840 -> RspFileInfo

39−conditionalRequest finfo hs0 reqidx = case condition of

41+conditionalRequest finfo hs0 rspidx reqidx = case condition of

4042 nobody@(WithoutBody _) -> nobody

41− WithBody s _ off len -> let !hs = (H.hLastModified,date) :

42− addContentHeaders hs0 off len size

43+ WithBody s _ off len -> let !hs1 = addContentHeaders hs0 off len size

44+ !hasLM = isJust $ rspidx ! fromEnum ResLastModified

45+ !hs = [ (H.hLastModified,date) | not hasLM ] ++ hs1

4346 in WithBody s hs off len

4447 where

4548 !mtime = I.fileInfoTime finfo

warp/Network/Wai/Handler/Warp/HTTP2/Response.hs+2−1

@@ -72,7 +72,8 @@ responseFile _ rsphdr isHead path Nothing ii reqhdr = do

7272 Left (_ex :: E.IOException) -> return $ response404 rsphdr

7373 Right finfo -> do

7474 let reqidx = indexRequestHeader reqhdr

75− case conditionalRequest finfo rsphdr reqidx of

75+ rspidx = indexResponseHeader rsphdr

76+ case conditionalRequest finfo rsphdr rspidx reqidx of

7677 WithoutBody s -> return $ responseNoBody s rsphdr

7778 WithBody s rsphdr' off bytes -> do

7879 let !off' = fromIntegral off

warp/Network/Wai/Handler/Warp/Header.hs+2

@@ -69,6 +69,7 @@ indexResponseHeader hdr = traverseHeader hdr responseMaxIndex responseKeyIndex

6969data ResponseHeaderIndex = ResContentLength

7070 | ResServer

7171 | ResDate

72+ | ResLastModified

7273 deriving (Enum,Bounded)

7374

7475-- | The size for 'IndexedHeader' for HTTP Response.

@@ -79,6 +80,7 @@ responseKeyIndex :: HeaderName -> Int

7980responseKeyIndex hn = case BS.length bs of

8081 4 -> if bs == "date" then fromEnum ResDate else -1

8182 6 -> if bs == "server" then fromEnum ResServer else -1

83+ 13 -> if bs == "last-modified" then fromEnum ResLastModified else -1

8284 14 -> if bs == "content-length" then fromEnum ResContentLength else -1

8385 _ -> -1

8486 where

warp/Network/Wai/Handler/Warp/Response.hs+19−16

@@ -116,14 +116,14 @@ sendResponse settings conn ii th req reqidxhdr src response = do

116116 -- and status, the response to HEAD is processed here.

117117 --

118118 -- See definition of rsp below for proper body stripping.

119− (ms, mlen) <- sendRsp conn ii ver s hs rsp

119+ (ms, mlen) <- sendRsp conn ii ver s hs rspidxhdr rsp

120120 case ms of

121121 Nothing -> return ()

122122 Just realStatus -> logger req realStatus mlen

123123 T.tickle th

124124 return ret

125125 else do

126− _ <- sendRsp conn ii ver s hs RspNoBody

126+ _ <- sendRsp conn ii ver s hs rspidxhdr RspNoBody

127127 logger req s Nothing

128128 T.tickle th

129129 return isPersist

@@ -196,12 +196,13 @@ sendRsp :: Connection

196196 -> H.HttpVersion

197197 -> H.Status

198198 -> H.ResponseHeaders

199+ -> IndexedHeader -- Response

199200 -> Rsp

200201 -> IO (Maybe H.Status, Maybe Integer)

201202

202203----------------------------------------------------------------

203204

204−sendRsp conn _ ver s hs RspNoBody = do

205+sendRsp conn _ ver s hs _ RspNoBody = do

205206 -- Not adding Content-Length.

206207 -- User agents treats it as Content-Length: 0.

207208 composeHeader ver s hs >>= connSendAll conn

@@ -209,7 +210,7 @@ sendRsp conn _ ver s hs RspNoBody = do

209210

210211----------------------------------------------------------------

211212

212−sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do

213+sendRsp conn _ ver s hs _ (RspBuilder body needsChunked) = do

213214 header <- composeHeaderBuilder ver s hs needsChunked

214215 let hdrBdy

215216 | needsChunked = header <> chunkedTransferEncoding body

@@ -222,7 +223,7 @@ sendRsp conn _ ver s hs (RspBuilder body needsChunked) = do

222223

223224----------------------------------------------------------------

224225

225−sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do

226+sendRsp conn _ ver s hs _ (RspStream streamingBody needsChunked th) = do

226227 header <- composeHeaderBuilder ver s hs needsChunked

227228 (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy

228229 $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)

@@ -246,7 +247,7 @@ sendRsp conn _ ver s hs (RspStream streamingBody needsChunked th) = do

246247

247248----------------------------------------------------------------

248249

249−sendRsp conn _ _ _ _ (RspRaw withApp src tickle) = do

250+sendRsp conn _ _ _ _ _ (RspRaw withApp src tickle) = do

250251 withApp recv send

251252 return (Nothing, Nothing)

252253 where

@@ -260,8 +261,8 @@ sendRsp conn _ _ _ _ (RspRaw withApp src tickle) = do

260261

261262-- Sophisticated WAI applications.

262263-- We respect s0. s0 MUST be a proper value.

263−sendRsp conn ii ver s0 hs0 (RspFile path (Just part) _ isHead hook) =

264− sendRspFile2XX conn ii ver s0 hs path beg len isHead hook

264+sendRsp conn ii ver s0 hs0 rspidxhdr (RspFile path (Just part) _ isHead hook) =

265+ sendRspFile2XX conn ii ver s0 hs rspidxhdr path beg len isHead hook

265266 where

266267 beg = filePartOffset part

267268 len = filePartByteCount part

@@ -271,17 +272,17 @@ sendRsp conn ii ver s0 hs0 (RspFile path (Just part) _ isHead hook) =

271272

272273-- Simple WAI applications.

273274-- Status is ignored

274−sendRsp conn ii ver _ hs0 (RspFile path Nothing idxhdr isHead hook) = do

275+sendRsp conn ii ver _ hs0 rspidxhdr (RspFile path Nothing reqidxhdr isHead hook) = do

275276 efinfo <- E.try $ getFileInfo ii path

276277 case efinfo of

277278 Left (_ex :: E.IOException) ->

278279#ifdef WARP_DEBUG

279280 print _ex >>

280281#endif

281− sendRspFile404 conn ii ver hs0

282− Right finfo -> case conditionalRequest finfo hs0 idxhdr of

283− WithoutBody s -> sendRsp conn ii ver s hs0 RspNoBody

284− WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs path beg len isHead hook

282+ sendRspFile404 conn ii ver hs0 rspidxhdr

283+ Right finfo -> case conditionalRequest finfo hs0 rspidxhdr reqidxhdr of

284+ WithoutBody s -> sendRsp conn ii ver s hs0 rspidxhdr RspNoBody

285+ WithBody s hs beg len -> sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook

285286

286287----------------------------------------------------------------

287288

@@ -290,14 +291,15 @@ sendRspFile2XX :: Connection

290291 -> H.HttpVersion

291292 -> H.Status

292293 -> H.ResponseHeaders

294+ -> IndexedHeader

293295 -> FilePath

294296 -> Integer

295297 -> Integer

296298 -> Bool

297299 -> IO ()

298300 -> IO (Maybe H.Status, Maybe Integer)

299−sendRspFile2XX conn ii ver s hs path beg len isHead hook

300− | isHead = sendRsp conn ii ver s hs RspNoBody

301+sendRspFile2XX conn ii ver s hs rspidxhdr path beg len isHead hook

302+ | isHead = sendRsp conn ii ver s hs rspidxhdr RspNoBody

301303 | otherwise = do

302304 lheader <- composeHeader ver s hs

303305 (mfd, fresher) <- getFd ii path

@@ -310,8 +312,9 @@ sendRspFile404 :: Connection

310312 -> InternalInfo

311313 -> H.HttpVersion

312314 -> H.ResponseHeaders

315+ -> IndexedHeader

313316 -> IO (Maybe H.Status, Maybe Integer)

314−sendRspFile404 conn ii ver hs0 = sendRsp conn ii ver s hs (RspBuilder body True)

317+sendRspFile404 conn ii ver hs0 rspidxhdr = sendRsp conn ii ver s hs rspidxhdr (RspBuilder body True)

315318 where

316319 s = H.notFound404

317320 hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0

warp/test/FileSpec.hs+1−1

@@ -21,7 +21,7 @@ testFileRange desc reqhs file ans = it desc $ do

2121 let WithBody s hs off len = ans

2222 hs' = ("Last-Modified",fileInfoDate finfo) : hs

2323 ans' = WithBody s hs' off len

24− conditionalRequest finfo [] (indexRequestHeader reqhs) `shouldBe` ans'

24+ conditionalRequest finfo [] (indexResponseHeader hs) (indexRequestHeader reqhs) `shouldBe` ans'

2525

2626spec :: Spec

2727spec = do