7c34e45 · typeable/wai

git.iko.soy/typeable/wai

on master help sign in

Add support for serving file ranges

7c34e45Andrew Pritchard11 years ago

wai/Network/Wai/HTTP2.hs+69−11

compare with master

unifiedsplit

@@ -14,9 +14,14 @@ module Network.Wai.HTTP2

14 , PushPromise(..)

15 , promiseHeaders

16 -- * Conveniences

17− , SimpleBody

18 , promoteApplication

17 , promoteApplication

18+ -- ** 'Responder's

19 , responder

20+ , respondFile

21+ , respondFilePart

22+ , respondNotFound

23+ -- ** 'Body's

24+ , SimpleBody

20 , streamFilePart

25 , streamFilePart

21 , streamBuilder

26 , streamBuilder

22 , streamSimple

27 , streamSimple

@@ -31,10 +36,13 @@ import qualified Network.HTTP.Types as H

32import Network.Wai (Application)

37import Network.Wai (Application)

33import Network.Wai.Internal

38import Network.Wai.Internal

34− ( FilePart

39+ ( FilePart(..)

35− , Request

40+ , Request(requestHeaders)

36 , Response(..)

41 , Response(..)

37 , ResponseReceived(..)

42 , ResponseReceived(..)

43+ , adjustForFilePart

44+ , chooseFilePart

45+ , tryGetFileSize

38 )

46 )

40-- | Headers sent after the end of a data stream, as defined by section 4.1.2 of

48-- | Headers sent after the end of a data stream, as defined by section 4.1.2 of

@@ -54,7 +62,7 @@ data PushPromise = PushPromise

54type HTTP2Application = Request -> PushFunc -> Responder

62type HTTP2Application = Request -> PushFunc -> Responder

56-- | Part of a streaming response -- either a 'Builder' or a range of a file.

64-- | Part of a streaming response -- either a 'Builder' or a range of a file.

57−data Chunk = FileChunk FilePath (Maybe FilePart) | BuilderChunk Builder

65+data Chunk = FileChunk FilePath FilePart | BuilderChunk Builder

59-- | The streaming body of a response. Equivalent to

67-- | The streaming body of a response. Equivalent to

60-- 'Network.Wai.StreamingBody' except that it can also write file ranges and

68-- 'Network.Wai.StreamingBody' except that it can also write file ranges and

@@ -91,10 +99,50 @@ promiseHeaders p =

91 , (":scheme", promisedScheme p)

99 , (":scheme", promisedScheme p)

92 ] ++ promisedHeader p

100 ] ++ promisedHeader p

101

94−-- | Create a response body consisting of a single range of a file.

102+-- | Create a response body consisting of a single range of a file. Does not

103+-- set Content-Length or Content-Range headers. For that, use

104+-- 'respondFilePart' or 'respondFile'.

95−streamFilePart :: FilePath -> Maybe FilePart -> Body ()

105+streamFilePart :: FilePath -> FilePart -> Body ()

96streamFilePart path part write _ = write $ FileChunk path part

106streamFilePart path part write _ = write $ FileChunk path part

107

108+-- | Respond with a single range of a file, adding the Content-Length and

109+-- Content-Range headers and changing the status to 206 as appropriate.

110+--

111+-- If you want the range to be inferred automatically from the Range header,

112+-- use 'respondFile' instead.

113+respondFilePart :: H.Status -> H.ResponseHeaders -> FilePath -> FilePart -> Responder

114+respondFilePart s h path part respond = do

115+ let (s', h') = adjustForFilePart s h part

116+ respond s' h' $ streamFilePart path part

117+ return []

118+

119+-- | Serve the requested range of the specified file (based on the Range

120+-- header), using the given 'H.Status' and 'H.ResponseHeaders' as a base. If

121+-- the file is not accessible, the status will be replaced with 404 and a

122+-- default not-found message will be served. If a partial file is requested,

123+-- the status will be replaced with 206 and the Content-Range header will be

124+-- added. The Content-Length header will always be added.

125+respondFile :: H.Status -> H.ResponseHeaders -> FilePath -> H.RequestHeaders -> Responder

126+respondFile s h path req respond = do

127+ fileSize <- tryGetFileSize path

128+ case fileSize of

129+ Left _ -> respondNotFound h respond

130+ Right size -> respondFileExists s h path size req respond

