content: {-# LANGUAGE OverloadedStrings, FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable, DeriveGeneric, CPP #-}
  module Network.HTTP.Types.Header
  (
    -- ** Types
    Header
  , HeaderName
  , RequestHeaders
  , ResponseHeaders
    -- ** Common headers
  , 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
    -- ** Byte ranges
  , 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          () {-IsString-}
  import           Data.Typeable                  (Typeable)
  import           Data.Data                      (Data)
  import           GHC.Generics                   (Generic)
  
  -- | Header
  type Header = (HeaderName, B.ByteString)
  
  -- | Header name
  type HeaderName = CI.CI B.ByteString
  
  -- | Request Headers
  type RequestHeaders = [Header]
  
  -- | Response Headers
  type ResponseHeaders = [Header]
  
  -- | HTTP Header names according to http://www.w3.org/Protocols/rfc2616/rfc2616-sec14.html
  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"
  
  -- | HTTP Header names according to http://www.w3.org/Protocols/rfc2616/rfc2616-sec19.html
  hContentDisposition, hMIMEVersion :: HeaderName
  hContentDisposition = "Content-Disposition"
  hMIMEVersion        = "MIME-Version"
  
  -- | HTTP Header names according to https://tools.ietf.org/html/rfc6265#section-4
  hCookie, hSetCookie :: HeaderName
  hCookie             = "Cookie"
  hSetCookie          = "Set-Cookie"
  
  -- | HTTP Header names according to https://tools.ietf.org/html/rfc6454
  hOrigin :: HeaderName
  hOrigin = "Origin"
  
  -- | HTTP Header names according to https://tools.ietf.org/html/rfc7240
  hPrefer, hPreferenceApplied :: HeaderName
  hPrefer = "Prefer"
  hPreferenceApplied = "Preference-Applied"
  
  -- | RFC 2616 Byte range (individual).
  --
  -- Negative indices are not allowed!
  data ByteRange
    = ByteRangeFrom !Integer
    | ByteRangeFromTo !Integer !Integer
    | ByteRangeSuffix !Integer
    deriving (Show, Eq, Ord, Typeable, Data, Generic)
  
  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
  
  -- | RFC 2616 Byte ranges (set).
  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
  
  -- | 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]
  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 -- has prefix "-" ("-0" is not valid, but here treated as "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
  