{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.Wai.Handler.Warp.File (
RspFileInfo (..),
conditionalRequest,
addContentHeadersForFilePart,
H.parseByteRanges,
) where
import Data.Array ((!))
import qualified Data.ByteString.Char8 as C8 (pack)
import Network.HTTP.Date
import qualified Network.HTTP.Types as H
import qualified Network.HTTP.Types.Header as H
import Network.Wai
import qualified Network.Wai.Handler.Warp.FileInfoCache as I
import Network.Wai.Handler.Warp.Header
import Network.Wai.Handler.Warp.Imports
import Network.Wai.Handler.Warp.PackInt
data RspFileInfo
= WithoutBody H.Status
| WithBody H.Status H.ResponseHeaders Integer Integer
deriving (RspFileInfo -> RspFileInfo -> Bool
(RspFileInfo -> RspFileInfo -> Bool)
-> (RspFileInfo -> RspFileInfo -> Bool) -> Eq RspFileInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RspFileInfo -> RspFileInfo -> Bool
== :: RspFileInfo -> RspFileInfo -> Bool
$c/= :: RspFileInfo -> RspFileInfo -> Bool
/= :: RspFileInfo -> RspFileInfo -> Bool
Eq, Int -> RspFileInfo -> ShowS
[RspFileInfo] -> ShowS
RspFileInfo -> String
(Int -> RspFileInfo -> ShowS)
-> (RspFileInfo -> String)
-> ([RspFileInfo] -> ShowS)
-> Show RspFileInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RspFileInfo -> ShowS
showsPrec :: Int -> RspFileInfo -> ShowS
$cshow :: RspFileInfo -> String
show :: RspFileInfo -> String
$cshowList :: [RspFileInfo] -> ShowS
showList :: [RspFileInfo] -> ShowS
Show)
conditionalRequest
:: I.FileInfo
-> H.ResponseHeaders
-> H.Method
-> IndexedHeader
-> IndexedHeader
-> RspFileInfo
conditionalRequest :: FileInfo
-> ResponseHeaders
-> Method
-> IndexedHeader
-> IndexedHeader
-> RspFileInfo
conditionalRequest FileInfo
finfo ResponseHeaders
hs0 Method
method IndexedHeader
rspidx IndexedHeader
reqidx = case RspFileInfo
condition of
nobody :: RspFileInfo
nobody@(WithoutBody Status
_) -> RspFileInfo
nobody
WithBody Status
s ResponseHeaders
_ Integer
off Integer
len ->
let !hs1 :: ResponseHeaders
hs1 = ResponseHeaders -> Integer -> Integer -> Integer -> ResponseHeaders
addContentHeaders ResponseHeaders
hs0 Integer
off Integer
len Integer
size
!hs :: ResponseHeaders
hs = case IndexedHeader
rspidx IndexedHeader -> Int -> Maybe Method
forall i e. Ix i => Array i e -> i -> e
! ResponseHeaderIndex -> Int
forall a. Enum a => a -> Int
fromEnum ResponseHeaderIndex
ResLastModified of
Just Method
_ -> ResponseHeaders
hs1
Maybe Method
Nothing -> (HeaderName
H.hLastModified, Method
date) (HeaderName, Method) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
hs1
in Status -> ResponseHeaders -> Integer -> Integer -> RspFileInfo
WithBody Status
s ResponseHeaders
hs Integer
off Integer
len
where
!mtime :: HTTPDate
mtime = FileInfo -> HTTPDate
I.fileInfoTime FileInfo
finfo
!size :: Integer
size = FileInfo -> Integer
I.fileInfoSize FileInfo
finfo
!date :: Method
date = FileInfo -> Method
I.fileInfoDate FileInfo
finfo
!mcondition :: Maybe RspFileInfo
mcondition =
IndexedHeader -> HTTPDate -> Maybe RspFileInfo
ifunmodified IndexedHeader
reqidx HTTPDate
mtime
Maybe RspFileInfo -> Maybe RspFileInfo -> Maybe RspFileInfo
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IndexedHeader -> HTTPDate -> Method -> Maybe RspFileInfo
ifmodified IndexedHeader
reqidx HTTPDate
mtime Method
method
Maybe RspFileInfo -> Maybe RspFileInfo -> Maybe RspFileInfo
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IndexedHeader -> HTTPDate -> Method -> Integer -> Maybe RspFileInfo
ifrange IndexedHeader
reqidx HTTPDate
mtime Method
method Integer
size
!condition :: RspFileInfo
condition = RspFileInfo -> Maybe RspFileInfo -> RspFileInfo
forall a. a -> Maybe a -> a
fromMaybe (IndexedHeader -> Integer -> RspFileInfo
unconditional IndexedHeader
reqidx Integer
size) Maybe RspFileInfo
mcondition
ifModifiedSince :: IndexedHeader -> Maybe HTTPDate
ifModifiedSince :: IndexedHeader -> Maybe HTTPDate
ifModifiedSince IndexedHeader
reqidx = IndexedHeader
reqidx IndexedHeader -> Int -> Maybe Method
forall i e. Ix i => Array i e -> i -> e
! RequestHeaderIndex -> Int
forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqIfModifiedSince Maybe Method -> (Method -> Maybe HTTPDate) -> Maybe HTTPDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Method -> Maybe HTTPDate
parseHTTPDate
ifUnmodifiedSince :: IndexedHeader -> Maybe HTTPDate
ifUnmodifiedSince :: IndexedHeader -> Maybe HTTPDate
ifUnmodifiedSince IndexedHeader
reqidx = IndexedHeader
reqidx IndexedHeader -> Int -> Maybe Method
forall i e. Ix i => Array i e -> i -> e
! RequestHeaderIndex -> Int
forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqIfUnmodifiedSince Maybe Method -> (Method -> Maybe HTTPDate) -> Maybe HTTPDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Method -> Maybe HTTPDate
parseHTTPDate
ifRange :: IndexedHeader -> Maybe HTTPDate
ifRange :: IndexedHeader -> Maybe HTTPDate
ifRange IndexedHeader
reqidx = IndexedHeader
reqidx IndexedHeader -> Int -> Maybe Method
forall i e. Ix i => Array i e -> i -> e
! RequestHeaderIndex -> Int
forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqIfRange Maybe Method -> (Method -> Maybe HTTPDate) -> Maybe HTTPDate
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Method -> Maybe HTTPDate
parseHTTPDate
ifmodified :: IndexedHeader -> HTTPDate -> H.Method -> Maybe RspFileInfo
ifmodified :: IndexedHeader -> HTTPDate -> Method -> Maybe RspFileInfo
ifmodified IndexedHeader
reqidx HTTPDate
mtime Method
method = do
HTTPDate
date <- IndexedHeader -> Maybe HTTPDate
ifModifiedSince IndexedHeader
reqidx
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Maybe Method -> Bool) -> Maybe Method -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Method -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Method -> Maybe ()) -> Maybe Method -> Maybe ()
forall a b. (a -> b) -> a -> b
$ IndexedHeader
reqidx IndexedHeader -> Int -> Maybe Method
forall i e. Ix i => Array i e -> i -> e
! RequestHeaderIndex -> Int
forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqIfNoneMatch
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Method
method Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
H.methodGet Bool -> Bool -> Bool
|| Method
method Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
H.methodHead
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HTTPDate
date HTTPDate -> HTTPDate -> Bool
forall a. Eq a => a -> a -> Bool
== HTTPDate
mtime Bool -> Bool -> Bool
|| HTTPDate
date HTTPDate -> HTTPDate -> Bool
forall a. Ord a => a -> a -> Bool
> HTTPDate
mtime
RspFileInfo -> Maybe RspFileInfo
forall a. a -> Maybe a
Just (RspFileInfo -> Maybe RspFileInfo)
-> RspFileInfo -> Maybe RspFileInfo
forall a b. (a -> b) -> a -> b
$ Status -> RspFileInfo
WithoutBody Status
H.notModified304
ifunmodified :: IndexedHeader -> HTTPDate -> Maybe RspFileInfo
ifunmodified :: IndexedHeader -> HTTPDate -> Maybe RspFileInfo
ifunmodified IndexedHeader
reqidx HTTPDate
mtime = do
HTTPDate
date <- IndexedHeader -> Maybe HTTPDate
ifUnmodifiedSince IndexedHeader
reqidx
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ())
-> (Maybe Method -> Bool) -> Maybe Method -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Method -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe Method -> Maybe ()) -> Maybe Method -> Maybe ()
forall a b. (a -> b) -> a -> b
$ IndexedHeader
reqidx IndexedHeader -> Int -> Maybe Method
forall i e. Ix i => Array i e -> i -> e
! RequestHeaderIndex -> Int
forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqIfMatch
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ HTTPDate
date HTTPDate -> HTTPDate -> Bool
forall a. Eq a => a -> a -> Bool
/= HTTPDate
mtime Bool -> Bool -> Bool
&& HTTPDate
date HTTPDate -> HTTPDate -> Bool
forall a. Ord a => a -> a -> Bool
< HTTPDate
mtime
RspFileInfo -> Maybe RspFileInfo
forall a. a -> Maybe a
Just (RspFileInfo -> Maybe RspFileInfo)
-> RspFileInfo -> Maybe RspFileInfo
forall a b. (a -> b) -> a -> b
$ Status -> RspFileInfo
WithoutBody Status
H.preconditionFailed412
ifrange :: IndexedHeader -> HTTPDate -> H.Method -> Integer -> Maybe RspFileInfo
ifrange :: IndexedHeader -> HTTPDate -> Method -> Integer -> Maybe RspFileInfo
ifrange IndexedHeader
reqidx HTTPDate
mtime Method
method Integer
size = do
HTTPDate
date <- IndexedHeader -> Maybe HTTPDate
ifRange IndexedHeader
reqidx
Method
rng <- IndexedHeader
reqidx IndexedHeader -> Int -> Maybe Method
forall i e. Ix i => Array i e -> i -> e
! RequestHeaderIndex -> Int
forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqRange
Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> Bool -> Maybe ()
forall a b. (a -> b) -> a -> b
$ Method
method Method -> Method -> Bool
forall a. Eq a => a -> a -> Bool
== Method
H.methodGet
RspFileInfo -> Maybe RspFileInfo
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return (RspFileInfo -> Maybe RspFileInfo)
-> RspFileInfo -> Maybe RspFileInfo
forall a b. (a -> b) -> a -> b
$
if HTTPDate
date HTTPDate -> HTTPDate -> Bool
forall a. Eq a => a -> a -> Bool
== HTTPDate
mtime
then Method -> Integer -> RspFileInfo
parseRange Method
rng Integer
size
else Status -> ResponseHeaders -> Integer -> Integer -> RspFileInfo
WithBody Status
H.ok200 [] Integer
0 Integer
size
unconditional :: IndexedHeader -> Integer -> RspFileInfo
unconditional :: IndexedHeader -> Integer -> RspFileInfo
unconditional IndexedHeader
reqidx =
case IndexedHeader
reqidx IndexedHeader -> Int -> Maybe Method
forall i e. Ix i => Array i e -> i -> e
! RequestHeaderIndex -> Int
forall a. Enum a => a -> Int
fromEnum RequestHeaderIndex
ReqRange of
Maybe Method
Nothing -> Status -> ResponseHeaders -> Integer -> Integer -> RspFileInfo
WithBody Status
H.ok200 [] Integer
0
Just Method
rng -> Method -> Integer -> RspFileInfo
parseRange Method
rng
parseRange :: ByteString -> Integer -> RspFileInfo
parseRange :: Method -> Integer -> RspFileInfo
parseRange Method
rng Integer
size = case Method -> Maybe ByteRanges
H.parseByteRanges Method
rng of
Maybe ByteRanges
Nothing -> Status -> RspFileInfo
WithoutBody Status
H.requestedRangeNotSatisfiable416
Just [] -> Status -> RspFileInfo
WithoutBody Status
H.requestedRangeNotSatisfiable416
Just (ByteRange
r : ByteRanges
_) ->
let (!Integer
beg, !Integer
end) = ByteRange -> Integer -> (Integer, Integer)
checkRange ByteRange
r Integer
size
!len :: Integer
len = Integer
end Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
beg Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1
s :: Status
s =
if Integer
beg Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
0 Bool -> Bool -> Bool
&& Integer
end Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1
then Status
H.ok200
else Status
H.partialContent206
in Status -> ResponseHeaders -> Integer -> Integer -> RspFileInfo
WithBody Status
s [] Integer
beg Integer
len
checkRange :: H.ByteRange -> Integer -> (Integer, Integer)
checkRange :: ByteRange -> Integer -> (Integer, Integer)
checkRange (H.ByteRangeFrom Integer
beg) Integer
size = (Integer
beg, Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
checkRange (H.ByteRangeFromTo Integer
beg Integer
end) Integer
size = (Integer
beg, Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
min (Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer
end)
checkRange (H.ByteRangeSuffix Integer
count) Integer
size = (Integer -> Integer -> Integer
forall a. Ord a => a -> a -> a
max Integer
0 (Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
count), Integer
size Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
contentRangeHeader :: Integer -> Integer -> Integer -> H.Header
Integer
beg Integer
end Integer
total = (HeaderName
H.hContentRange, Method
range)
where
range :: Method
range =
String -> Method
C8.pack
(String -> Method) -> String -> Method
forall a b. (a -> b) -> a -> b
$
Char
'b'
Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'y'
Char -> ShowS
forall a. a -> [a] -> [a]
: Char
't'
Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'e'
Char -> ShowS
forall a. a -> [a] -> [a]
: Char
's'
Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' '
Char -> ShowS
forall a. a -> [a] -> [a]
: ( if Integer
beg Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
end
then (Char
'*' Char -> ShowS
forall a. a -> [a] -> [a]
:)
else
Integer -> ShowS
forall a. Integral a => a -> ShowS
showInt Integer
beg
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char
'-' Char -> ShowS
forall a. a -> [a] -> [a]
:)
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ShowS
forall a. Integral a => a -> ShowS
showInt Integer
end
)
( Char
'/'
Char -> ShowS
forall a. a -> [a] -> [a]
: Integer -> ShowS
forall a. Integral a => a -> ShowS
showInt Integer
total String
""
)
addContentHeaders
:: H.ResponseHeaders -> Integer -> Integer -> Integer -> H.ResponseHeaders
ResponseHeaders
hs Integer
off Integer
len Integer
size
| Integer
len Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== Integer
size = ResponseHeaders
hs'
| Bool
otherwise =
let !ctrng :: (HeaderName, Method)
ctrng = Integer -> Integer -> Integer -> (HeaderName, Method)
contentRangeHeader Integer
off (Integer
off Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
len Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1) Integer
size
in (HeaderName, Method)
ctrng (HeaderName, Method) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
hs'
where
!lengthBS :: Method
lengthBS = Integer -> Method
forall a. Integral a => a -> Method
packIntegral Integer
len
!hs' :: ResponseHeaders
hs' = (HeaderName
H.hContentLength, Method
lengthBS) (HeaderName, Method) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: (HeaderName
H.hAcceptRanges, Method
"bytes") (HeaderName, Method) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
hs
addContentHeadersForFilePart
:: H.ResponseHeaders -> FilePart -> H.ResponseHeaders
ResponseHeaders
hs FilePart
part = ResponseHeaders -> Integer -> Integer -> Integer -> ResponseHeaders
addContentHeaders ResponseHeaders
hs Integer
off Integer
len Integer
size
where
off :: Integer
off = FilePart -> Integer
filePartOffset FilePart
part
len :: Integer
len = FilePart -> Integer
filePartByteCount FilePart
part
size :: Integer
size = FilePart -> Integer
filePartFileSize FilePart
part