27d7bc1 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Merge PR #791.

27d7bc1Kazu Yamamoto7 years ago

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

compare with master

unifiedsplit

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

34----------------------------------------------------------------

36conditionalRequest :: I.FileInfo

37− -> H.ResponseHeaders -> IndexedHeader

37+ -> H.ResponseHeaders

38+ -> IndexedHeader -- ^ Response

39+ -> IndexedHeader -- ^ Request

38 -> RspFileInfo

40 -> RspFileInfo

39−conditionalRequest finfo hs0 reqidx = case condition of

41+conditionalRequest finfo hs0 rspidx reqidx = case condition of

40 nobody@(WithoutBody _) -> nobody

42 nobody@(WithoutBody _) -> nobody

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

44+ !hasLM = isJust $ rspidx ! fromEnum ResLastModified

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

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

42− addContentHeaders hs0 off len size

43 in WithBody s hs off len

46 in WithBody s hs off len

44 where

47 where

45 !mtime = I.fileInfoTime finfo

48 !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

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

73 Right finfo -> do

74 let reqidx = indexRequestHeader reqhdr

75+ rspidx = indexResponseHeader rsphdr

75− case conditionalRequest finfo rsphdr reqidx of

76+ case conditionalRequest finfo rsphdr rspidx reqidx of

76 WithoutBody s -> return $ responseNoBody s rsphdr

77 WithoutBody s -> return $ responseNoBody s rsphdr

77 WithBody s rsphdr' off bytes -> do

78 WithBody s rsphdr' off bytes -> do

78 let !off' = fromIntegral off

79 let !off' = fromIntegral off

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

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

69data ResponseHeaderIndex = ResContentLength

70 | ResServer

71 | ResDate

72+ | ResLastModified

72 deriving (Enum,Bounded)

73 deriving (Enum,Bounded)

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

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

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

79responseKeyIndex hn = case BS.length bs of

80responseKeyIndex hn = case BS.length bs of

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

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

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

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

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

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

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

83 _ -> -1

85 _ -> -1

84 where

86 where

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

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

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

117 --

118 -- 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

120 case ms of

121 Nothing -> return ()

122 Just realStatus -> logger req realStatus mlen

123 T.tickle th

124 return ret

125 else do

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

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

127 logger req s Nothing

128 T.tickle th

129 return isPersist

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

196 -> H.HttpVersion

197 -> H.Status

198 -> H.ResponseHeaders

199+ -> IndexedHeader -- Response

199 -> Rsp

200 -> Rsp

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

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

201

202

202----------------------------------------------------------------

203----------------------------------------------------------------

203

204

204−sendRsp conn _ ver s hs RspNoBody = do

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

205 -- Not adding Content-Length.

206 -- Not adding Content-Length.

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

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

207 composeHeader ver s hs >>= connSendAll conn

208 composeHeader ver s hs >>= connSendAll conn

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

209

210

210----------------------------------------------------------------

211----------------------------------------------------------------

211

212

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

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

213 header <- composeHeaderBuilder ver s hs needsChunked

214 header <- composeHeaderBuilder ver s hs needsChunked

214 let hdrBdy

215 let hdrBdy

215 | needsChunked = header <> chunkedTransferEncoding body

216 | needsChunked = header <> chunkedTransferEncoding body

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

222

223

223----------------------------------------------------------------

224----------------------------------------------------------------

224

225

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

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

226 header <- composeHeaderBuilder ver s hs needsChunked

227 header <- composeHeaderBuilder ver s hs needsChunked

227 (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy

228 (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy

228 $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)

229 $ toBuilderBuffer (connWriteBuffer conn) (connBufferSize conn)

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

246

247

247----------------------------------------------------------------

248----------------------------------------------------------------

248

249

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

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

250 withApp recv send

251 withApp recv send

251 return (Nothing, Nothing)

252 return (Nothing, Nothing)

252 where

253 where

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

260

261

261-- Sophisticated WAI applications.

262-- Sophisticated WAI applications.

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

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

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

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

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

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

265 where

266 where

266 beg = filePartOffset part

267 beg = filePartOffset part

267 len = filePartByteCount part

268 len = filePartByteCount part

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

271

272

272-- Simple WAI applications.

273-- Simple WAI applications.

273-- Status is ignored

274-- 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

275 efinfo <- E.try $ getFileInfo ii path

276 efinfo <- E.try $ getFileInfo ii path

276 case efinfo of

277 case efinfo of

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

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

278#ifdef WARP_DEBUG

279#ifdef WARP_DEBUG

279 print _ex >>

280 print _ex >>

280#endif

281#endif

281− sendRspFile404 conn ii ver hs0

282+ sendRspFile404 conn ii ver hs0 rspidxhdr

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

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

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

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

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

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

285

286

286----------------------------------------------------------------

287----------------------------------------------------------------

287

288

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

290 -> H.HttpVersion

291 -> H.HttpVersion

291 -> H.Status

292 -> H.Status

292 -> H.ResponseHeaders

293 -> H.ResponseHeaders

294+ -> IndexedHeader

293 -> FilePath

295 -> FilePath

294 -> Integer

296 -> Integer

295 -> Integer

297 -> Integer

296 -> Bool

298 -> Bool

297 -> IO ()

299 -> IO ()

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

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

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

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

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

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

301 | otherwise = do

303 | otherwise = do

302 lheader <- composeHeader ver s hs

304 lheader <- composeHeader ver s hs

303 (mfd, fresher) <- getFd ii path

305 (mfd, fresher) <- getFd ii path

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

310 -> InternalInfo

312 -> InternalInfo

311 -> H.HttpVersion

313 -> H.HttpVersion

312 -> H.ResponseHeaders

314 -> H.ResponseHeaders

315+ -> IndexedHeader

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

316 -> 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)

315 where

318 where

316 s = H.notFound404

319 s = H.notFound404

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

320 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

21 let WithBody s hs off len = ans

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

23 ans' = WithBody s hs' off len

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

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

26spec :: Spec

27spec = do