-- | Code for parsing extensions headers.
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
module Network.WebSockets.Extensions.Description
    ( ExtensionParam
    , ExtensionDescription (..)
    , ExtensionDescriptions

    , parseExtensionDescriptions
    , encodeExtensionDescriptions
    ) where

import           Control.Applicative              ((*>), (<*))
import qualified Data.Attoparsec.ByteString       as A
import qualified Data.Attoparsec.ByteString.Char8 as AC8
import qualified Data.ByteString                  as B
import           Data.Monoid                      (mconcat, mappend)
import           Prelude

type ExtensionParam = (B.ByteString, Maybe B.ByteString)

data ExtensionDescription = ExtensionDescription
    { ExtensionDescription -> ByteString
extName   :: !B.ByteString
    , ExtensionDescription -> [ExtensionParam]
extParams :: ![ExtensionParam]
    } deriving (ExtensionDescription -> ExtensionDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtensionDescription -> ExtensionDescription -> Bool
$c/= :: ExtensionDescription -> ExtensionDescription -> Bool
== :: ExtensionDescription -> ExtensionDescription -> Bool
$c== :: ExtensionDescription -> ExtensionDescription -> Bool
Eq, Int -> ExtensionDescription -> ShowS
[ExtensionDescription] -> ShowS
ExtensionDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtensionDescription] -> ShowS
$cshowList :: [ExtensionDescription] -> ShowS
show :: ExtensionDescription -> String
$cshow :: ExtensionDescription -> String
showsPrec :: Int -> ExtensionDescription -> ShowS
$cshowsPrec :: Int -> ExtensionDescription -> ShowS
Show)

parseExtensionDescription :: A.Parser ExtensionDescription
parseExtensionDescription :: Parser ExtensionDescription
parseExtensionDescription = do
    ByteString
extName   <- Parser ByteString ByteString
parseIdentifier
    [ExtensionParam]
extParams <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
A.many' (Char -> Parser ByteString Word8
token Char
';' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ExtensionParam
parseParam)
    forall (m :: * -> *) a. Monad m => a -> m a
return ExtensionDescription {[ExtensionParam]
ByteString
extParams :: [ExtensionParam]
extName :: ByteString
extParams :: [ExtensionParam]
extName :: ByteString
..}
  where
    parseIdentifier :: Parser ByteString ByteString
parseIdentifier = (Char -> Bool) -> Parser ByteString ByteString
AC8.takeWhile Char -> Bool
isIdentifierChar forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
AC8.skipSpace

    token :: Char -> Parser ByteString Word8
token Char
c = Char -> Parser ByteString Word8
AC8.char8 Char
c forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
AC8.skipSpace

    isIdentifierChar :: Char -> Bool
isIdentifierChar Char
c =
        (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
||
        (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Z') Bool -> Bool -> Bool
||
        (Char
c forall a. Ord a => a -> a -> Bool
>= Char
'0' Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'9') Bool -> Bool -> Bool
||
        Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'

    parseParam :: A.Parser ExtensionParam
    parseParam :: Parser ByteString ExtensionParam
parseParam = do
        ByteString
name <- Parser ByteString ByteString
parseIdentifier
        Maybe ByteString
val  <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Char -> Parser ByteString Word8
token Char
'=' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
parseIdentifier
        forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
name, Maybe ByteString
val)

encodeExtensionDescription :: ExtensionDescription -> B.ByteString
encodeExtensionDescription :: ExtensionDescription -> ByteString
encodeExtensionDescription ExtensionDescription {[ExtensionParam]
ByteString
extParams :: [ExtensionParam]
extName :: ByteString
extParams :: ExtensionDescription -> [ExtensionParam]
extName :: ExtensionDescription -> ByteString
..} =
    forall a. Monoid a => [a] -> a
mconcat (ByteString
extName forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}. (Monoid a, IsString a) => (a, Maybe a) -> a
encodeParam [ExtensionParam]
extParams)
  where
    encodeParam :: (a, Maybe a) -> a
encodeParam (a
key, Maybe a
Nothing)  = a
";" forall a. Monoid a => a -> a -> a
`mappend` a
key
    encodeParam (a
key, Just a
val) = a
";" forall a. Monoid a => a -> a -> a
`mappend` a
key forall a. Monoid a => a -> a -> a
`mappend` a
"=" forall a. Monoid a => a -> a -> a
`mappend` a
val

type ExtensionDescriptions = [ExtensionDescription]

parseExtensionDescriptions :: B.ByteString -> Either String ExtensionDescriptions
parseExtensionDescriptions :: ByteString -> Either String [ExtensionDescription]
parseExtensionDescriptions = forall a. Parser a -> ByteString -> Either String a
A.parseOnly forall a b. (a -> b) -> a -> b
$
    Parser ()
AC8.skipSpace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*>
    forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
A.sepBy Parser ExtensionDescription
parseExtensionDescription (Char -> Parser ByteString Word8
AC8.char8 Char
',' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
AC8.skipSpace) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<*
    forall t. Chunk t => Parser t ()
A.endOfInput

encodeExtensionDescriptions :: ExtensionDescriptions -> B.ByteString
encodeExtensionDescriptions :: [ExtensionDescription] -> ByteString
encodeExtensionDescriptions = ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"," forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ExtensionDescription -> ByteString
encodeExtensionDescription