131+

132+-- As 'respondFile', but with prior knowledge of the file's existence and size.

133+respondFileExists :: H.Status -> H.ResponseHeaders -> FilePath -> Integer -> H.RequestHeaders -> Responder

134+respondFileExists s h path size reqHdrs =

135+ respondFilePart s h path $ chooseFilePart size $ lookup H.hRange reqHdrs

136+

137+-- | Respond with a minimal 404 page with the given headers.

138+respondNotFound :: H.ResponseHeaders -> Responder

139+respondNotFound h respond = do

140+ respond H.notFound404 h' $ streamBuilder "File not found."

141+ return []

142+ where

143+ contentType = (H.hContentType, "text/plain; charset=utf-8")

144+ h' = contentType:filter ((/=H.hContentType) . fst) h

145+

98-- | Create a response body consisting of a single builder.

146-- | Create a response body consisting of a single builder.

99streamBuilder :: Builder -> Body ()

147streamBuilder :: Builder -> Body ()

100streamBuilder builder write _ = write $ BuilderChunk builder

148streamBuilder builder write _ = write $ BuilderChunk builder

@@ -110,15 +158,25 @@ streamSimple body write flush = body (write . BuilderChunk) flush

110

158

111-- | Use a normal WAI 'Response' to send the response. Useful if you're

159-- | Use a normal WAI 'Response' to send the response. Useful if you're

112-- sharing code between HTTP\/2 applications and HTTP\/1 applications.

160-- sharing code between HTTP\/2 applications and HTTP\/1 applications.

161+--

162+-- The 'Request' is used to determine the right file range to serve for

163+-- 'ResponseFile'.

113−responder :: Response -> Responder

164+responder :: Request -> Response -> Responder

114−responder response respond = case response of

165+responder req response respond = case response of

115− (ResponseFile s h path part) -> [] <$ respond s h (streamFilePart path part)

116 (ResponseBuilder s h b) -> [] <$ respond s h (streamBuilder b)

166 (ResponseBuilder s h b) -> [] <$ respond s h (streamBuilder b)

117 (ResponseStream s h body) -> [] <$ respond s h (streamSimple body)

167 (ResponseStream s h body) -> [] <$ respond s h (streamSimple body)

118− (ResponseRaw _ fallback) -> responder fallback respond

168+ (ResponseRaw _ fallback) -> responder req fallback respond

169+ (ResponseFile s h path mpart) -> go respond

170+ where

171+ -- Hooray, forcing things to be universally quantified.

172+ go :: Responder

173+ go = maybe

174+ (respondFile s h path $ requestHeaders req)

175+ (respondFilePart s h path)

176+ mpart

119

177

120-- | Promote a normal WAI 'Application' to an 'HTTP2Application' by ignoring

178-- | Promote a normal WAI 'Application' to an 'HTTP2Application' by ignoring

121-- the HTTP/2-specific features.

179-- the HTTP/2-specific features.

122promoteApplication :: Application -> HTTP2Application

180promoteApplication :: Application -> HTTP2Application

123promoteApplication app req _ respond = [] <$ app req respond'

181promoteApplication app req _ respond = [] <$ app req respond'

124− where respond' r = ResponseReceived <$ responder r respond

182+ where respond' r = ResponseReceived <$ responder req r respond

wai/Network/Wai/Internal.hs+95−2

@@ -1,6 +1,7 @@

