1{-# LANGUAGE CPP #-} 2{-# LANGUAGE OverloadedStrings #-} 3{-# LANGUAGE BangPatterns #-} 4 5module Network.Wai.Handler.Warp.File ( 6 RspFileInfo(..) 7 , conditionalRequest 8 , addContentHeadersForFilePart 9 , H.parseByteRanges 10 ) where 11 12import Data.Array ((!)) 13import qualified Data.ByteString.Char8 as C8 (pack) 14import Network.HTTP.Date 15import qualified Network.HTTP.Types as H 16import qualified Network.HTTP.Types.Header as H 17import Network.Wai 18 19import qualified Network.Wai.Handler.Warp.FileInfoCache as I 20import Network.Wai.Handler.Warp.Header 21import Network.Wai.Handler.Warp.Imports 22import Network.Wai.Handler.Warp.PackInt 23 24 25-- $setup 26-- >>> import Test.QuickCheck 27 28---------------------------------------------------------------- 29 30data RspFileInfo = WithoutBody H.Status 31 | WithBody H.Status H.ResponseHeaders Integer Integer 32 deriving (Eq,Show) 33 34---------------------------------------------------------------- 35 36conditionalRequest :: I.FileInfo 37 -> H.ResponseHeaders 38 -> IndexedHeader -- ^ Response 39 -> IndexedHeader -- ^ Request 40 -> RspFileInfo 41conditionalRequest finfo hs0 rspidx reqidx = case condition of 42 nobody@(WithoutBody _) -> nobody 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 46 in WithBody s hs off len 47 where 48 !mtime = I.fileInfoTime finfo 49 !size = I.fileInfoSize finfo 50 !date = I.fileInfoDate finfo 51 !mcondition = ifmodified reqidx size mtime 52 <|> ifunmodified reqidx size mtime 53 <|> ifrange reqidx size mtime 54 !condition = fromMaybe (unconditional reqidx size) mcondition 55 56---------------------------------------------------------------- 57 58ifModifiedSince :: IndexedHeader -> Maybe HTTPDate 59ifModifiedSince reqidx = reqidx ! fromEnum ReqIfModifiedSince >>= parseHTTPDate 60 61ifUnmodifiedSince :: IndexedHeader -> Maybe HTTPDate 62ifUnmodifiedSince reqidx = reqidx ! fromEnum ReqIfUnmodifiedSince >>= parseHTTPDate 63 64ifRange :: IndexedHeader -> Maybe HTTPDate 65ifRange reqidx = reqidx ! fromEnum ReqIfRange >>= parseHTTPDate 66 67---------------------------------------------------------------- 68 69ifmodified :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo 70ifmodified reqidx size mtime = do 71 date <- ifModifiedSince reqidx 72 return $ if date /= mtime 73 then unconditional reqidx size 74 else WithoutBody H.notModified304 75 76ifunmodified :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo 77ifunmodified reqidx size mtime = do 78 date <- ifUnmodifiedSince reqidx 79 return $ if date == mtime 80 then unconditional reqidx size 81 else WithoutBody H.preconditionFailed412 82 83ifrange :: IndexedHeader -> Integer -> HTTPDate -> Maybe RspFileInfo 84ifrange reqidx size mtime = do 85 date <- ifRange reqidx 86 rng <- reqidx ! fromEnum ReqRange 87 return $ if date == mtime 88 then parseRange rng size 89 else WithBody H.ok200 [] 0 size 90 91unconditional :: IndexedHeader -> Integer -> RspFileInfo 92unconditional reqidx size = case reqidx ! fromEnum ReqRange of 93 Nothing -> WithBody H.ok200 [] 0 size 94 Just rng -> parseRange rng size 95 96---------------------------------------------------------------- 97 98parseRange :: ByteString -> Integer -> RspFileInfo 99parseRange rng size = case H.parseByteRanges rng of 100 Nothing -> WithoutBody H.requestedRangeNotSatisfiable416 101 Just [] -> WithoutBody H.requestedRangeNotSatisfiable416 102 Just (r:_) -> let (!beg, !end) = checkRange r size 103 !len = end - beg + 1 104 s = if beg == 0 && end == size - 1 then 105 H.ok200 106 else 107 H.partialContent206 108 in WithBody s [] beg len 109 110checkRange :: H.ByteRange -> Integer -> (Integer, Integer) 111checkRange (H.ByteRangeFrom beg) size = (beg, size - 1) 112checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size - 1) end) 113checkRange (H.ByteRangeSuffix count) size = (max 0 (size - count), size - 1) 114 115---------------------------------------------------------------- 116 117-- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header' 118-- for the range specified. 119contentRangeHeader :: Integer -> Integer -> Integer -> H.Header 120contentRangeHeader beg end total = (H.hContentRange, range) 121 where 122 range = C8.pack 123 -- building with ShowS 124 $ 'b' : 'y': 't' : 'e' : 's' : ' ' 125 : (if beg > end then ('*':) else 126 showInt beg 127 . ('-' :) 128 . showInt end) 129 ( '/' 130 : showInt total "") 131 132addContentHeaders :: H.ResponseHeaders -> Integer -> Integer -> Integer -> H.ResponseHeaders 133addContentHeaders hs off len size 134 | len == size = hs' 135 | otherwise = let !ctrng = contentRangeHeader off (off + len - 1) size 136 in ctrng:hs' 137 where 138 !lengthBS = packIntegral len 139 !hs' = (H.hContentLength, lengthBS) : (H.hAcceptRanges,"bytes") : hs 140 141-- | 142-- 143-- >>> addContentHeadersForFilePart [] (FilePart 2 10 16) 144-- [("Content-Range","bytes 2-11/16"),("Content-Length","10"),("Accept-Ranges","bytes")] 145-- >>> addContentHeadersForFilePart [] (FilePart 0 16 16) 146-- [("Content-Length","16"),("Accept-Ranges","bytes")] 147addContentHeadersForFilePart :: H.ResponseHeaders -> FilePart -> H.ResponseHeaders 148addContentHeadersForFilePart hs part = addContentHeaders hs off len size 149 where 150 off = filePartOffset part 151 len = filePartByteCount part 152 size = filePartFileSize part 153