@@ -57,28 +57,35 @@ import qualified System.PosixCompat.Files as P
5757-- $setup
5858-- >>> :set -XOverloadedStrings
5959
60+mapRight :: (b -> c) -> Either a b -> Either a c
61+mapRight f eith = case eith of
62+ Right x -> Right (f x)
63+ Left l -> Left l
64+
6065----------------------------------------------------------------
6166
6267fileRange :: H.Status -> H.ResponseHeaders -> FilePath
6368 -> Maybe FilePart -> Maybe HeaderValue
64− -> IO (Either SomeException
69+ -> IO (Either IOException
6570 (H.Status, H.ResponseHeaders, Integer, Integer))
66−fileRange s0 hs0 path mPart mRange = try $ do
67− fileSize <- checkFileSize mPart
68− let (beg, end, len, isEntire) = checkPartRange fileSize mPart mRange
69− let hs1 = addContentLength len hs0
70− hs | isEntire = hs1
71− | otherwise = addContentRange beg end fileSize hs1
72− s | isEntire = s0
73− | otherwise = H.status206
74− return (s, hs, beg, len)
71+fileRange s0 hs0 path mPart mRange =
72+ mapRight (fileRangeSized . fromIntegral . P.fileSize) <$>
73+ try (P.getFileStatus path)
7574 where
76− checkFileSize Nothing = fromIntegral . P.fileSize <$> P.getFileStatus path
77− checkFileSize (Just part) = return $ filePartFileSize part
75+ fileRangeSized :: Integer -> (H.Status, H.ResponseHeaders, Integer, Integer)
76+ fileRangeSized fileSize =
77+ let (beg, end, len, isEntire) = checkPartRange fileSize mPart mRange
78+ hs1 = addContentLength len hs0
79+ hs | isEntire = hs1
80+ | otherwise = addContentRange beg end fileSize hs1
81+ s | isEntire = s0
82+ | otherwise = H.status206
83+ in (s, hs, beg, len)
84+
7885
7986checkPartRange :: Integer -> Maybe FilePart -> Maybe HeaderValue
8087 -> (Integer, Integer, Integer, Bool)
81−checkPartRange fileSize mPart mRange = checkPart mPart mRange
88+checkPartRange fileSize = checkPart
8289 where
8390 checkPart Nothing Nothing = (0, fileSize - 1, fileSize, True)
8491 checkPart Nothing (Just range) = case parseByteRanges range >>= listToMaybe of
@@ -184,10 +191,10 @@ sendResponse conn ii restore req reqidxhdr leftover' response = do
184191 ResponseSource _ _ fb -> RspSource fb needsChunked th
185192 ResponseRaw raw _ -> RspRaw raw leftover' (T.tickle th)
186193 ret = case response of
187− ResponseFile _ _ _ _ -> isPersist
188− ResponseBuilder _ _ _ -> isKeepAlive
189− ResponseSource _ _ _ -> isKeepAlive
190− ResponseRaw _ _ -> False
194+ ResponseFile {} -> isPersist
195+ ResponseBuilder {} -> isKeepAlive
196+ ResponseSource {} -> isKeepAlive
197+ ResponseRaw {} -> False
191198
192199----------------------------------------------------------------
193200
@@ -208,7 +215,11 @@ sendRsp :: Connection
208215sendRsp conn ver s0 hs0 restore (RspFile path mPart mRange hook) = restore $ do
209216 ex <- fileRange s0 hs path mPart mRange
210217 case ex of
211− Left _ -> sendRsp conn ver s2 hs2 id (RspBuilder body True)
218+ Left _ex ->
219+#ifdef WARP_DEBUG
220+ print _ex >>
221+#endif
222+ sendRsp conn ver s2 hs2 id (RspBuilder body True)
212223 Right (s, hs1, beg, len) -> do
213224 lheader <- composeHeader ver s hs1
214225 connSendFile conn path beg len hook [lheader]