-----------------------------------------------------------------------------
-- | Common utilities.
module Network.HTTP.Media.Utils
    ( breakChar
    , trimBS

    , mediaChars
    , isMediaChar

    , tokenChars
    , isTokenChar
    , isValidToken
    ) where

import qualified Data.ByteString.Char8 as BS

import           Data.ByteString       (ByteString)
import           Data.Char             (isControl)


------------------------------------------------------------------------------
-- | Equivalent to 'Data.ByteString.break' (on equality against the given
-- character), but leaves out the byte that the string is broken on.
breakChar :: Char -> ByteString -> Maybe (ByteString, ByteString)
breakChar :: Char -> ByteString -> Maybe (ByteString, ByteString)
breakChar Char
c = (ByteString, ByteString) -> Maybe (ByteString, ByteString)
forall a. (a, ByteString) -> Maybe (a, ByteString)
safeTail ((ByteString, ByteString) -> Maybe (ByteString, ByteString))
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> Maybe (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
c)
  where
    safeTail :: (a, ByteString) -> Maybe (a, ByteString)
safeTail (a
a, ByteString
b)
        | ByteString -> Bool
BS.null ByteString
b = Maybe (a, ByteString)
forall a. Maybe a
Nothing
        | Bool
otherwise = (a, ByteString) -> Maybe (a, ByteString)
forall a. a -> Maybe a
Just (a
a, ByteString -> ByteString
BS.tail ByteString
b)


------------------------------------------------------------------------------
-- | Trims tab and space characters from both ends of a ByteString.
trimBS :: ByteString -> ByteString
trimBS :: ByteString -> ByteString
trimBS = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Char -> Bool
isLWS (ByteString -> (ByteString, ByteString))
-> (ByteString -> ByteString)
-> ByteString
-> (ByteString, ByteString)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ByteString -> ByteString
BS.dropWhile Char -> Bool
isLWS
  where
    isLWS :: Char -> Bool
isLWS Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'


------------------------------------------------------------------------------
-- | List of the valid characters for a media-type `reg-name` as per RFC 4288.
mediaChars :: [Char]
mediaChars :: [Char]
mediaChars = [Char
'A'..Char
'Z'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'a'..Char
'z'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char
'0'..Char
'9'] [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"!#$&.+-^_"


------------------------------------------------------------------------------
-- | Evaluates whether the given character is valid in a media type `reg-name`
-- as per RFC 4288.
isMediaChar :: Char -> Bool
isMediaChar :: Char -> Bool
isMediaChar = (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Char]
mediaChars)


------------------------------------------------------------------------------
-- | Evaluates whether the given character is valid in an HTTP header token as
-- per RFC 2616.
isTokenChar :: Char -> Bool
isTokenChar :: Char -> Bool
isTokenChar = Bool -> Bool -> Bool
(||) (Bool -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isControl (Char -> Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> [Char] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char]
separators)
  where
    separators :: [Char]
separators = [ Char
'(', Char
')', Char
'<', Char
'>', Char
'@', Char
',', Char
';', Char
':', Char
'\\'
                 , Char
'"', Char
'/', Char
'[', Char
']', Char
'?', Char
'=', Char
'{', Char
'}', Char
' '
                 ]


------------------------------------------------------------------------------
-- | HTTP header token characters as per RFC 2616.
tokenChars :: [Char]
tokenChars :: [Char]
tokenChars = (Char -> Bool) -> [Char] -> [Char]
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isTokenChar [Char
'\0'..Char
'\127']


------------------------------------------------------------------------------
-- | Evaluates whether the given ASCII string is valid as an HTTP header token
-- as per RFC 2616.
isValidToken :: ByteString -> Bool
isValidToken :: ByteString -> Bool
isValidToken = Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> (ByteString -> Bool) -> ByteString -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null (ByteString -> Bool -> Bool)
-> (ByteString -> Bool) -> ByteString -> Bool
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> ByteString -> Bool
BS.all Char -> Bool
isTokenChar