{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Type and constants for handling HTTP header fields.
--
-- At the bottom are also some functions to handle certain header field values.
module Network.HTTP.Types.Header (
    -- * HTTP Headers
    Header,
    HeaderName,
    RequestHeaders,
    ResponseHeaders,

    -- ** Common headers

    -- | The following header constants are provided for convenience,
    -- to prevent accidental spelling errors.
    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,

    -- ** Byte ranges

    -- | Convenience functions and types to handle values from Range headers.
    --
    -- https://www.rfc-editor.org/rfc/rfc9110.html#name-byte-ranges
    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)

-- | A full HTTP header field with the name and value separated.
--
-- E.g. @\"Content-Length: 28\"@ parsed into a 'Header' would turn into @("Content-Length", "28")@
type Header = (HeaderName, B.ByteString)

-- | A case-insensitive name of a header field.
--
-- This is the part of the header field before the colon: @HeaderName: some value@
type HeaderName = CI.CI B.ByteString

-- | A list of 'Header's.
--
-- Same type as 'ResponseHeaders', but useful to differentiate in type signatures.
type RequestHeaders = [Header]

-- | A list of 'Header's.
--
-- Same type as 'RequestHeaders', but useful to differentiate in type signatures.
type ResponseHeaders = [Header]

-- | [Accept](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept)
--
-- @since 0.7.0
hAccept :: HeaderName
hAccept :: HeaderName
hAccept = HeaderName
"Accept"

-- | [Accept-Charset](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-charset)
--
-- @since 0.9
hAcceptCharset :: HeaderName
hAcceptCharset :: HeaderName
hAcceptCharset = HeaderName
"Accept-Charset"

-- | [Accept-Encoding](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-encoding)
--
-- @since 0.9
hAcceptEncoding :: HeaderName
hAcceptEncoding :: HeaderName
hAcceptEncoding = HeaderName
"Accept-Encoding"

-- | [Accept-Language](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-language)
--
-- @since 0.7.0
hAcceptLanguage :: HeaderName
hAcceptLanguage :: HeaderName
hAcceptLanguage = HeaderName
"Accept-Language"

-- | [Accept-Ranges](https://www.rfc-editor.org/rfc/rfc9110.html#name-accept-ranges)
--
-- @since 0.9
hAcceptRanges :: HeaderName
hAcceptRanges :: HeaderName
hAcceptRanges = HeaderName
"Accept-Ranges"

-- | [Age](https://www.rfc-editor.org/rfc/rfc9111.html#name-age)
--
-- @since 0.9
hAge :: HeaderName
hAge :: HeaderName
hAge = HeaderName
"Age"

-- | [Allow](https://www.rfc-editor.org/rfc/rfc9110.html#name-allow)
--
-- @since 0.9
hAllow :: HeaderName
hAllow :: HeaderName
hAllow = HeaderName
"Allow"

-- | [Authorization](https://www.rfc-editor.org/rfc/rfc9110.html#name-authorization)
--
-- @since 0.7.0
hAuthorization :: HeaderName
hAuthorization :: HeaderName
hAuthorization = HeaderName
"Authorization"

-- | [Cache-Control](https://www.rfc-editor.org/rfc/rfc9111.html#name-cache-control)
--
-- @since 0.7.0
hCacheControl :: HeaderName
hCacheControl :: HeaderName
hCacheControl = HeaderName
"Cache-Control"

-- | [Connection](https://www.rfc-editor.org/rfc/rfc9110.html#name-connection)
--
-- @since 0.7.0
hConnection :: HeaderName
hConnection :: HeaderName
hConnection = HeaderName
"Connection"

-- | [Content-Encoding](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-encoding)
--
-- @since 0.7.0
hContentEncoding :: HeaderName
hContentEncoding :: HeaderName
hContentEncoding = HeaderName
"Content-Encoding"

-- | [Content-Language](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-language)
--
-- @since 0.9
hContentLanguage :: HeaderName
hContentLanguage :: HeaderName
hContentLanguage = HeaderName
"Content-Language"

-- | [Content-Length](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-length)
--
-- @since 0.7.0
hContentLength :: HeaderName
hContentLength :: HeaderName
hContentLength = HeaderName
"Content-Length"

-- | [Content-Location](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-location)
--
-- @since 0.9
hContentLocation :: HeaderName
hContentLocation :: HeaderName
hContentLocation = HeaderName
"Content-Location"

-- | [Content-MD5](https://www.rfc-editor.org/rfc/rfc2616.html#section-14.15)
--
-- /This header has been obsoleted in RFC 9110./
--
-- @since 0.7.0
hContentMD5 :: HeaderName
hContentMD5 :: HeaderName
hContentMD5 = HeaderName
"Content-MD5"

-- | [Content-Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-range)
--
-- @since 0.9
hContentRange :: HeaderName
hContentRange :: HeaderName
hContentRange = HeaderName
"Content-Range"

-- | [Content-Type](https://www.rfc-editor.org/rfc/rfc9110.html#name-content-type)
--
-- @since 0.7.0
hContentType :: HeaderName
hContentType :: HeaderName
hContentType = HeaderName
"Content-Type"

-- | [Date](https://www.rfc-editor.org/rfc/rfc9110.html#name-date)
--
-- @since 0.7.0
hDate :: HeaderName
hDate :: HeaderName
hDate = HeaderName
"Date"

-- | [ETag](https://www.rfc-editor.org/rfc/rfc9110.html#name-etag)
--
-- @since 0.9
hETag :: HeaderName
hETag :: HeaderName
hETag = HeaderName
"ETag"

-- | [Expect](https://www.rfc-editor.org/rfc/rfc9110.html#name-expect)
--
-- @since 0.9
hExpect :: HeaderName
hExpect :: HeaderName
hExpect = HeaderName
"Expect"

-- | [Expires](https://www.rfc-editor.org/rfc/rfc9111.html#name-expires)
--
-- @since 0.9
hExpires :: HeaderName
hExpires :: HeaderName
hExpires = HeaderName
"Expires"

-- | [From](https://www.rfc-editor.org/rfc/rfc9110.html#name-from)
--
-- @since 0.9
hFrom :: HeaderName
hFrom :: HeaderName
hFrom = HeaderName
"From"

-- | [Host](https://www.rfc-editor.org/rfc/rfc9110.html#name-host-and-authority)
--
-- @since 0.9
hHost :: HeaderName
hHost :: HeaderName
hHost = HeaderName
"Host"

-- | [If-Match](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-match)
--
-- @since 0.9
hIfMatch :: HeaderName
hIfMatch :: HeaderName
hIfMatch = HeaderName
"If-Match"

-- | [If-Modified-Since](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-modified-since)
--
-- @since 0.7.0
hIfModifiedSince :: HeaderName
hIfModifiedSince :: HeaderName
hIfModifiedSince = HeaderName
"If-Modified-Since"

-- | [If-None-Match](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-none-match)
--
-- @since 0.9
hIfNoneMatch :: HeaderName
hIfNoneMatch :: HeaderName
hIfNoneMatch = HeaderName
"If-None-Match"

-- | [If-Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-range)
--
-- @since 0.7.0
hIfRange :: HeaderName
hIfRange :: HeaderName
hIfRange = HeaderName
"If-Range"

-- | [If-Unmodified-Since](https://www.rfc-editor.org/rfc/rfc9110.html#name-if-unmodified-since)
--
-- @since 0.9
hIfUnmodifiedSince :: HeaderName
hIfUnmodifiedSince :: HeaderName
hIfUnmodifiedSince = HeaderName
"If-Unmodified-Since"

-- | [Last-Modified](https://www.rfc-editor.org/rfc/rfc9110.html#name-last-modified)
--
-- @since 0.7.0
hLastModified :: HeaderName
hLastModified :: HeaderName
hLastModified = HeaderName
"Last-Modified"

-- | [Location](https://www.rfc-editor.org/rfc/rfc9110.html#name-location)
--
-- @since 0.7.1
hLocation :: HeaderName
hLocation :: HeaderName
hLocation = HeaderName
"Location"

-- | [Max-Forwards](https://www.rfc-editor.org/rfc/rfc9110.html#name-max-forwards)
--
-- @since 0.9
hMaxForwards :: HeaderName
hMaxForwards :: HeaderName
hMaxForwards = HeaderName
"Max-Forwards"

-- | [Pragma](https://www.rfc-editor.org/rfc/rfc9111.html#name-pragma)
--
-- /This header has been deprecated in RFC 9111 in favor of "Cache-Control"./
--
-- @since 0.9
hPragma :: HeaderName
hPragma :: HeaderName
hPragma = HeaderName
"Pragma"

-- | [Proxy-Authenticate](https://www.rfc-editor.org/rfc/rfc9110.html#name-proxy-authenticate)
--
-- @since 0.9
hProxyAuthenticate :: HeaderName
hProxyAuthenticate :: HeaderName
hProxyAuthenticate = HeaderName
"Proxy-Authenticate"

-- | [Proxy-Authorization](https://www.rfc-editor.org/rfc/rfc9110.html#name-proxy-authorization)
--
-- @since 0.9
hProxyAuthorization :: HeaderName
hProxyAuthorization :: HeaderName
hProxyAuthorization = HeaderName
"Proxy-Authorization"

-- | [Range](https://www.rfc-editor.org/rfc/rfc9110.html#name-range)
--
-- @since 0.7.0
hRange :: HeaderName
hRange :: HeaderName
hRange = HeaderName
"Range"

-- | [Referer](https://www.rfc-editor.org/rfc/rfc9110.html#name-referer)
--
-- @since 0.7.0
hReferer :: HeaderName
hReferer :: HeaderName
hReferer = HeaderName
"Referer"

-- | [Retry-After](https://www.rfc-editor.org/rfc/rfc9110.html#name-retry-after)
--
-- @since 0.9
hRetryAfter :: HeaderName
hRetryAfter :: HeaderName
hRetryAfter = HeaderName
"Retry-After"

-- | [Server](https://www.rfc-editor.org/rfc/rfc9110.html#name-server)
--
-- @since 0.7.1
hServer :: HeaderName
hServer :: HeaderName
hServer = HeaderName
"Server"

-- | [TE](https://www.rfc-editor.org/rfc/rfc9110.html#name-te)
--
-- @since 0.9
hTE :: HeaderName
hTE :: HeaderName
hTE = HeaderName
"TE"

-- | [Trailer](https://www.rfc-editor.org/rfc/rfc9110.html#name-trailer)
--
-- @since 0.9
hTrailer :: HeaderName
hTrailer :: HeaderName
hTrailer = HeaderName
"Trailer"

-- | [Transfer-Encoding](https://www.rfc-editor.org/rfc/rfc9112#name-transfer-encoding)
--
-- @since 0.9
hTransferEncoding :: HeaderName
hTransferEncoding :: HeaderName
hTransferEncoding = HeaderName
"Transfer-Encoding"

-- | [Upgrade](https://www.rfc-editor.org/rfc/rfc9110.html#name-upgrade)
--
-- @since 0.9
hUpgrade :: HeaderName
hUpgrade :: HeaderName
hUpgrade = HeaderName
"Upgrade"

-- | [User-Agent](https://www.rfc-editor.org/rfc/rfc9110.html#name-user-agent)
--
-- @since 0.7.0
hUserAgent :: HeaderName
hUserAgent :: HeaderName
hUserAgent = HeaderName
"User-Agent"

-- | [Vary](https://www.rfc-editor.org/rfc/rfc9110.html#name-vary)
--
-- @since 0.9
hVary :: HeaderName
hVary :: HeaderName
hVary = HeaderName
"Vary"

-- | [Via](https://www.rfc-editor.org/rfc/rfc9110.html#name-via)
--
-- @since 0.9
hVia :: HeaderName
hVia :: HeaderName
hVia = HeaderName
"Via"

-- | [WWW-Authenticate](https://www.rfc-editor.org/rfc/rfc9110.html#name-www-authenticate)
--
-- @since 0.9
hWWWAuthenticate :: HeaderName
hWWWAuthenticate :: HeaderName
hWWWAuthenticate = HeaderName
"WWW-Authenticate"

-- | [Warning](https://www.rfc-editor.org/rfc/rfc9111.html#name-warning)
--
-- /This header has been obsoleted in RFC 9110./
--
-- @since 0.9
hWarning :: HeaderName
hWarning :: HeaderName
hWarning = HeaderName
"Warning"

-- | [Content-Disposition](https://www.rfc-editor.org/rfc/rfc6266.html)
--
-- @since 0.10
hContentDisposition :: HeaderName
hContentDisposition :: HeaderName
hContentDisposition = HeaderName
"Content-Disposition"

-- | [MIME-Version](https://www.rfc-editor.org/rfc/rfc2616.html#section-19.4.1)
--
-- @since 0.10
hMIMEVersion :: HeaderName
hMIMEVersion :: HeaderName
hMIMEVersion = HeaderName
"MIME-Version"

-- | [Cookie](https://www.rfc-editor.org/rfc/rfc6265.html#section-4.2)
--
-- @since 0.7.0
hCookie :: HeaderName
hCookie :: HeaderName
hCookie = HeaderName
"Cookie"

-- | [Set-Cookie](https://www.rfc-editor.org/rfc/rfc6265.html#section-4.1)
--
-- @since 0.10
hSetCookie :: HeaderName
hSetCookie :: HeaderName
hSetCookie = HeaderName
"Set-Cookie"

-- | [Origin](https://www.rfc-editor.org/rfc/rfc6454.html#section-7)
--
-- @since 0.10
hOrigin :: HeaderName
hOrigin :: HeaderName
hOrigin = HeaderName
"Origin"

-- | [Prefer](https://www.rfc-editor.org/rfc/rfc7240.html#section-2)
--
-- @since 0.12.2
hPrefer :: HeaderName
hPrefer :: HeaderName
hPrefer = HeaderName
"Prefer"

-- | [Preference-Applied](https://www.rfc-editor.org/rfc/rfc7240.html#section-3)
--
-- @since 0.12.2
hPreferenceApplied :: HeaderName
hPreferenceApplied :: HeaderName
hPreferenceApplied = HeaderName
"Preference-Applied"

-- | An individual byte range.
--
-- Negative indices are not allowed!
--
-- @since 0.6.11
data ByteRange
    = ByteRangeFrom !Integer
    | ByteRangeFromTo !Integer !Integer
    | ByteRangeSuffix !Integer
    deriving
        ( -- | @since 0.8.4
          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
        , -- | @since 0.8.4
          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
        , -- | @since 0.8.4
          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
        , -- | @since 0.8.4
          Typeable
        , -- | @since 0.8.4
          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
        , -- | @since 0.12.4
          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
        )

-- | Turns a byte range into a byte string 'B.Builder'.
--
-- @since 0.6.11
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

-- | Renders a byte range into a 'B.ByteString'.
--
-- >>> renderByteRange (ByteRangeFrom 2048)
-- "2048-"
--
-- @since 0.6.11
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

-- | A list of byte ranges.
--
-- @since 0.6.11
type ByteRanges = [ByteRange]

-- | Turns a list of byte ranges into a byte string 'B.Builder'.
--
-- @since 0.6.11
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)

-- | Renders a list of byte ranges into a 'B.ByteString'.
--
-- >>> renderByteRanges [ByteRangeFrom 2048, ByteRangeSuffix 20]
-- "bytes=2048-,-20"
--
-- @since 0.6.11
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

-- | Parse the value of a Range header into a 'ByteRanges'.
--
-- >>> parseByteRanges "error"
-- Nothing
-- >>> parseByteRanges "bytes=0-499"
-- Just [ByteRangeFromTo 0 499]
-- >>> parseByteRanges "bytes=500-999"
-- Just [ByteRangeFromTo 500 999]
-- >>> parseByteRanges "bytes=-500"
-- Just [ByteRangeSuffix 500]
-- >>> parseByteRanges "bytes=9500-"
-- Just [ByteRangeFrom 9500]
-- >>> parseByteRanges "bytes=0-0,-1"
-- Just [ByteRangeFromTo 0 0,ByteRangeSuffix 1]
-- >>> parseByteRanges "bytes=500-600,601-999"
-- Just [ByteRangeFromTo 500 600,ByteRangeFromTo 601 999]
-- >>> parseByteRanges "bytes=500-700,601-999"
-- Just [ByteRangeFromTo 500 700,ByteRangeFromTo 601 999]
--
-- @since 0.9.1
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 -- has prefix "-" ("-0" is not valid, but here treated as "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

    -- FIXME: Use 'stripPrefix' from the 'bytestring' package.
    -- Might have to update the dependency constraints though.
    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