{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: Network.Greskell.WebSocket.Request.Common
-- Description: Common data types for Request objects
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
--
module Network.Greskell.WebSocket.Request.Common
    ( Operation (..)
    , SASLMechanism (..)
    , Base64 (..)
    ) where

import           Control.Applicative    (empty)
import           Data.Aeson             (FromJSON (..), Object, ToJSON (..), Value (String))
import           Data.ByteString        (ByteString)
import qualified Data.ByteString.Base64 as B64
import           Data.Text              (Text, unpack)
import           Data.Text.Encoding     (decodeUtf8, encodeUtf8)


-- | Class of operation objects.
class Operation o where
  opProcessor :: o -> Text
  -- ^ \"processor\" field.
  opName :: o -> Text
  -- ^ \"op\" field.
  opArgs :: o -> Object
  -- ^ \"args\" field.

instance (Operation a, Operation b) => Operation (Either a b) where
  opProcessor :: Either a b -> Text
opProcessor Either a b
e = (a -> Text) -> (b -> Text) -> Either a b -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Text
forall o. Operation o => o -> Text
opProcessor b -> Text
forall o. Operation o => o -> Text
opProcessor Either a b
e
  opName :: Either a b -> Text
opName Either a b
e = (a -> Text) -> (b -> Text) -> Either a b -> Text
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Text
forall o. Operation o => o -> Text
opName b -> Text
forall o. Operation o => o -> Text
opName Either a b
e
  opArgs :: Either a b -> Object
opArgs Either a b
e = (a -> Object) -> (b -> Object) -> Either a b -> Object
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> Object
forall o. Operation o => o -> Object
opArgs b -> Object
forall o. Operation o => o -> Object
opArgs Either a b
e


-- | Possible SASL mechanisms.
data SASLMechanism
  = SASLPlain -- ^ \"PLAIN\" SASL
  | SASLGSSAPI -- ^ \"GSSAPI\" SASL
  deriving (SASLMechanism
SASLMechanism -> SASLMechanism -> Bounded SASLMechanism
forall a. a -> a -> Bounded a
$cminBound :: SASLMechanism
minBound :: SASLMechanism
$cmaxBound :: SASLMechanism
maxBound :: SASLMechanism
Bounded, Int -> SASLMechanism
SASLMechanism -> Int
SASLMechanism -> [SASLMechanism]
SASLMechanism -> SASLMechanism
SASLMechanism -> SASLMechanism -> [SASLMechanism]
SASLMechanism -> SASLMechanism -> SASLMechanism -> [SASLMechanism]
(SASLMechanism -> SASLMechanism)
-> (SASLMechanism -> SASLMechanism)
-> (Int -> SASLMechanism)
-> (SASLMechanism -> Int)
-> (SASLMechanism -> [SASLMechanism])
-> (SASLMechanism -> SASLMechanism -> [SASLMechanism])
-> (SASLMechanism -> SASLMechanism -> [SASLMechanism])
-> (SASLMechanism
    -> SASLMechanism -> SASLMechanism -> [SASLMechanism])
-> Enum SASLMechanism
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: SASLMechanism -> SASLMechanism
succ :: SASLMechanism -> SASLMechanism
$cpred :: SASLMechanism -> SASLMechanism
pred :: SASLMechanism -> SASLMechanism
$ctoEnum :: Int -> SASLMechanism
toEnum :: Int -> SASLMechanism
$cfromEnum :: SASLMechanism -> Int
fromEnum :: SASLMechanism -> Int
$cenumFrom :: SASLMechanism -> [SASLMechanism]
enumFrom :: SASLMechanism -> [SASLMechanism]
$cenumFromThen :: SASLMechanism -> SASLMechanism -> [SASLMechanism]
enumFromThen :: SASLMechanism -> SASLMechanism -> [SASLMechanism]
$cenumFromTo :: SASLMechanism -> SASLMechanism -> [SASLMechanism]
enumFromTo :: SASLMechanism -> SASLMechanism -> [SASLMechanism]
$cenumFromThenTo :: SASLMechanism -> SASLMechanism -> SASLMechanism -> [SASLMechanism]
enumFromThenTo :: SASLMechanism -> SASLMechanism -> SASLMechanism -> [SASLMechanism]
Enum, SASLMechanism -> SASLMechanism -> Bool
(SASLMechanism -> SASLMechanism -> Bool)
-> (SASLMechanism -> SASLMechanism -> Bool) -> Eq SASLMechanism
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SASLMechanism -> SASLMechanism -> Bool
== :: SASLMechanism -> SASLMechanism -> Bool
$c/= :: SASLMechanism -> SASLMechanism -> Bool
/= :: SASLMechanism -> SASLMechanism -> Bool
Eq, Eq SASLMechanism
Eq SASLMechanism =>
(SASLMechanism -> SASLMechanism -> Ordering)
-> (SASLMechanism -> SASLMechanism -> Bool)
-> (SASLMechanism -> SASLMechanism -> Bool)
-> (SASLMechanism -> SASLMechanism -> Bool)
-> (SASLMechanism -> SASLMechanism -> Bool)
-> (SASLMechanism -> SASLMechanism -> SASLMechanism)
-> (SASLMechanism -> SASLMechanism -> SASLMechanism)
-> Ord SASLMechanism
SASLMechanism -> SASLMechanism -> Bool
SASLMechanism -> SASLMechanism -> Ordering
SASLMechanism -> SASLMechanism -> SASLMechanism
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
$ccompare :: SASLMechanism -> SASLMechanism -> Ordering
compare :: SASLMechanism -> SASLMechanism -> Ordering
$c< :: SASLMechanism -> SASLMechanism -> Bool
< :: SASLMechanism -> SASLMechanism -> Bool
$c<= :: SASLMechanism -> SASLMechanism -> Bool
<= :: SASLMechanism -> SASLMechanism -> Bool
$c> :: SASLMechanism -> SASLMechanism -> Bool
> :: SASLMechanism -> SASLMechanism -> Bool
$c>= :: SASLMechanism -> SASLMechanism -> Bool
>= :: SASLMechanism -> SASLMechanism -> Bool
$cmax :: SASLMechanism -> SASLMechanism -> SASLMechanism
max :: SASLMechanism -> SASLMechanism -> SASLMechanism
$cmin :: SASLMechanism -> SASLMechanism -> SASLMechanism
min :: SASLMechanism -> SASLMechanism -> SASLMechanism
Ord, Int -> SASLMechanism -> ShowS
[SASLMechanism] -> ShowS
SASLMechanism -> [Char]
(Int -> SASLMechanism -> ShowS)
-> (SASLMechanism -> [Char])
-> ([SASLMechanism] -> ShowS)
-> Show SASLMechanism
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SASLMechanism -> ShowS
showsPrec :: Int -> SASLMechanism -> ShowS
$cshow :: SASLMechanism -> [Char]
show :: SASLMechanism -> [Char]
$cshowList :: [SASLMechanism] -> ShowS
showList :: [SASLMechanism] -> ShowS
Show)

instance ToJSON SASLMechanism where
  toJSON :: SASLMechanism -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (SASLMechanism -> Text) -> SASLMechanism -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SASLMechanism -> Text
toText
    where
      toText :: SASLMechanism -> Text
      toText :: SASLMechanism -> Text
toText SASLMechanism
SASLPlain  = Text
"PLAIN"
      toText SASLMechanism
SASLGSSAPI = Text
"GSSAPI"

instance FromJSON SASLMechanism where
  parseJSON :: Value -> Parser SASLMechanism
parseJSON (String Text
s) = case Text
s of
    Text
"PLAIN"  -> SASLMechanism -> Parser SASLMechanism
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SASLMechanism
SASLPlain
    Text
"GSSAPI" -> SASLMechanism -> Parser SASLMechanism
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SASLMechanism
SASLGSSAPI
    Text
_        -> [Char] -> Parser SASLMechanism
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Unknown SASLMechanism: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
unpack Text
s)
  parseJSON Value
