{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP.Types.Header (
Header,
HeaderName,
RequestHeaders,
ResponseHeaders,
hAccept,
hAcceptCharset,
hAcceptEncoding,
hAcceptLanguage,
hAcceptRanges,
hAge,
hAllow,
hAuthorization,
hCacheControl,
hConnection,
hContentDisposition,
hContentEncoding,
hContentLanguage,
hContentLength,
hContentLocation,
hContentMD5,
hContentRange,
hContentType,
hCookie,
hDate,
hETag,
hExpect,
hExpires,
hFrom,
hHost,
hIfMatch,
hIfModifiedSince,
hIfNoneMatch,
hIfRange,
hIfUnmodifiedSince,
hLastModified,
hLocation,
hMaxForwards,
hMIMEVersion,
hOrigin,
hPragma,
hPrefer,
hPreferenceApplied,
hProxyAuthenticate,
hProxyAuthorization,
hRange,
hReferer,
hRetryAfter,
hServer,
hSetCookie,
hTE,
hTrailer,
hTransferEncoding,
hUpgrade,
hUserAgent,
hVary,
hVia,
hWWWAuthenticate,
hWarning,
ByteRange (..),
renderByteRangeBuilder,
renderByteRange,
ByteRanges,
renderByteRangesBuilder,
renderByteRanges,
parseByteRanges,
)
where
import qualified Data.ByteString as B
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import Data.Data (Data)
import Data.List (intersperse)
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
type = (HeaderName, B.ByteString)
type = CI.CI B.ByteString
type = [Header]
type = [Header]
hAccept :: HeaderName
hAccept :: HeaderName
hAccept = HeaderName
"Accept"
hAcceptCharset :: HeaderName
hAcceptCharset :: HeaderName
hAcceptCharset = HeaderName
"Accept-Charset"
hAcceptEncoding :: HeaderName
hAcceptEncoding :: HeaderName
hAcceptEncoding = HeaderName
"Accept-Encoding"
hAcceptLanguage :: HeaderName
hAcceptLanguage :: HeaderName
hAcceptLanguage = HeaderName
"Accept-Language"
hAcceptRanges :: HeaderName
hAcceptRanges :: HeaderName
hAcceptRanges = HeaderName
"Accept-Ranges"
hAge :: HeaderName
hAge :: HeaderName
hAge = HeaderName
"Age"
hAllow :: HeaderName
hAllow :: HeaderName
hAllow = HeaderName
"Allow"
hAuthorization :: HeaderName
hAuthorization :: HeaderName
hAuthorization = HeaderName
"Authorization"
hCacheControl :: HeaderName
hCacheControl :: HeaderName
hCacheControl = HeaderName
"Cache-Control"
hConnection :: HeaderName
hConnection :: HeaderName
hConnection = HeaderName
"Connection"
hContentEncoding :: HeaderName
hContentEncoding :: HeaderName
hContentEncoding = HeaderName
"Content-Encoding"
hContentLanguage :: HeaderName
hContentLanguage :: HeaderName
hContentLanguage = HeaderName
"Content-Language"
hContentLength :: HeaderName
hContentLength :: HeaderName
hContentLength = HeaderName
"Content-Length"
hContentLocation :: HeaderName
hContentLocation :: HeaderName
hContentLocation = HeaderName
"Content-Location"
hContentMD5 :: HeaderName
hContentMD5 :: HeaderName
hContentMD5 = HeaderName
"Content-MD5"
hContentRange :: HeaderName
hContentRange :: HeaderName
hContentRange = HeaderName
"Content-Range"
hContentType :: HeaderName
hContentType :: HeaderName
hContentType = HeaderName
"Content-Type"
hDate :: HeaderName
hDate :: HeaderName
hDate = HeaderName
"Date"
hETag :: HeaderName
hETag :: HeaderName
hETag = HeaderName
"ETag"
hExpect :: HeaderName
hExpect :: HeaderName
hExpect = HeaderName
"Expect"
hExpires :: HeaderName
hExpires :: HeaderName
hExpires = HeaderName
"Expires"
hFrom :: HeaderName
hFrom :: HeaderName
hFrom = HeaderName
"From"
hHost :: HeaderName
hHost :: HeaderName
hHost = HeaderName
"Host"
hIfMatch :: HeaderName
hIfMatch :: HeaderName
hIfMatch = HeaderName
"If-Match"
hIfModifiedSince :: HeaderName
hIfModifiedSince :: HeaderName
hIfModifiedSince = HeaderName
"If-Modified-Since"
hIfNoneMatch :: HeaderName
hIfNoneMatch :: HeaderName
hIfNoneMatch = HeaderName
"If-None-Match"
hIfRange :: HeaderName
hIfRange :: HeaderName
hIfRange = HeaderName
"If-Range"
hIfUnmodifiedSince :: HeaderName
hIfUnmodifiedSince :: HeaderName
hIfUnmodifiedSince = HeaderName
"If-Unmodified-Since"
hLastModified :: HeaderName
hLastModified :: HeaderName
hLastModified = HeaderName
"Last-Modified"
hLocation :: HeaderName
hLocation :: HeaderName
hLocation = HeaderName
"Location"
hMaxForwards :: HeaderName
hMaxForwards :: HeaderName
hMaxForwards = HeaderName
"Max-Forwards"
hPragma :: HeaderName
hPragma :: HeaderName
hPragma = HeaderName
"Pragma"
hProxyAuthenticate :: HeaderName
hProxyAuthenticate :: HeaderName
hProxyAuthenticate = HeaderName
"Proxy-Authenticate"
hProxyAuthorization :: HeaderName
hProxyAuthorization :: HeaderName
hProxyAuthorization = HeaderName
"Proxy-Authorization"
hRange :: HeaderName
hRange :: HeaderName
hRange = HeaderName
"Range"
hReferer :: HeaderName
hReferer :: HeaderName
hReferer = HeaderName
"Referer"
hRetryAfter :: HeaderName
hRetryAfter :: HeaderName
hRetryAfter = HeaderName
"Retry-After"
hServer :: HeaderName
hServer :: HeaderName
hServer = HeaderName
"Server"
hTE :: HeaderName
hTE :: HeaderName
hTE = HeaderName
"TE"
hTrailer :: HeaderName
hTrailer :: HeaderName
hTrailer = HeaderName
"Trailer"
hTransferEncoding :: HeaderName
hTransferEncoding :: HeaderName
hTransferEncoding = HeaderName
"Transfer-Encoding"
hUpgrade :: HeaderName
hUpgrade :: HeaderName
hUpgrade = HeaderName
"Upgrade"
hUserAgent :: HeaderName
hUserAgent :: HeaderName
hUserAgent = HeaderName
"User-Agent"
hVary :: HeaderName
hVary :: HeaderName
hVary = HeaderName
"Vary"
hVia :: HeaderName
hVia :: HeaderName
hVia = HeaderName
"Via"
hWWWAuthenticate :: HeaderName
hWWWAuthenticate :: HeaderName
hWWWAuthenticate = HeaderName
"WWW-Authenticate"
hWarning :: HeaderName
hWarning :: HeaderName
hWarning = HeaderName
"Warning"
hContentDisposition :: HeaderName
hContentDisposition :: HeaderName
hContentDisposition = HeaderName
"Content-Disposition"
hMIMEVersion :: HeaderName
hMIMEVersion :: HeaderName
hMIMEVersion = HeaderName
"MIME-Version"
hCookie :: HeaderName
hCookie :: HeaderName
hCookie = HeaderName
"Cookie"
hSetCookie :: HeaderName
hSetCookie :: HeaderName
hSetCookie = HeaderName
"Set-Cookie"
hOrigin :: HeaderName
hOrigin :: HeaderName
hOrigin = HeaderName
"Origin"
hPrefer :: HeaderName
hPrefer :: HeaderName
hPrefer = HeaderName
"Prefer"
hPreferenceApplied :: HeaderName
hPreferenceApplied :: HeaderName
hPreferenceApplied = HeaderName
"Preference-Applied"
data ByteRange
= ByteRangeFrom !Integer
| ByteRangeFromTo !Integer !Integer
| ByteRangeSuffix !Integer
deriving
(
Int -> ByteRange -> ShowS
[ByteRange] -> ShowS
ByteRange -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ByteRange] -> ShowS
$cshowList :: [ByteRange] -> ShowS
show :: ByteRange -> String
$cshow :: ByteRange -> String
showsPrec :: Int -> ByteRange -> ShowS
$cshowsPrec :: Int -> ByteRange -> ShowS
Show
,
ByteRange -> ByteRange -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ByteRange -> ByteRange -> Bool
$c/= :: ByteRange -> ByteRange -> Bool
== :: ByteRange -> ByteRange -> Bool
$c== :: ByteRange -> ByteRange -> Bool
Eq
,
Eq ByteRange
ByteRange -> ByteRange -> Bool
ByteRange -> ByteRange -> Ordering
ByteRange -> ByteRange -> ByteRange
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ByteRange -> ByteRange -> ByteRange
$cmin :: ByteRange -> ByteRange -> ByteRange
max :: ByteRange -> ByteRange -> ByteRange
$cmax :: ByteRange -> ByteRange -> ByteRange
>= :: ByteRange -> ByteRange -> Bool
$c>= :: ByteRange -> ByteRange -> Bool
> :: ByteRange -> ByteRange -> Bool
$c> :: ByteRange -> ByteRange -> Bool
<= :: ByteRange -> ByteRange -> Bool
$c<= :: ByteRange -> ByteRange -> Bool
< :: ByteRange -> ByteRange -> Bool
$c< :: ByteRange -> ByteRange -> Bool
compare :: ByteRange -> ByteRange -> Ordering
$ccompare :: ByteRange -> ByteRange -> Ordering
Ord
,
Typeable
,
Typeable ByteRange
ByteRange -> DataType
ByteRange -> Constr
(forall b. Data b => b -> b) -> ByteRange -> ByteRange
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ByteRange -> u
forall u. (forall d. Data d => d -> u) -> ByteRange -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ByteRange -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ByteRange -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ByteRange -> m ByteRange
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ByteRange -> m ByteRange
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteRange
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ByteRange -> c ByteRange
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ByteRange)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ByteRange)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ByteRange -> m ByteRange
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ByteRange -> m ByteRange
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ByteRange -> m ByteRange
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ByteRange -> m ByteRange
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ByteRange -> m ByteRange
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ByteRange -> m ByteRange
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ByteRange -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ByteRange -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ByteRange -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ByteRange -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ByteRange -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ByteRange -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ByteRange -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ByteRange -> r
gmapT :: (forall b. Data b => b -> b) -> ByteRange -> ByteRange
$cgmapT :: (forall b. Data b => b -> b) -> ByteRange -> ByteRange
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ByteRange)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ByteRange)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ByteRange)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ByteRange)
dataTypeOf :: ByteRange -> DataType
$cdataTypeOf :: ByteRange -> DataType
toConstr :: ByteRange -> Constr
$ctoConstr :: ByteRange -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteRange
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ByteRange
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ByteRange -> c ByteRange
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ByteRange -> c ByteRange
Data
,
forall x. Rep ByteRange x -> ByteRange
forall x. ByteRange -> Rep ByteRange x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ByteRange x -> ByteRange
$cfrom :: forall x. ByteRange -> Rep ByteRange x
Generic
)
renderByteRangeBuilder :: ByteRange -> B.Builder
renderByteRangeBuilder :: ByteRange -> Builder
renderByteRangeBuilder (ByteRangeFrom Integer
from) = Integer -> Builder
B.integerDec Integer
from forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
B.char7 Char
'-'
renderByteRangeBuilder (ByteRangeFromTo Integer
from Integer
to) = Integer -> Builder
B.integerDec Integer
from forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
B.char7 Char
'-' forall a. Monoid a => a -> a -> a
`mappend` Integer -> Builder
B.integerDec Integer
to
renderByteRangeBuilder (ByteRangeSuffix Integer
suffix) = Char -> Builder
B.char7 Char
'-' forall a. Monoid a => a -> a -> a
`mappend` Integer -> Builder
B.integerDec Integer
suffix
renderByteRange :: ByteRange -> B.ByteString
renderByteRange :: ByteRange -> ByteString
renderByteRange = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteRange -> Builder
renderByteRangeBuilder
type ByteRanges = [ByteRange]
renderByteRangesBuilder :: ByteRanges -> B.Builder
renderByteRangesBuilder :: [ByteRange] -> Builder
renderByteRangesBuilder [ByteRange]
xs =
ByteString -> Builder
B.byteString ByteString
"bytes="
forall a. Monoid a => a -> a -> a
`mappend` forall a. Monoid a => [a] -> a
mconcat (forall a. a -> [a] -> [a]
intersperse (Char -> Builder
B.char7 Char
',') forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ByteRange -> Builder
renderByteRangeBuilder [ByteRange]
xs)
renderByteRanges :: ByteRanges -> B.ByteString
renderByteRanges :: [ByteRange] -> ByteString
renderByteRanges = ByteString -> ByteString
BL.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
B.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteRange] -> Builder
renderByteRangesBuilder
parseByteRanges :: B.ByteString -> Maybe ByteRanges
parseByteRanges :: ByteString -> Maybe [ByteRange]
parseByteRanges ByteString
bs1 = do
ByteString
bs2 <- ByteString -> ByteString -> Maybe ByteString
stripPrefixB ByteString
"bytes=" ByteString
bs1
(ByteRange
r, ByteString
bs3) <- ByteString -> Maybe (ByteRange, ByteString)
range ByteString
bs2
forall {c}. ([ByteRange] -> c) -> ByteString -> Maybe c
ranges (ByteRange
r forall a. a -> [a] -> [a]
:) ByteString
bs3
where
range :: ByteString -> Maybe (ByteRange, ByteString)
range ByteString
bs2 = do
(Integer
i, ByteString
bs3) <- ByteString -> Maybe (Integer, ByteString)
B8.readInteger ByteString
bs2
if Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0
then forall a. a -> Maybe a
Just (Integer -> ByteRange
ByteRangeSuffix (forall a. Num a => a -> a
negate Integer
i), ByteString
bs3)
else do
ByteString
bs4 <- ByteString -> ByteString -> Maybe ByteString
stripPrefixB ByteString
"-" ByteString
bs3
case ByteString -> Maybe (Integer, ByteString)
B8.readInteger ByteString
bs4 of
Just (Integer
j, ByteString
bs5) | Integer
j forall a. Ord a => a -> a -> Bool
>= Integer
i -> forall a. a -> Maybe a
Just (Integer -> Integer -> ByteRange
ByteRangeFromTo Integer
i Integer
j, ByteString
bs5)
Maybe (Integer, ByteString)
_ -> forall a. a -> Maybe a
Just (Integer -> ByteRange
ByteRangeFrom Integer
i, ByteString
bs4)
ranges :: ([ByteRange] -> c) -> ByteString -> Maybe c
ranges [ByteRange] -> c
front ByteString
bs3
| ByteString -> Bool
B.null ByteString
bs3 = forall a. a -> Maybe a
Just ([ByteRange] -> c
front [])
| Bool
otherwise = do
ByteString
bs4 <- ByteString -> ByteString -> Maybe ByteString
stripPrefixB ByteString
"," ByteString
bs3
(ByteRange
r, ByteString
bs5) <- ByteString -> Maybe (ByteRange, ByteString)
range ByteString
bs4
([ByteRange] -> c) -> ByteString -> Maybe c
ranges ([ByteRange] -> c
front forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteRange
r forall a. a -> [a] -> [a]
:)) ByteString
bs5
stripPrefixB :: ByteString -> ByteString -> Maybe ByteString
stripPrefixB ByteString
x ByteString
y
| ByteString
x ByteString -> ByteString -> Bool
`B.isPrefixOf` ByteString
y = forall a. a -> Maybe a
Just (Int -> ByteString -> ByteString
B.drop (ByteString -> Int
B.length ByteString
x) ByteString
y)
| Bool
otherwise = forall a. Maybe a
Nothing