-- | Defines the 'Encoding' accept header with an 'Accept' instance for use in
-- language negotiation.
module Network.HTTP.Media.Encoding.Internal
  ( Encoding (..),
  )
where

import Control.Monad (guard)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BS
import Data.CaseInsensitive (CI, original)
import qualified Data.CaseInsensitive as CI
import Data.Maybe (fromMaybe)
import Data.String (IsString (..))
import Network.HTTP.Media.Accept (Accept (..))
import Network.HTTP.Media.RenderHeader (RenderHeader (..))
import Network.HTTP.Media.Utils (isValidToken)

-- | Suitable for HTTP encoding as defined in
-- <https://tools.ietf.org/html/rfc7231#section-5.3.4 RFC7231>.
--
-- Specifically:
--
-- > codings = content-coding / "identity" / "*"
newtype Encoding = Encoding (CI ByteString)
  deriving (Encoding -> Encoding -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Encoding -> Encoding -> Bool
$c/= :: Encoding -> Encoding -> Bool
== :: Encoding -> Encoding -> Bool
$c== :: Encoding -> Encoding -> Bool
Eq, Eq Encoding
Encoding -> Encoding -> Bool
Encoding -> Encoding -> Ordering
Encoding -> Encoding -> Encoding
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 :: Encoding -> Encoding -> Encoding
$cmin :: Encoding -> Encoding -> Encoding
max :: Encoding -> Encoding -> Encoding
$cmax :: Encoding -> Encoding -> Encoding
>= :: Encoding -> Encoding -> Bool
$c>= :: Encoding -> Encoding -> Bool
> :: Encoding -> Encoding -> Bool
$c> :: Encoding -> Encoding -> Bool
<= :: Encoding -> Encoding -> Bool
$c<= :: Encoding -> Encoding -> Bool
< :: Encoding -> Encoding -> Bool
$c< :: Encoding -> Encoding -> Bool
compare :: Encoding -> Encoding -> Ordering
$ccompare :: Encoding -> Encoding -> Ordering
Ord)

instance Show Encoding where
  show :: Encoding -> String
show = ByteString -> String
BS.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h. RenderHeader h => h -> ByteString
renderHeader

instance IsString Encoding where
  fromString :: String -> Encoding
fromString String
str =
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. a -> Maybe a -> a
fromMaybe (forall a. Accept a => ByteString -> Maybe a
parseAccept forall a b. (a -> b) -> a -> b
$ String -> ByteString
BS.pack String
str) forall a b. (a -> b) -> a -> b
$
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
        String
"Invalid encoding literal " forall a. [a] -> [a] -> [a]
++ String
str

instance Accept Encoding where
  -- This handles the case where the header value is empty, but it also
  -- allows technically invalid values such as "compress;q=0.8,;q=0.5".
  parseAccept :: ByteString -> Maybe Encoding
parseAccept ByteString
"" = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ CI ByteString -> Encoding
Encoding CI ByteString
"identity"
  parseAccept ByteString
bs = do
    forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ ByteString -> Bool
isValidToken ByteString
bs
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CI ByteString -> Encoding
Encoding (forall s. FoldCase s => s -> CI s
CI.mk ByteString
bs)

  matches :: Encoding -> Encoding -> Bool
matches Encoding
_ (Encoding CI ByteString
"*") = Bool
True
  matches Encoding
a Encoding
b = Encoding
a forall a. Eq a => a -> a -> Bool
== Encoding
b

  moreSpecificThan :: Encoding -> Encoding -> Bool
moreSpecificThan Encoding
_ (Encoding CI ByteString
"*") = Bool
True
  moreSpecificThan Encoding
_ Encoding
_ = Bool
False

instance RenderHeader Encoding where
  renderHeader :: Encoding -> ByteString
renderHeader (Encoding CI ByteString
e) = forall s. CI s -> s
original CI ByteString
e