1{-# OPTIONS_HADDOCK not-home #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE CPP #-}

4+{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE RankNTypes #-}

5{-# LANGUAGE RankNTypes #-}

5{-# LANGUAGE RecordWildCards #-}

6{-# LANGUAGE RecordWildCards #-}

6-- | Internal constructors and helper functions. Note that no guarantees are

7-- | Internal constructors and helper functions. Note that no guarantees are

@@ -8,14 +9,22 @@

8module Network.Wai.Internal where

9module Network.Wai.Internal where

10import Blaze.ByteString.Builder (Builder)

11import Blaze.ByteString.Builder (Builder)

12+import Control.Exception (IOException, try)

11−import qualified Data.ByteString as B

13+import qualified Data.ByteString as B hiding (pack)

14+import qualified Data.ByteString.Builder as B

15+import qualified Data.ByteString.Char8 as B (pack, readInteger)

16+import qualified Data.ByteString.Lazy as L

17+import Data.Maybe (listToMaybe)

12import Data.Text (Text)

18import Data.Text (Text)

13import Data.Typeable (Typeable)

19import Data.Typeable (Typeable)

14−import Data.Vault.Lazy (Vault)

20+import Data.Vault.Lazy (Vault)

15import Data.Word (Word64)

21import Data.Word (Word64)

16import qualified Network.HTTP.Types as H

22import qualified Network.HTTP.Types as H

23+import qualified Network.HTTP.Types.Header as HH

17import Network.Socket (SockAddr)

24import Network.Socket (SockAddr)

25+import Numeric (showInt)

18import Data.List (intercalate)

26import Data.List (intercalate)

27+import qualified System.PosixCompat.Files as P

20-- | Information on the request sent by the client. This abstracts away the

29-- | Information on the request sent by the client. This abstracts away the

21-- details of the underlying implementation.

30-- details of the underlying implementation.

@@ -145,3 +154,87 @@ data FilePart = FilePart

145-- Since 3.0.0

154-- Since 3.0.0

146data ResponseReceived = ResponseReceived

155data ResponseReceived = ResponseReceived

147 deriving Typeable

156 deriving Typeable

157+

158+-- | Look up the size of a file in 'Right' or the 'IOException' in 'Left'.

159+tryGetFileSize :: FilePath -> IO (Either IOException Integer)

160+tryGetFileSize path =

161+ fmap (fromIntegral . P.fileSize) <$> try (P.getFileStatus path)

162+

163+-- | \"Content-Range\".

164+hContentRange :: H.HeaderName

165+hContentRange = "Content-Range"

166+

167+-- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'

168+-- for the range specified.

169+contentRangeHeader :: Integer -> Integer -> Integer -> H.Header

170+contentRangeHeader beg end total = (hContentRange, range)

171+ where

172+ range = B.pack

173+ -- building with ShowS

174+ $ 'b' : 'y': 't' : 'e' : 's' : ' '

175+ : (if beg > end then ('*':) else

176+ showInt beg

177+ . ('-' :)

178+ . showInt end)

179+ ( '/'

180+ : showInt total "")

181+

182+-- | Given the full size of a file and optionally a Range header value,

183+-- determine the range to serve by parsing the range header and obeying it, or

184+-- serving the whole file if it's absent or malformed.

185+chooseFilePart :: Integer -> Maybe B.ByteString -> FilePart

186+chooseFilePart size Nothing = FilePart 0 size size

187+chooseFilePart size (Just range) = case parseByteRanges range >>= listToMaybe of

188+ -- Range is broken

189+ Nothing -> FilePart 0 size size

190+ Just hrange -> checkRange hrange

191+ where

192+ checkRange (H.ByteRangeFrom beg) = fromRange beg (size - 1)

193+ checkRange (H.ByteRangeFromTo beg end) = fromRange beg (min (size - 1) end)

194+ checkRange (H.ByteRangeSuffix count) = fromRange (max 0 (size - count)) (size - 1)

195+

196+ fromRange beg end = FilePart beg (end - beg + 1) size

197+

198+-- | Adjust the given 'H.Status' and 'H.ResponseHeaders' based on the given

199+-- 'FilePart'. This means replacing the status with 206 if the response is

200+-- partial, and adding the Content-Length (always) and Content-Range (if

201+-- appropriate) headers.

202+adjustForFilePart :: H.Status -> H.ResponseHeaders -> FilePart -> (H.Status, H.ResponseHeaders)

203+adjustForFilePart s h part = (s', h'')

204+ where

205+ off = filePartOffset part

206+ len = filePartByteCount part

207+ size = filePartFileSize part

208+

209+ contentRange = contentRangeHeader off (off + len - 1) size

210+ lengthBS = L.toStrict $ B.toLazyByteString $ B.integerDec len

211+ s' = if filePartByteCount part /= size then H.partialContent206 else s

212+ h' = (H.hContentLength, lengthBS):h

213+ h'' = (if len == size then id else (contentRange:)) h'

214+

215+-- | Parse the value of a Range header into a 'HH.ByteRanges'.

216+parseByteRanges :: B.ByteString -> Maybe HH.ByteRanges

217+parseByteRanges bs1 = do

218+ bs2 <- stripPrefix "bytes=" bs1

219+ (r, bs3) <- range bs2

220+ ranges (r:) bs3

221+ where

222+ range bs2 = do

223+ (i, bs3) <- B.readInteger bs2

224+ if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")

225+ then Just (HH.ByteRangeSuffix (negate i), bs3)

226+ else do

227+ bs4 <- stripPrefix "-" bs3

228+ case B.readInteger bs4 of

229+ Just (j, bs5) | j >= i -> Just (HH.ByteRangeFromTo i j, bs5)

230+ _ -> Just (HH.ByteRangeFrom i, bs4)

231+ ranges front bs3

232+ | B.null bs3 = Just (front [])

233+ | otherwise = do

234+ bs4 <- stripPrefix "," bs3

235+ (r, bs5) <- range bs4

236+ ranges (front . (r:)) bs5

237+

238+ stripPrefix x y

239+ | x `B.isPrefixOf` y = Just (B.drop (B.length x) y)

240+ | otherwise = Nothing

wai/wai.cabal+2

@@ -21,10 +21,12 @@ Source-repository head

21Library

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

23 , bytestring >= 0.9.1.4

24+ , bytestring-builder >= 0.10.4.0 && < 10.7

24 , blaze-builder >= 0.2.1.4 && < 0.5

25 , blaze-builder >= 0.2.1.4 && < 0.5

25 , network >= 2.2.1.5

26 , network >= 2.2.1.5

26 , http-types >= 0.7

27 , http-types >= 0.7

27 , text >= 0.7

28 , text >= 0.7

29+ , unix-compat >= 0.2

28 , vault >= 0.3 && < 0.4

30 , vault >= 0.3 && < 0.4

29 Exposed-modules: Network.Wai

31 Exposed-modules: Network.Wai

30 Network.Wai.HTTP2

32 Network.Wai.HTTP2

warp/Network/Wai/Handler/Warp/HTTP2/Sender.hs+10−17

@@ -28,7 +28,6 @@ import Network.Wai.Handler.Warp.HTTP2.Types

28import Network.Wai.Handler.Warp.IORef

29import qualified Network.Wai.Handler.Warp.Settings as S

30import Network.Wai.Handler.Warp.Types

31−import qualified System.PosixCompat.Files as P

33#ifdef WINDOWS

32#ifdef WINDOWS

34import qualified System.IO as IO

33import qualified System.IO as IO

@@ -296,17 +295,16 @@ runStreamBuilder ii buf0 room0 sq = loop buf0 room0 0

296 B.Done -> loop (buf `plusPtr` len) (room - len) total'

295 B.Done -> loop (buf `plusPtr` len) (room - len) total'

297 B.More _ writer -> return (LOne writer, Nothing, total')

296 B.More _ writer -> return (LOne writer, Nothing, total')

298 B.Chunk bs writer -> return (LTwo bs writer, Nothing, total')

297 B.Chunk bs writer -> return (LTwo bs writer, Nothing, total')

299− Just (SFile path mpart) -> do

298+ Just (SFile path part) -> do

300− (leftover, len) <- runStreamFile ii buf room path mpart

299+ (leftover, len) <- runStreamFile ii buf room path part

301 let !total' = total + len

300 let !total' = total + len

302 return (leftover, Nothing, total')

301 return (leftover, Nothing, total')

303 -- TODO if file part is done, go back to loop

302 -- TODO if file part is done, go back to loop

304 Just SFlush -> return (LZero, Nothing, total)

303 Just SFlush -> return (LZero, Nothing, total)

305 Just (SFinish trailers) -> return (LZero, Just trailers, total)

304 Just (SFinish trailers) -> return (LZero, Just trailers, total)

306

305

307−-- | Open the file, determine the range we should send, and start reading into

306+-- | Open the file and start reading into the send buffer.

308−-- the send buffer.

309−runStreamFile :: InternalInfo -> Buffer -> BufSize -> FilePath -> Maybe FilePart

307+runStreamFile :: InternalInfo -> Buffer -> BufSize -> FilePath -> FilePart

310 -> IO (Leftover, BytesFilled)

308 -> IO (Leftover, BytesFilled)

311

309

312-- | Read the given (OS-specific) file representation into the buffer. On

310-- | Read the given (OS-specific) file representation into the buffer. On

@@ -316,8 +314,9 @@ runStreamFile :: InternalInfo -> Buffer -> BufSize -> FilePath -> Maybe FilePart

316readOpenFile :: OpenFile -> Buffer -> BufSize -> Integer -> IO Int

314readOpenFile :: OpenFile -> Buffer -> BufSize -> Integer -> IO Int

317

315

318#ifdef WINDOWS

316#ifdef WINDOWS

319−runStreamFile _ buf room path mpart = do

317+runStreamFile _ buf room path part = do

320− (start, bytes) <- fileStartEnd path mpart

318+ let start = filePartOffset part

319+ bytes = filePartByteCount part

321 -- fixme: how to close Handle? GC does it at this moment.

320 -- fixme: how to close Handle? GC does it at this moment.

322 h <- IO.openBinaryFile path IO.ReadMode

321 h <- IO.openBinaryFile path IO.ReadMode

323 IO.hSeek h IO.AbsoluteSeek start

322 IO.hSeek h IO.AbsoluteSeek start

@@ -325,8 +324,9 @@ runStreamFile _ buf room path mpart = do

325

324

326readOpenFile h buf room _ = IO.hGetBufSome h buf room

325readOpenFile h buf room _ = IO.hGetBufSome h buf room

327#else

326#else

328−runStreamFile ii buf room path mpart = do

327+runStreamFile ii buf room path part = do

329− (start, bytes) <- fileStartEnd path mpart

328+ let start = filePartOffset part

329+ bytes = filePartByteCount part

330 (fd, refresh) <- case fdCacher ii of

331 Just fdcache -> getFd fdcache path

332 Nothing -> do

@@ -355,13 +355,6 @@ fillBufFile buf room f start bytes refresh = do

355 LZero

356 return (leftover, len)

357

358−fileStartEnd :: FilePath -> Maybe FilePart -> IO (Integer, Integer)

359−fileStartEnd path Nothing = do

360− end <- fromIntegral . P.fileSize <$> P.getFileStatus path

361− return (0, end)

362−fileStartEnd _ (Just part) =

363− return (filePartOffset part, filePartByteCount part)

364−

365mini :: Int -> Integer -> Int

358mini :: Int -> Integer -> Int

366mini i n

359mini i n

367 | fromIntegral i < n = i

360 | fromIntegral i < n = i

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

@@ -100,7 +100,7 @@ data Sequence = SFinish Trailers

100 -- ^ Any buffered data should be sent immediately.

101 | SBuilder Builder

102 -- ^ Append a chunk of data to the stream.

103− | SFile FilePath (Maybe FilePart)

103+ | SFile FilePath FilePart

104 -- ^ Append a chunk of a file's contents to the stream.

105

106-- | A message from the sender to a stream's dedicated waiter thread.

warp/Network/Wai/Handler/Warp/RequestHeader.hs+2−28

@@ -9,7 +9,7 @@ module Network.Wai.Handler.Warp.RequestHeader (

9import Control.Exception (throwIO)

10import Control.Monad (when)

11import qualified Data.ByteString as S

12−import qualified Data.ByteString.Char8 as B (unpack, readInteger)

12+import qualified Data.ByteString.Char8 as B (unpack)

13import Data.ByteString.Internal (ByteString(..), memchr)

14import qualified Data.CaseInsensitive as CI

15import Data.Word (Word8)

@@ -18,7 +18,7 @@ import Foreign.Ptr (Ptr, plusPtr, minusPtr, nullPtr)

18import Foreign.Storable (peek)

19import qualified Network.HTTP.Types as H

20import Network.Wai.Handler.Warp.Types

21−import qualified Network.HTTP.Types.Header as HH

21+import Network.Wai.Internal (parseByteRanges)

22-- $setup

23-- >>> :set -XOverloadedStrings

@@ -133,29 +133,3 @@ parseHeader s =

133 let (k, rest) = S.break (== 58) s -- ':'

134 rest' = S.dropWhile (\c -> c == 32 || c == 9) $ S.drop 1 rest

135 in (CI.mk k, rest')

136−

137−parseByteRanges :: S.ByteString -> Maybe HH.ByteRanges

138−parseByteRanges bs1 = do

139− bs2 <- stripPrefix "bytes=" bs1

140− (r, bs3) <- range bs2

141− ranges (r:) bs3

142− where

143− range bs2 = do

144− (i, bs3) <- B.readInteger bs2

145− if i < 0 -- has prefix "-" ("-0" is not valid, but here treated as "0-")

146− then Just (HH.ByteRangeSuffix (negate i), bs3)

147− else do

148− bs4 <- stripPrefix "-" bs3

149− case B.readInteger bs4 of

150− Just (j, bs5) | j >= i -> Just (HH.ByteRangeFromTo i j, bs5)

151− _ -> Just (HH.ByteRangeFrom i, bs4)

152− ranges front bs3

153− | S.null bs3 = Just (front [])

154− | otherwise = do

155− bs4 <- stripPrefix "," bs3

156− (r, bs5) <- range bs4

157− ranges (front . (r:)) bs5

158−

159− stripPrefix x y

160− | x `S.isPrefixOf` y = Just (S.drop (S.length x) y)

161− | otherwise = Nothing

warp/Network/Wai/Handler/Warp/Response.hs+10−60

@@ -33,7 +33,7 @@ import qualified Data.ByteString.Char8 as B (pack)

33import qualified Data.CaseInsensitive as CI

34import Data.Function (on)

35import Data.List (deleteBy)

36−import Data.Maybe (isJust, listToMaybe)

36+import Data.Maybe (isJust, fromMaybe)

37#if MIN_VERSION_base(4,5,0)

38# if __GLASGOW_HASKELL__ < 709

39import Data.Monoid (mempty)

@@ -51,14 +51,11 @@ import qualified Network.Wai.Handler.Warp.Date as D

51import qualified Network.Wai.Handler.Warp.FdCache as F

52import Network.Wai.Handler.Warp.Header

53import Network.Wai.Handler.Warp.IO (toBufIOWith)

54−import Network.Wai.Handler.Warp.RequestHeader (parseByteRanges)

55import Network.Wai.Handler.Warp.ResponseHeader

54import Network.Wai.Handler.Warp.ResponseHeader

56import qualified Network.Wai.Handler.Warp.Timeout as T

55import qualified Network.Wai.Handler.Warp.Timeout as T

57import Network.Wai.Handler.Warp.Types

56import Network.Wai.Handler.Warp.Types

58import Network.Wai.Internal

57import Network.Wai.Internal

59−import Numeric (showInt)

60import qualified Paths_warp

58import qualified Paths_warp

61−import qualified System.PosixCompat.Files as P

63#if !MIN_VERSION_base(4,5,0)

60#if !MIN_VERSION_base(4,5,0)

64(<>) :: Monoid m => m -> m -> m

61(<>) :: Monoid m => m -> m -> m

@@ -68,11 +65,6 @@ import qualified System.PosixCompat.Files as P

68-- $setup

65-- $setup

69-- >>> :set -XOverloadedStrings

66-- >>> :set -XOverloadedStrings

71−mapRight :: (b -> c) -> Either a b -> Either a c

72−mapRight f eith = case eith of

73− Right x -> Right (f x)

74− Left l -> Left l

75−

76----------------------------------------------------------------

68----------------------------------------------------------------

78fileRange :: H.Status -> H.ResponseHeaders -> FilePath

70fileRange :: H.Status -> H.ResponseHeaders -> FilePath

@@ -80,8 +72,7 @@ fileRange :: H.Status -> H.ResponseHeaders -> FilePath

80 -> IO (Either IOException

72 -> IO (Either IOException

81 (H.Status, H.ResponseHeaders, Integer, Integer))

73 (H.Status, H.ResponseHeaders, Integer, Integer))

82fileRange s0 hs0 path Nothing mRange =

74fileRange s0 hs0 path Nothing mRange =

83− mapRight (fileRangeSized s0 hs0 Nothing mRange . fromIntegral . P.fileSize) <$>

75+ fmap (fileRangeSized s0 hs0 Nothing mRange) <$> tryGetFileSize path

84− try (P.getFileStatus path)

85fileRange s0 hs0 _ mPart@(Just part) mRange =

76fileRange s0 hs0 _ mPart@(Just part) mRange =

86 return . Right $ fileRangeSized s0 hs0 mPart mRange size

77 return . Right $ fileRangeSized s0 hs0 mPart mRange size

87 where

78 where

@@ -92,40 +83,18 @@ fileRangeSized :: H.Status -> H.ResponseHeaders

92 -> (H.Status, H.ResponseHeaders, Integer, Integer)

83 -> (H.Status, H.ResponseHeaders, Integer, Integer)

93fileRangeSized s0 hs0 mPart mRange fileSize = (s, hs, beg, len)

84fileRangeSized s0 hs0 mPart mRange fileSize = (s, hs, beg, len)

94 where

85 where

95− (beg, end, len, isEntire) = checkPartRange fileSize mPart mRange

86+ (beg, _end, len, _entire) = checkPartRange fileSize mPart mRange

96− hs1 = addContentLength len hs0

87+ (s, hs) = adjustForFilePart s0 hs0 $ FilePart beg len fileSize

97− hs | isEntire = hs1

98− | otherwise = addContentRange beg end fileSize hs1

99− s | isEntire = s0

100− | otherwise = H.status206

101

102checkPartRange :: Integer -> Maybe FilePart -> Maybe HeaderValue

89checkPartRange :: Integer -> Maybe FilePart -> Maybe HeaderValue

103 -> (Integer, Integer, Integer, Bool)

90 -> (Integer, Integer, Integer, Bool)

104−checkPartRange fileSize = checkPart

91+checkPartRange fileSize mpart mrange = (beg, end, len, isEntire)

105 where

92 where

106− checkPart Nothing Nothing = (0, fileSize - 1, fileSize, True)

93+ part = fromMaybe (chooseFilePart fileSize mrange) mpart

107− checkPart Nothing (Just range) = case parseByteRanges range >>= listToMaybe of

108− -- Range is broken

109− Nothing -> (0, fileSize - 1, fileSize, True)

110− Just hrange -> checkRange hrange

111− -- Ignore Range if FilePart is specified.

112− -- We assume that an application handled Range and specified

113− -- FilePart.

114− checkPart (Just part) _ = (beg, end, len, isEntire)

115− where

116− beg = filePartOffset part

94+ beg = filePartOffset part

117− len = filePartByteCount part

95+ len = filePartByteCount part

118− end = beg + len - 1

96+ end = beg + len - 1

119− isEntire = beg == 0 && len == fileSize

120−

121− checkRange (H.ByteRangeFrom beg) = fromRange beg (fileSize - 1)

122− checkRange (H.ByteRangeFromTo beg end) = fromRange beg (min (fileSize - 1) end)

123− checkRange (H.ByteRangeSuffix count) = fromRange (max 0 (fileSize - count)) (fileSize - 1)

124−

125− fromRange beg end = (beg, end, len, isEntire)

126− where

127− len = end - beg + 1

128− isEntire = beg == 0 && len == fileSize

97+ isEntire = beg == 0 && len == fileSize

129

130----------------------------------------------------------------

99----------------------------------------------------------------

131

100

@@ -396,25 +365,6 @@ addAcceptRanges hdrs = (hAcceptRanges, "bytes") : hdrs

396addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders

365addTransferEncoding :: H.ResponseHeaders -> H.ResponseHeaders

397addTransferEncoding hdrs = (hTransferEncoding, "chunked") : hdrs

366addTransferEncoding hdrs = (hTransferEncoding, "chunked") : hdrs

398

367

399−addContentLength :: Integer -> H.ResponseHeaders -> H.ResponseHeaders

400−addContentLength cl hdrs = (H.hContentLength, len) : hdrs

401− where

402− len = B.pack $ show cl

403−

404−addContentRange :: Integer -> Integer -> Integer

405− -> H.ResponseHeaders -> H.ResponseHeaders

406−addContentRange beg end total hdrs = (hContentRange, range) : hdrs

407− where

408− range = B.pack

409− -- building with ShowS

410− $ 'b' : 'y': 't' : 'e' : 's' : ' '

411− : (if beg > end then ('*':) else

412− showInt beg

413− . ('-' :)

414− . showInt end)

415− ( '/'

416− : showInt total "")

417−

418addDate :: D.DateCache -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders

368addDate :: D.DateCache -> IndexedHeader -> H.ResponseHeaders -> IO H.ResponseHeaders

419addDate dc rspidxhdr hdrs = case rspidxhdr ! idxDate of

369addDate dc rspidxhdr hdrs = case rspidxhdr ! idxDate of

420 Nothing -> do

370 Nothing -> do