diff --git a/wai-app-static/Network/Wai/Application/Static.hs b/wai-app-static/Network/Wai/Application/Static.hs index d8feb3253..8e98c9737 100644 --- a/wai-app-static/Network/Wai/Application/Static.hs +++ b/wai-app-static/Network/Wai/Application/Static.hs @@ -157,6 +157,7 @@ serveFile StaticSettings {..} req file -- First check etag values, if turned on | ssUseHash = do mHash <- fileGetHash file + -- FIXME: Doesn't support multiple hashes in 'If-None-Match' header case (mHash, lookup "if-none-match" $ W.requestHeaders req) of -- if-none-match matches the actual hash, return a 304 (Just hash, Just lastHash) | hash == lastHash -> return NotModified diff --git a/warp/Network/Wai/Handler/Warp/File.hs b/warp/Network/Wai/Handler/Warp/File.hs index 6443668dc..b27084837 100644 --- a/warp/Network/Wai/Handler/Warp/File.hs +++ b/warp/Network/Wai/Handler/Warp/File.hs @@ -35,22 +35,38 @@ data RspFileInfo = WithoutBody H.Status conditionalRequest :: I.FileInfo -> H.ResponseHeaders + -> H.Method -> IndexedHeader -- ^ Response -> IndexedHeader -- ^ Request -> RspFileInfo -conditionalRequest finfo hs0 rspidx reqidx = case condition of +conditionalRequest finfo hs0 method rspidx reqidx = case condition of nobody@(WithoutBody _) -> nobody - WithBody s _ off len -> let !hs1 = addContentHeaders hs0 off len size - !hasLM = isJust $ rspidx ! fromEnum ResLastModified - !hs = [ (H.hLastModified,date) | not hasLM ] ++ hs1 - in WithBody s hs off len + WithBody s _ off len -> + let !hs1 = addContentHeaders hs0 off len size + !hs = case rspidx ! fromEnum ResLastModified of + Just _ -> hs1 + Nothing -> (H.hLastModified,date) : hs1 + in WithBody s hs off len where !mtime = I.fileInfoTime finfo !size = I.fileInfoSize finfo !date = I.fileInfoDate finfo - !mcondition = ifmodified reqidx size mtime - <|> ifunmodified reqidx size mtime - <|> ifrange reqidx size mtime + -- According to RFC 9110: + -- "A recipient cache or origin server MUST evaluate the request + -- preconditions defined by this specification in the following order: + -- - If-Match + -- - If-Unmodified-Since + -- - If-None-Match + -- - If-Modified-Since + -- - If-Range + -- + -- We don't actually implement the If-(None-)Match logic, but + -- we also don't want to block middleware or applications from + -- using ETags. And sending If-(None-)Match headers in a request + -- to a server that doesn't use them is requester's problem. + !mcondition = ifunmodified reqidx mtime + <|> ifmodified reqidx mtime method + <|> ifrange reqidx mtime method size !condition = fromMaybe (unconditional reqidx size) mcondition ---------------------------------------------------------------- @@ -66,32 +82,48 @@ ifRange reqidx = reqidx ! fromEnum ReqIfRange >>= parseHTTPDate ---------------------------------------------------------------- -ifmodified :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo -ifmodified reqidx size mtime = do +ifmodified :: IndexedHeader -> HTTPDate -> H.Method -> Maybe RspFileInfo +ifmodified reqidx mtime method = do date <- ifModifiedSince reqidx - return $ if date /= mtime - then unconditional reqidx size - else WithoutBody H.notModified304 - -ifunmodified :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo -ifunmodified reqidx size mtime = do + -- According to RFC 9110: + -- "A recipient MUST ignore If-Modified-Since if the request + -- contains an If-None-Match header field; [...]" + guard . isNothing $ reqidx ! fromEnum ReqIfNoneMatch + -- "A recipient MUST ignore the If-Modified-Since header field + -- if [...] the request method is neither GET nor HEAD." + guard $ method == H.methodGet || method == H.methodHead + guard $ date == mtime || date > mtime + Just $ WithoutBody H.notModified304 + +ifunmodified :: IndexedHeader -> HTTPDate -> Maybe RspFileInfo +ifunmodified reqidx mtime = do date <- ifUnmodifiedSince reqidx - return $ if date == mtime - then unconditional reqidx size - else WithoutBody H.preconditionFailed412 - -ifrange :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo -ifrange reqidx size mtime = do + -- According to RFC 9110: + -- "A recipient MUST ignore If-Unmodified-Since if the request + -- contains an If-Match header field; [...]" + guard . isNothing $ reqidx ! fromEnum ReqIfMatch + guard $ date /= mtime && date < mtime + Just $ WithoutBody H.preconditionFailed412 + +-- TODO: Should technically also strongly match on ETags. +ifrange :: IndexedHeader -> HTTPDate -> H.Method -> Integer -> Maybe RspFileInfo +ifrange reqidx mtime method size = do + -- According to RFC 9110: + -- "When the method is GET and both Range and If-Range are + -- present, evaluate the If-Range precondition:" date <- ifRange reqidx rng <- reqidx ! fromEnum ReqRange - return $ if date == mtime - then parseRange rng size - else WithBody H.ok200 [] 0 size + guard $ method == H.methodGet + return $ + if date == mtime + then parseRange rng size + else WithBody H.ok200 [] 0 size unconditional :: IndexedHeader -> Integer -> RspFileInfo -unconditional reqidx size = case reqidx ! fromEnum ReqRange of - Nothing -> WithBody H.ok200 [] 0 size - Just rng -> parseRange rng size +unconditional reqidx = + case reqidx ! fromEnum ReqRange of + Nothing -> WithBody H.ok200 [] 0 + Just rng -> parseRange rng ---------------------------------------------------------------- diff --git a/warp/Network/Wai/Handler/Warp/HTTP2/Response.hs b/warp/Network/Wai/Handler/Warp/HTTP2/Response.hs index 451647913..25a6e89d0 100644 --- a/warp/Network/Wai/Handler/Warp/HTTP2/Response.hs +++ b/warp/Network/Wai/Handler/Warp/HTTP2/Response.hs @@ -30,13 +30,13 @@ fromResponse settings ii req rsp = do rspst@(h2rsp, st, hasBody) <- case rsp of ResponseFile st rsphdr path mpart -> do let rsphdr' = add date rsphdr - responseFile st rsphdr' isHead path mpart ii reqhdr + responseFile st rsphdr' method path mpart ii reqhdr ResponseBuilder st rsphdr builder -> do let rsphdr' = add date rsphdr - return $ responseBuilder st rsphdr' isHead builder + return $ responseBuilder st rsphdr' method builder ResponseStream st rsphdr strmbdy -> do let rsphdr' = add date rsphdr - return $ responseStream st rsphdr' isHead strmbdy + return $ responseStream st rsphdr' method strmbdy _ -> error "ResponseRaw is not supported in HTTP/2" mh2data <- getHTTP2Data req case mh2data of @@ -46,7 +46,7 @@ fromResponse settings ii req rsp = do !h2rsp' = H2.setResponseTrailersMaker h2rsp trailers return (h2rsp', st, hasBody) where - !isHead = requestMethod req == H.methodHead + !method = requestMethod req !reqhdr = requestHeaders req !server = S.settingsServerName settings add date rsphdr = @@ -58,59 +58,57 @@ fromResponse settings ii req rsp = do ---------------------------------------------------------------- -responseFile :: H.Status -> H.ResponseHeaders -> Bool +responseFile :: H.Status -> H.ResponseHeaders -> H.Method -> FilePath -> Maybe FilePart -> InternalInfo -> H.RequestHeaders -> IO (H2.Response, H.Status, Bool) responseFile st rsphdr _ _ _ _ _ | noBody st = return $ responseNoBody st rsphdr -responseFile st rsphdr isHead path (Just fp) _ _ = - return $ responseFile2XX st rsphdr isHead fileSpec +responseFile st rsphdr method path (Just fp) _ _ = + return $ responseFile2XX st rsphdr method fileSpec where !off' = fromIntegral $ filePartOffset fp !bytes' = fromIntegral $ filePartByteCount fp !fileSpec = H2.FileSpec path off' bytes' -responseFile _ rsphdr isHead path Nothing ii reqhdr = do +responseFile _ rsphdr method path Nothing ii reqhdr = do efinfo <- UnliftIO.tryIO $ getFileInfo ii path case efinfo of Left (_ex :: UnliftIO.IOException) -> return $ response404 rsphdr Right finfo -> do let reqidx = indexRequestHeader reqhdr rspidx = indexResponseHeader rsphdr - case conditionalRequest finfo rsphdr rspidx reqidx of + case conditionalRequest finfo rsphdr method rspidx reqidx of WithoutBody s -> return $ responseNoBody s rsphdr WithBody s rsphdr' off bytes -> do let !off' = fromIntegral off !bytes' = fromIntegral bytes !fileSpec = H2.FileSpec path off' bytes' - return $ responseFile2XX s rsphdr' isHead fileSpec + return $ responseFile2XX s rsphdr' method fileSpec ---------------------------------------------------------------- -responseFile2XX :: H.Status -> H.ResponseHeaders -> Bool -> H2.FileSpec -> (H2.Response, H.Status, Bool) -responseFile2XX st rsphdr isHead fileSpec - | isHead = responseNoBody st rsphdr +responseFile2XX :: H.Status -> H.ResponseHeaders -> H.Method -> H2.FileSpec -> (H2.Response, H.Status, Bool) +responseFile2XX st rsphdr method fileSpec + | method == H.methodHead = responseNoBody st rsphdr | otherwise = (H2.responseFile st rsphdr fileSpec, st, True) ---------------------------------------------------------------- -responseBuilder :: H.Status -> H.ResponseHeaders -> Bool +responseBuilder :: H.Status -> H.ResponseHeaders -> H.Method -> BB.Builder -> (H2.Response, H.Status, Bool) -responseBuilder st rsphdr isHead builder - | noBody st = responseNoBody st rsphdr - | isHead = responseNoBody st rsphdr +responseBuilder st rsphdr method builder + | method == H.methodHead || noBody st = responseNoBody st rsphdr | otherwise = (H2.responseBuilder st rsphdr builder, st, True) ---------------------------------------------------------------- -responseStream :: H.Status -> H.ResponseHeaders -> Bool +responseStream :: H.Status -> H.ResponseHeaders -> H.Method -> StreamingBody -> (H2.Response, H.Status, Bool) -responseStream st rsphdr isHead strmbdy - | noBody st = responseNoBody st rsphdr - | isHead = responseNoBody st rsphdr +responseStream st rsphdr method strmbdy + | method == H.methodHead || noBody st = responseNoBody st rsphdr | otherwise = (H2.responseStreaming st rsphdr strmbdy, st, True) ---------------------------------------------------------------- diff --git a/warp/Network/Wai/Handler/Warp/Header.hs b/warp/Network/Wai/Handler/Warp/Header.hs index 39de2afc8..94970a067 100644 --- a/warp/Network/Wai/Handler/Warp/Header.hs +++ b/warp/Network/Wai/Handler/Warp/Header.hs @@ -31,35 +31,50 @@ data RequestHeaderIndex = ReqContentLength | ReqIfRange | ReqReferer | ReqUserAgent + | ReqIfMatch + | ReqIfNoneMatch deriving (Enum,Bounded) -- | The size for 'IndexedHeader' for HTTP Request. --- From 0 to this corresponds to \"Content-Length\", \"Transfer-Encoding\", --- \"Expect\", \"Connection\", \"Range\", \"Host\", --- \"If-Modified-Since\", \"If-Unmodified-Since\" and \"If-Range\". +-- From 0 to this corresponds to: +-- +-- - \"Content-Length\" +-- - \"Transfer-Encoding\" +-- - \"Expect\" +-- - \"Connection\" +-- - \"Range\" +-- - \"Host\" +-- - \"If-Modified-Since\" +-- - \"If-Unmodified-Since\" +-- - \"If-Range\" +-- - \"Referer\" +-- - \"User-Agent\" +-- - \"If-Match\" +-- - \"If-None-Match\" requestMaxIndex :: Int requestMaxIndex = fromEnum (maxBound :: RequestHeaderIndex) requestKeyIndex :: HeaderName -> Int requestKeyIndex hn = case BS.length bs of - 4 -> if bs == "host" then fromEnum ReqHost else -1 - 5 -> if bs == "range" then fromEnum ReqRange else -1 - 6 -> if bs == "expect" then fromEnum ReqExpect else -1 - 7 -> if bs == "referer" then fromEnum ReqReferer else -1 - 8 -> if bs == "if-range" then fromEnum ReqIfRange else -1 - 10 -> if bs == "user-agent" then fromEnum ReqUserAgent else - if bs == "connection" then fromEnum ReqConnection else -1 - 14 -> if bs == "content-length" then fromEnum ReqContentLength else -1 - 17 -> if bs == "transfer-encoding" then fromEnum ReqTransferEncoding else - if bs == "if-modified-since" then fromEnum ReqIfModifiedSince - else -1 - 19 -> if bs == "if-unmodified-since" then fromEnum ReqIfUnmodifiedSince else -1 + 4 | bs == "host" -> fromEnum ReqHost + 5 | bs == "range" -> fromEnum ReqRange + 6 | bs == "expect" -> fromEnum ReqExpect + 7 | bs == "referer" -> fromEnum ReqReferer + 8 | bs == "if-range" -> fromEnum ReqIfRange + | bs == "if-match" -> fromEnum ReqIfMatch + 10 | bs == "user-agent" -> fromEnum ReqUserAgent + | bs == "connection" -> fromEnum ReqConnection + 13 | bs == "if-none-match" -> fromEnum ReqIfNoneMatch + 14 | bs == "content-length" -> fromEnum ReqContentLength + 17 | bs == "transfer-encoding" -> fromEnum ReqTransferEncoding + | bs == "if-modified-since" -> fromEnum ReqIfModifiedSince + 19 | bs == "if-unmodified-since" -> fromEnum ReqIfUnmodifiedSince _ -> -1 where bs = foldedCase hn defaultIndexRequestHeader :: IndexedHeader -defaultIndexRequestHeader = array (0,requestMaxIndex) [(i,Nothing)|i<-[0..requestMaxIndex]] +defaultIndexRequestHeader = array (0, requestMaxIndex) [(i, Nothing) | i <- [0..requestMaxIndex]] ---------------------------------------------------------------- @@ -78,10 +93,10 @@ responseMaxIndex = fromEnum (maxBound :: ResponseHeaderIndex) responseKeyIndex :: HeaderName -> Int responseKeyIndex hn = case BS.length bs of - 4 -> if bs == "date" then fromEnum ResDate else -1 - 6 -> if bs == "server" then fromEnum ResServer else -1 - 13 -> if bs == "last-modified" then fromEnum ResLastModified else -1 - 14 -> if bs == "content-length" then fromEnum ResContentLength else -1 + 4 | bs == "date" -> fromEnum ResDate + 6 | bs == "server" -> fromEnum ResServer + 13 | bs == "last-modified" -> fromEnum ResLastModified + 14 | bs == "content-length" -> fromEnum ResContentLength _ -> -1 where bs = foldedCase hn diff --git a/warp/Network/Wai/Handler/Warp/Response.hs b/warp/Network/Wai/Handler/Warp/Response.hs index ff0e3a38a..ebc3790e5 100644 --- a/warp/Network/Wai/Handler/Warp/Response.hs +++ b/warp/Network/Wai/Handler/Warp/Response.hs @@ -95,7 +95,7 @@ import Network.Wai.Handler.Warp.Types -- -- Simple applications should specify 'Nothing' to -- 'Maybe' 'FilePart'. The size of the specified file is obtained --- by disk access or from the file infor cache. +-- by disk access or from the file info cache. -- If-Modified-Since, If-Unmodified-Since, If-Range and Range -- are processed. Since a proper status is chosen, 'Status' is -- ignored. Last-Modified is inserted. @@ -118,14 +118,14 @@ sendResponse settings conn ii th req reqidxhdr src response = do -- and status, the response to HEAD is processed here. -- -- See definition of rsp below for proper body stripping. - (ms, mlen) <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize rsp + (ms, mlen) <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method rsp case ms of Nothing -> return () Just realStatus -> logger req realStatus mlen T.tickle th return ret else do - _ <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize RspNoBody + _ <- sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody logger req s Nothing T.tickle th return isPersist @@ -142,7 +142,8 @@ sendResponse settings conn ii th req reqidxhdr src response = do (isPersist,isChunked0) = infoFromRequest req reqidxhdr isChunked = not isHead && isChunked0 (isKeepAlive, needsChunked) = infoFromResponse rspidxhdr (isPersist,isChunked) - isHead = requestMethod req == H.methodHead + method = requestMethod req + isHead = method == H.methodHead rsp = case response of ResponseFile _ _ path mPart -> RspFile path mPart reqidxhdr isHead (T.tickle th) ResponseBuilder _ _ b @@ -202,12 +203,13 @@ sendRsp :: Connection -> H.ResponseHeaders -> IndexedHeader -- Response -> Int -- maxBuilderResponseBufferSize + -> H.Method -> Rsp -> IO (Maybe H.Status, Maybe Integer) ---------------------------------------------------------------- -sendRsp conn _ _ ver s hs _ _ RspNoBody = do +sendRsp conn _ _ ver s hs _ _ _ RspNoBody = do -- Not adding Content-Length. -- User agents treats it as Content-Length: 0. composeHeader ver s hs >>= connSendAll conn @@ -215,7 +217,7 @@ sendRsp conn _ _ ver s hs _ _ RspNoBody = do ---------------------------------------------------------------- -sendRsp conn _ th ver s hs _ maxRspBufSize (RspBuilder body needsChunked) = do +sendRsp conn _ th ver s hs _ maxRspBufSize _ (RspBuilder body needsChunked) = do header <- composeHeaderBuilder ver s hs needsChunked let hdrBdy | needsChunked = header <> chunkedTransferEncoding body @@ -227,7 +229,7 @@ sendRsp conn _ th ver s hs _ maxRspBufSize (RspBuilder body needsChunked) = do ---------------------------------------------------------------- -sendRsp conn _ th ver s hs _ _ (RspStream streamingBody needsChunked) = do +sendRsp conn _ th ver s hs _ _ _ (RspStream streamingBody needsChunked) = do header <- composeHeaderBuilder ver s hs needsChunked (recv, finish) <- newByteStringBuilderRecv $ reuseBufferStrategy $ toBuilderBuffer $ connWriteBuffer conn @@ -251,7 +253,7 @@ sendRsp conn _ th ver s hs _ _ (RspStream streamingBody needsChunked) = do ---------------------------------------------------------------- -sendRsp conn _ th _ _ _ _ _ (RspRaw withApp src) = do +sendRsp conn _ th _ _ _ _ _ _ (RspRaw withApp src) = do withApp recv send return (Nothing, Nothing) where @@ -265,8 +267,8 @@ sendRsp conn _ th _ _ _ _ _ (RspRaw withApp src) = do -- Sophisticated WAI applications. -- We respect s0. s0 MUST be a proper value. -sendRsp conn ii th ver s0 hs0 rspidxhdr maxRspBufSize (RspFile path (Just part) _ isHead hook) = - sendRspFile2XX conn ii th ver s0 hs rspidxhdr maxRspBufSize path beg len isHead hook +sendRsp conn ii th ver s0 hs0 rspidxhdr maxRspBufSize method (RspFile path (Just part) _ isHead hook) = + sendRspFile2XX conn ii th ver s0 hs rspidxhdr maxRspBufSize method path beg len isHead hook where beg = filePartOffset part len = filePartByteCount part @@ -276,17 +278,17 @@ sendRsp conn ii th ver s0 hs0 rspidxhdr maxRspBufSize (RspFile path (Just part) -- Simple WAI applications. -- Status is ignored -sendRsp conn ii th ver _ hs0 rspidxhdr maxRspBufSize (RspFile path Nothing reqidxhdr isHead hook) = do +sendRsp conn ii th ver _ hs0 rspidxhdr maxRspBufSize method (RspFile path Nothing reqidxhdr isHead hook) = do efinfo <- UnliftIO.tryIO $ getFileInfo ii path case efinfo of Left (_ex :: UnliftIO.IOException) -> #ifdef WARP_DEBUG print _ex >> #endif - sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize - Right finfo -> case conditionalRequest finfo hs0 rspidxhdr reqidxhdr of - WithoutBody s -> sendRsp conn ii th ver s hs0 rspidxhdr maxRspBufSize RspNoBody - WithBody s hs beg len -> sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize path beg len isHead hook + sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize method + Right finfo -> case conditionalRequest finfo hs0 method rspidxhdr reqidxhdr of + WithoutBody s -> sendRsp conn ii th ver s hs0 rspidxhdr maxRspBufSize method RspNoBody + WithBody s hs beg len -> sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize method path beg len isHead hook ---------------------------------------------------------------- @@ -298,14 +300,15 @@ sendRspFile2XX :: Connection -> H.ResponseHeaders -> IndexedHeader -> Int + -> H.Method -> FilePath -> Integer -> Integer -> Bool -> IO () -> IO (Maybe H.Status, Maybe Integer) -sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize path beg len isHead hook - | isHead = sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize RspNoBody +sendRspFile2XX conn ii th ver s hs rspidxhdr maxRspBufSize method path beg len isHead hook + | isHead = sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method RspNoBody | otherwise = do lheader <- composeHeader ver s hs (mfd, fresher) <- getFd ii path @@ -321,8 +324,10 @@ sendRspFile404 :: Connection -> H.ResponseHeaders -> IndexedHeader -> Int + -> H.Method -> IO (Maybe H.Status, Maybe Integer) -sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize = sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize (RspBuilder body True) +sendRspFile404 conn ii th ver hs0 rspidxhdr maxRspBufSize method = + sendRsp conn ii th ver s hs rspidxhdr maxRspBufSize method (RspBuilder body True) where s = H.notFound404 hs = replaceHeader H.hContentType "text/plain; charset=utf-8" hs0 diff --git a/warp/test/FileSpec.hs b/warp/test/FileSpec.hs index f0519174d..cd088ded0 100644 --- a/warp/test/FileSpec.hs +++ b/warp/test/FileSpec.hs @@ -2,44 +2,117 @@ module FileSpec (main, spec) where +import Data.ByteString +import Data.String (fromString) import Network.HTTP.Types import Network.Wai.Handler.Warp.File import Network.Wai.Handler.Warp.FileInfoCache import Network.Wai.Handler.Warp.Header +import System.IO.Unsafe (unsafePerformIO) import Test.Hspec main :: IO () main = hspec spec +changeHeaders :: (ResponseHeaders -> ResponseHeaders) -> RspFileInfo -> RspFileInfo +changeHeaders f rfi = + case rfi of + WithBody s hs off len -> WithBody s (f hs) off len + other -> other + +getHeaders :: RspFileInfo -> ResponseHeaders +getHeaders rfi = + case rfi of + WithBody _ hs _ _ -> hs + _ -> [] + testFileRange :: String - -> RequestHeaders -> FilePath + -> RequestHeaders -> RspFileInfo -> Spec -testFileRange desc reqhs file ans = it desc $ do - finfo <- getInfo file - let WithBody s hs off len = ans - hs' = ("Last-Modified",fileInfoDate finfo) : hs - ans' = WithBody s hs' off len - conditionalRequest finfo [] (indexResponseHeader hs) (indexRequestHeader reqhs) `shouldBe` ans' +testFileRange desc reqhs ans = it desc $ do + finfo <- getInfo "attic/hex" + let f = (:) ("Last-Modified", fileInfoDate finfo) + hs = getHeaders ans + ans' = changeHeaders f ans + conditionalRequest + finfo + [] + methodGet + (indexResponseHeader hs) + (indexRequestHeader reqhs) `shouldBe` ans' + +farPast, farFuture :: ByteString +farPast = "Thu, 01 Jan 1970 00:00:00 GMT" +farFuture = "Sun, 05 Oct 3000 00:00:00 GMT" + +regularBody :: RspFileInfo +regularBody = WithBody ok200 [("Content-Length","16"),("Accept-Ranges","bytes")] 0 16 + +make206Body :: Integer -> Integer -> RspFileInfo +make206Body start len = + WithBody status206 [crHeader, lenHeader, ("Accept-Ranges","bytes")] start len + where + lenHeader = ("Content-Length", fromString $ show len) + crHeader = ("Content-Range", fromString $ "bytes " <> show start <> "-" <> show (start + len - 1) <> "/16") spec :: Spec spec = do describe "conditionalRequest" $ do testFileRange "gets a file size from file system" - [] "attic/hex" - $ WithBody ok200 [("Content-Length","16"),("Accept-Ranges","bytes")] 0 16 + [] + regularBody testFileRange "gets a file size from file system and handles Range and returns Partical Content" - [("Range","bytes=2-14")] "attic/hex" - $ WithBody status206 [("Content-Range","bytes 2-14/16"),("Content-Length","13"),("Accept-Ranges","bytes")] 2 13 + [("Range","bytes=2-14")] + $ make206Body 2 13 testFileRange "truncates end point of range to file size" - [("Range","bytes=10-20")] "attic/hex" - $ WithBody status206 [("Content-Range","bytes 10-15/16"),("Content-Length","6"),("Accept-Ranges","bytes")] 10 6 + [("Range","bytes=10-20")] + $ make206Body 10 6 testFileRange "gets a file size from file system and handles Range and returns OK if Range means the entire" - [("Range:","bytes=0-15")] "attic/hex" - $ WithBody status200 [("Content-Length","16"),("Accept-Ranges","bytes")] 0 16 - + [("Range:","bytes=0-15")] + regularBody + testFileRange + "returns a 412 if the file has been changed in the meantime" + [("If-Unmodified-Since", farPast)] + $ WithoutBody status412 + testFileRange + "gets a file if the file has not been changed in the meantime" + [("If-Unmodified-Since", farFuture)] + regularBody + testFileRange + "ignores the If-Unmodified-Since header if an If-Match header is also present" + [("If-Match", "SomeETag"), ("If-Unmodified-Since", farPast)] + regularBody + testFileRange + "still gives only a range, even after conditionals" + [("If-Match", "SomeETag"), ("If-Unmodified-Since", farPast), ("Range","bytes=10-20")] + $ make206Body 10 6 + testFileRange + "gets a file if the file has been changed in the meantime" + [("If-Modified-Since", farPast)] + regularBody + testFileRange + "returns a 304 if the file has not been changed in the meantime" + [("If-Modified-Since", farFuture)] + $ WithoutBody status304 + testFileRange + "ignores the If-Modified-Since header if an If-None-Match header is also present" + [("If-None-Match", "SomeETag"), ("If-Modified-Since", farFuture)] + regularBody + testFileRange + "still gives only a range, even after conditionals" + [("If-None-Match", "SomeETag"), ("If-Modified-Since", farFuture), ("Range","bytes=10-13")] + $ make206Body 10 4 + testFileRange + "gives the a range, if the condition is met" + [("If-Range", fileInfoDate (unsafePerformIO $ getInfo "attic/hex")), ("Range","bytes=2-7")] + $ make206Body 2 6 + testFileRange + "gives the entire body and ignores the Range header if the condition isn't met" + [("If-Range", farPast), ("Range","bytes=2-7")] + regularBody