    {-# LANGUAGE CPP #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE BangPatterns, RecordWildCards #-}

    module Network.Wai.Handler.Warp.HTTP2.File (
        RspFileInfo(..)
      , conditionalRequest
      , addContentHeadersForFilePart
      , H.parseByteRanges
      ) where

    import Control.Applicative ((<|>))
    import qualified Data.ByteString.Char8 as B (pack)
    import Data.ByteString (ByteString)
    import Data.Maybe (fromMaybe)
    import Network.HTTP.Date
    import qualified Network.HTTP.Types as H
    import Network.Wai
    import qualified Network.Wai.Handler.Warp.FileInfoCache as I
    import Network.Wai.Handler.Warp.PackInt
    import Numeric (showInt)
    import Network.HPACK
    import Network.HPACK.Token

    -- $setup
    -- >>> import Test.QuickCheck

    ----------------------------------------------------------------

    data RspFileInfo = WithoutBody !H.Status
                     | WithBody !H.Status !TokenHeaderList !Integer !Integer
                     deriving (Eq,Show)

    ----------------------------------------------------------------

    conditionalRequest :: I.FileInfo
                       -> TokenHeaderList -- Response
                       -> ValueTable -- Request
                       -> RspFileInfo
    conditionalRequest (I.FileInfo _ size mtime date) ths0 reqtbl = case condition of
        nobody@(WithoutBody _) -> nobody
        WithBody s _ off len   -> let !hs = (tokenLastModified,date) :
                                            addContentHeaders ths0 off len size
                                  in WithBody s hs off len
      where
        !mcondition = ifmodified    reqtbl size mtime
                  <|> ifunmodified  reqtbl size mtime
                  <|> ifrange       reqtbl size mtime
        !condition = fromMaybe (unconditional reqtbl size) mcondition

    ----------------------------------------------------------------

    {-# INLINE ifModifiedSince #-}
    ifModifiedSince :: ValueTable -> Maybe HTTPDate
    ifModifiedSince reqtbl = getHeaderValue tokenIfModifiedSince reqtbl >>= parseHTTPDate

    {-# INLINE ifUnmodifiedSince #-}
    ifUnmodifiedSince :: ValueTable -> Maybe HTTPDate
    ifUnmodifiedSince reqtbl = getHeaderValue tokenIfUnmodifiedSince reqtbl >>= parseHTTPDate

    {-# INLINE ifRange #-}
    ifRange :: ValueTable -> Maybe HTTPDate
    ifRange reqtbl = getHeaderValue tokenIfRange reqtbl >>= parseHTTPDate

    ----------------------------------------------------------------

    {-# INLINE ifmodified #-}
    ifmodified :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
    ifmodified reqtbl size mtime = do
        date <- ifModifiedSince reqtbl
        return $ if date /= mtime
                 then unconditional reqtbl size
                 else WithoutBody H.notModified304

    {-# INLINE ifunmodified #-}
    ifunmodified :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
    ifunmodified reqtbl size mtime = do
        date <- ifUnmodifiedSince reqtbl
        return $ if date == mtime
                 then unconditional reqtbl size
                 else WithoutBody H.preconditionFailed412

    {-# INLINE ifrange #-}
    ifrange :: ValueTable -> Integer -> HTTPDate -> Maybe RspFileInfo
    ifrange reqtbl size mtime = do
        date <- ifRange reqtbl
        rng  <- getHeaderValue tokenRange reqtbl
        return $ if date == mtime
                 then parseRange rng size
                 else WithBody H.ok200 [] 0 size

    {-# INLINE unconditional #-}
    unconditional :: ValueTable -> Integer -> RspFileInfo
    unconditional reqtbl size = case getHeaderValue tokenRange reqtbl of
        Nothing  -> WithBody H.ok200 [] 0 size
        Just rng -> parseRange rng size

    ----------------------------------------------------------------

    {-# INLINE parseRange #-}
    parseRange :: ByteString -> Integer -> RspFileInfo
    parseRange rng size = case H.parseByteRanges rng of
        Nothing    -> WithoutBody H.requestedRangeNotSatisfiable416
        Just []    -> WithoutBody H.requestedRangeNotSatisfiable416
        Just (r:_) -> let (!beg, !end) = checkRange r size
                          !len = end - beg + 1
                          s = if beg == 0 && end == size - 1 then
                                  H.ok200
                                else
                                  H.partialContent206
                      in WithBody s [] beg len

    {-# INLINE checkRange #-}
    checkRange :: H.ByteRange -> Integer -> (Integer, Integer)
    checkRange (H.ByteRangeFrom   beg)     size = (beg, size - 1)
    checkRange (H.ByteRangeFromTo beg end) size = (beg,  min (size - 1) end)
    checkRange (H.ByteRangeSuffix count)   size = (max 0 (size - count), size - 1)

    ----------------------------------------------------------------

    {-# INLINE contentRangeHeader #-}
    -- | @contentRangeHeader beg end total@ constructs a Content-Range 'H.Header'
    -- for the range specified.
    contentRangeHeader :: Integer -> Integer -> Integer -> TokenHeader
    contentRangeHeader beg end total = (tokenContentRange, range)
      where
        range = B.pack
          -- building with ShowS
          $ 'b' : 'y': 't' : 'e' : 's' : ' '
          : (if beg > end then ('*':) else
              showInt beg
              . ('-' :)
              . showInt end)
          ( '/'
          : showInt total "")

    {-# INLINE addContentHeaders #-}
    addContentHeaders :: TokenHeaderList -> Integer -> Integer -> Integer -> TokenHeaderList
    addContentHeaders ths off len size
      | len == size = ths'
      | otherwise   = let !ctrng = contentRangeHeader off (off + len - 1) size
                      in ctrng:ths'
      where
        !lengthBS = packIntegral len
        !ths' = (tokenContentLength, lengthBS) : (tokenAcceptRanges,"bytes") : ths

    {-# INLINE addContentHeadersForFilePart #-}
    -- |
    --
    -- >>> addContentHeadersForFilePart [] (FilePart 2 10 16)
    -- [(Token {ix = 20, shouldBeIndexed = True, isPseudo = False, tokenKey = "Content-Range"},"bytes 2-11/16"),(Token {ix = 18, shouldBeIndexed = False, isPseudo = False, tokenKey = "Content-Length"},"10"),(Token {ix = 8, shouldBeIndexed = True, isPseudo = False, tokenKey = "Accept-Ranges"},"bytes")]
    -- >>> addContentHeadersForFilePart [] (FilePart 0 16 16)
    -- [(Token {ix = 18, shouldBeIndexed = False, isPseudo = False, tokenKey = "Content-Length"},"16"),(Token {ix = 8, shouldBeIndexed = True, isPseudo = False, tokenKey = "Accept-Ranges"},"bytes")]
    addContentHeadersForFilePart :: TokenHeaderList -> FilePart -> TokenHeaderList
    addContentHeadersForFilePart hs part = addContentHeaders hs off len size
      where
        off = filePartOffset part
        len = filePartByteCount part
        size = filePartFileSize part