module Network.Wai.Handler.Warp.HTTP2.File (
RspFileInfo(..)
, conditionalRequest
, addContentHeadersForFilePart
, H.parseByteRanges
) where
import qualified Data.ByteString.Char8 as C8 (pack)
import Network.HPACK
import Network.HPACK.Token
import Network.HTTP.Date
import qualified Network.HTTP.Types as H
import Network.Wai
import qualified Network.Wai.Handler.Warp.FileInfoCache as I
import Network.Wai.Handler.Warp.Imports
import Network.Wai.Handler.Warp.PackInt
data RspFileInfo = WithoutBody !H.Status
| WithBody !H.Status !TokenHeaderList !Integer !Integer
deriving (Eq,Show)
conditionalRequest :: I.FileInfo
-> TokenHeaderList
-> ValueTable
-> RspFileInfo
conditionalRequest (I.FileInfo _ size mtime date) ths0 reqtbl = case condition of
nobody@(WithoutBody _) -> nobody
WithBody s _ off len -> let !hs = (tokenLastModified,date) :
addContentHeaders ths0 off len size
in WithBody s hs off len
where
!mcondition = ifmodified reqtbl size mtime
<|> ifunmodified reqtbl size mtime
<|> ifrange reqtbl size mtime
!condition = fromMaybe (unconditional reqtbl size) mcondition
ifModifiedSince :: ValueTable -> Maybe HTTPDate
ifModifiedSince reqtbl = getHeaderValue tokenIfModifiedSince reqtbl >>= parseHTTPDate
ifUnmodifiedSince :: ValueTable -> Maybe HTTPDate
ifUnmodifiedSince reqtbl = getHeaderValue tokenIfUnmodifiedSince reqtbl >>= parseHTTPDate
ifRange :: ValueTable -> Maybe HTTPDate
ifRange reqtbl = getHeaderValue tokenIfRange reqtbl >>= parseHTTPDate
ifmodified :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
ifmodified reqtbl size mtime = do
date <- ifModifiedSince reqtbl
return $ if date /= mtime
then unconditional reqtbl size
else WithoutBody H.notModified304
ifunmodified :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
ifunmodified reqtbl size mtime = do
date <- ifUnmodifiedSince reqtbl
return $ if date == mtime
then unconditional reqtbl size
else WithoutBody H.preconditionFailed412
ifrange :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
ifrange reqtbl size mtime = do
date <- ifRange reqtbl
rng <- getHeaderValue tokenRange reqtbl
return $ if date == mtime
then parseRange rng size
else WithBody H.ok200 [] 0 size
unconditional :: ValueTable -> Integer -> RspFileInfo
unconditional reqtbl size = case getHeaderValue tokenRange reqtbl of
Nothing -> WithBody H.ok200 [] 0 size
Just rng -> parseRange rng size
parseRange :: ByteString -> Integer -> RspFileInfo
parseRange rng size = case H.parseByteRanges rng of
Nothing -> WithoutBody H.requestedRangeNotSatisfiable416
Just [] -> WithoutBody H.requestedRangeNotSatisfiable416
Just (r:_) -> let (!beg, !end) = checkRange r size
!len = end beg + 1
s = if beg == 0 && end == size 1 then
H.ok200
else
H.partialContent206
in WithBody s [] beg len
checkRange :: H.ByteRange -> Integer -> (Integer, Integer)
checkRange (H.ByteRangeFrom beg) size = (beg, size 1)
checkRange (H.ByteRangeFromTo beg end) size = (beg, min (size 1) end)
checkRange (H.ByteRangeSuffix count) size = (max 0 (size count), size 1)
contentRangeHeader :: Integer -> Integer -> Integer -> TokenHeader
contentRangeHeader beg end total = (tokenContentRange, range)
where
range = C8.pack
$ 'b' : 'y': 't' : 'e' : 's' : ' '
: (if beg > end then ('*':) else
showInt beg
. ('-' :)
. showInt end)
( '/'
: showInt total "")
addContentHeaders :: TokenHeaderList -> Integer -> Integer -> Integer -> TokenHeaderList
addContentHeaders ths off len size
| len == size = ths'
| otherwise = let !ctrng = contentRangeHeader off (off + len 1) size
in ctrng:ths'
where
!lengthBS = packIntegral len
!ths' = (tokenContentLength, lengthBS) : (tokenAcceptRanges,"bytes") : ths
addContentHeadersForFilePart :: TokenHeaderList -> FilePart -> TokenHeaderList
addContentHeadersForFilePart hs part = addContentHeaders hs off len size
where
off = filePartOffset part
len = filePartByteCount part
size = filePartFileSize part