{-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, CPP #-}
module Network.HTTP.Types.Header
(
Header
, HeaderName
, RequestHeaders
, ResponseHeaders
, hAccept
, hAcceptCharset
, hAcceptEncoding
, hAcceptLanguage
, hAcceptRanges
, hAge
, hAllow
, hAuthorization
, hCacheControl
, hConnection
, hContentEncoding
, hContentLanguage
, hContentLength
, hContentLocation
, hContentMD5
, hContentRange
, hContentType
, hDate
, hETag
, hExpect
, hExpires
, hFrom
, hHost
, hIfMatch
, hIfModifiedSince
, hIfNoneMatch
, hIfRange
, hIfUnmodifiedSince
, hLastModified
, hLocation
, hMaxForwards
, hOrigin
, hPragma
, hPrefer
, hPreferenceApplied
, hProxyAuthenticate
, hProxyAuthorization
, hRange
, hReferer
, hRetryAfter
, hServer
, hTE
, hTrailer
, hTransferEncoding
, hUpgrade
, hUserAgent
, hVary
, hVia
, hWWWAuthenticate
, hWarning
, hContentDisposition
, hMIMEVersion
, hCookie
, hSetCookie
, ByteRange(..)
, renderByteRangeBuilder
, renderByteRange
, ByteRanges
, renderByteRangesBuilder
, renderByteRanges
, parseByteRanges
)
where
import Data.List
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid
#endif
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as B8
import qualified Data.ByteString.Builder as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.CaseInsensitive as CI
import Data.ByteString.Char8 ()
import Data.Typeable (Typeable)
import Data.Data (Data)
type Header = (HeaderName, B.ByteString)
type HeaderName = CI.CI B.ByteString
type RequestHeaders = [Header]
type ResponseHeaders = [Header]
hAccept, hAcceptCharset, hAcceptEncoding, hAcceptLanguage, hAcceptRanges, hAge, hAllow, hAuthorization, hCacheControl, hConnection, hContentEncoding, hContentLanguage, hContentLength, hContentLocation, hContentMD5, hContentRange, hContentType, hDate, hETag, hExpect, hExpires, hFrom, hHost, hIfMatch, hIfModifiedSince, hIfNoneMatch, hIfRange, hIfUnmodifiedSince, hLastModified, hLocation, hMaxForwards, hPragma, hProxyAuthenticate, hProxyAuthorization, hRange, hReferer, hRetryAfter, hServer, hTE, hTrailer, hTransferEncoding, hUpgrade, hUserAgent, hVary, hVia, hWWWAuthenticate, hWarning :: HeaderName
hAccept = "Accept"
hAcceptCharset = "Accept-Charset"
hAcceptEncoding = "Accept-Encoding"
hAcceptLanguage = "Accept-Language"
hAcceptRanges = "Accept-Ranges"
hAge = "Age"
hAllow = "Allow"
hAuthorization = "Authorization"
hCacheControl = "Cache-Control"
hConnection = "Connection"
hContentEncoding = "Content-Encoding"
hContentLanguage = "Content-Language"
hContentLength = "Content-Length"
hContentLocation = "Content-Location"
hContentMD5 = "Content-MD5"
hContentRange = "Content-Range"
hContentType = "Content-Type"
hDate = "Date"
hETag = "ETag"
hExpect = "Expect"
hExpires = "Expires"
hFrom = "From"
hHost = "Host"
hIfMatch = "If-Match"
hIfModifiedSince = "If-Modified-Since"
hIfNoneMatch = "If-None-Match"
hIfRange = "If-Range"
hIfUnmodifiedSince = "If-Unmodified-Since"
hLastModified = "Last-Modified"
hLocation = "Location"
hMaxForwards = "Max-Forwards"
hPragma = "Pragma"
hProxyAuthenticate = "Proxy-Authenticate"
hProxyAuthorization = "Proxy-Authorization"
hRange = "Range"
hReferer = "Referer"
hRetryAfter = "Retry-After"
hServer = "Server"
hTE = "TE"
hTrailer = "Trailer"
hTransferEncoding = "Transfer-Encoding"
hUpgrade = "Upgrade"
hUserAgent = "User-Agent"
hVary = "Vary"
hVia = "Via"
hWWWAuthenticate = "WWW-Authenticate"
hWarning = "Warning"
hContentDisposition, hMIMEVersion :: HeaderName
hContentDisposition = "Content-Disposition"
hMIMEVersion = "MIME-Version"
hCookie, hSetCookie :: HeaderName
hCookie = "Cookie"
hSetCookie = "Set-Cookie"
hOrigin :: HeaderName
hOrigin = "Origin"
hPrefer, hPreferenceApplied :: HeaderName
hPrefer = "Prefer"
hPreferenceApplied = "Preference-Applied"
data ByteRange
= ByteRangeFrom !Integer
| ByteRangeFromTo !Integer !Integer
| ByteRangeSuffix !Integer
deriving (Show, Eq, Ord, Typeable, Data)
renderByteRangeBuilder :: ByteRange -> B.Builder
renderByteRangeBuilder (ByteRangeFrom from) = B.integerDec from `mappend` B.char7 '-'
renderByteRangeBuilder (ByteRangeFromTo from to) = B.integerDec from `mappend` B.char7 '-' `mappend` B.integerDec to
renderByteRangeBuilder (ByteRangeSuffix suffix) = B.char7 '-' `mappend` B.integerDec suffix
renderByteRange :: ByteRange -> B.ByteString
renderByteRange = BL.toStrict . B.toLazyByteString . renderByteRangeBuilder
type ByteRanges = [ByteRange]
renderByteRangesBuilder :: ByteRanges -> B.Builder
renderByteRangesBuilder xs = B.byteString "bytes=" `mappend`
mconcat (intersperse (B.char7 ',') (map renderByteRangeBuilder xs))
renderByteRanges :: ByteRanges -> B.ByteString
renderByteRanges = BL.toStrict . B.toLazyByteString . renderByteRangesBuilder
parseByteRanges :: B.ByteString -> Maybe ByteRanges
parseByteRanges bs1 = do
bs2 <- stripPrefixB "bytes=" bs1
(r, bs3) <- range bs2
ranges (r:) bs3
where
range bs2 = do
(i, bs3) <- B8.readInteger bs2
if i < 0
then Just (ByteRangeSuffix (negate i), bs3)
else do
bs4 <- stripPrefixB "-" bs3
case B8.readInteger bs4 of
Just (j, bs5) | j >= i -> Just (ByteRangeFromTo i j, bs5)
_ -> Just (ByteRangeFrom i, bs4)
ranges front bs3
| B.null bs3 = Just (front [])
| otherwise = do
bs4 <- stripPrefixB "," bs3
(r, bs5) <- range bs4
ranges (front . (r:)) bs5
stripPrefixB x y
| x `B.isPrefixOf` y = Just (B.drop (B.length x) y)
| otherwise = Nothing