_ = Parser SASLMechanism
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | A raw 'ByteString' encoded to\/decoded from a base64 text.
--
-- 'ToJSON' instance encodes the raw 'ByteString' to a base64-encoded
-- 'Text'. 'FromJSON' is its inverse.
newtype Base64
  = Base64 { Base64 -> ByteString
unByte64 :: ByteString }
  deriving (Base64 -> Base64 -> Bool
(Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool) -> Eq Base64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Base64 -> Base64 -> Bool
== :: Base64 -> Base64 -> Bool
$c/= :: Base64 -> Base64 -> Bool
/= :: Base64 -> Base64 -> Bool
Eq, Eq Base64
Eq Base64 =>
(Base64 -> Base64 -> Ordering)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Base64)
-> (Base64 -> Base64 -> Base64)
-> Ord Base64
Base64 -> Base64 -> Bool
Base64 -> Base64 -> Ordering
Base64 -> Base64 -> Base64
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
$ccompare :: Base64 -> Base64 -> Ordering
compare :: Base64 -> Base64 -> Ordering
$c< :: Base64 -> Base64 -> Bool
< :: Base64 -> Base64 -> Bool
$c<= :: Base64 -> Base64 -> Bool
<= :: Base64 -> Base64 -> Bool
$c> :: Base64 -> Base64 -> Bool
> :: Base64 -> Base64 -> Bool
$c>= :: Base64 -> Base64 -> Bool
>= :: Base64 -> Base64 -> Bool
$cmax :: Base64 -> Base64 -> Base64
max :: Base64 -> Base64 -> Base64
$cmin :: Base64 -> Base64 -> Base64
min :: Base64 -> Base64 -> Base64
Ord, Int -> Base64 -> ShowS
[Base64] -> ShowS
Base64 -> [Char]
(Int -> Base64 -> ShowS)
-> (Base64 -> [Char]) -> ([Base64] -> ShowS) -> Show Base64
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Base64 -> ShowS
showsPrec :: Int -> Base64 -> ShowS
$cshow :: Base64 -> [Char]
show :: Base64 -> [Char]
$cshowList :: [Base64] -> ShowS
showList :: [Base64] -> ShowS
Show)

instance ToJSON Base64 where
  toJSON :: Base64 -> Value
toJSON (Base64 ByteString
bs) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> Text -> Value
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
B64.encode ByteString
bs

instance FromJSON Base64 where
  parseJSON :: Value -> Parser Base64
parseJSON (String Text
t) = ([Char] -> Parser Base64)
-> (ByteString -> Parser Base64)
-> Either [Char] ByteString
-> Parser Base64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> Parser Base64
forall a. [Char] -> Parser a
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail (Base64 -> Parser Base64
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Base64 -> Parser Base64)
-> (ByteString -> Base64) -> ByteString -> Parser Base64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Base64
Base64) (Either [Char] ByteString -> Parser Base64)
-> Either [Char] ByteString -> Parser Base64
forall a b. (a -> b) -> a -> b
$ ByteString -> Either [Char] ByteString
B64.decode (ByteString -> Either [Char] ByteString)
-> ByteString -> Either [Char] ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
  parseJSON Value
_          = Parser Base64
forall a. Parser a
forall (f :: * -> *) a. Alternative f => f a
empty