{-# 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 (ToJSON(..), FromJSON(..), Object, Value(String))
import Data.ByteString (ByteString)
import qualified Data.ByteString.Base64 as B64
import Data.Text (unpack, Text)
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 (Int -> SASLMechanism -> ShowS
[SASLMechanism] -> ShowS
SASLMechanism -> String
(Int -> SASLMechanism -> ShowS)
-> (SASLMechanism -> String)
-> ([SASLMechanism] -> ShowS)
-> Show SASLMechanism
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SASLMechanism] -> ShowS
$cshowList :: [SASLMechanism] -> ShowS
show :: SASLMechanism -> String
$cshow :: SASLMechanism -> String
showsPrec :: Int -> SASLMechanism -> ShowS
$cshowsPrec :: Int -> SASLMechanism -> ShowS
Show,SASLMechanism -> SASLMechanism -> Bool
(SASLMechanism -> SASLMechanism -> Bool)
-> (SASLMechanism -> SASLMechanism -> Bool) -> Eq SASLMechanism
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SASLMechanism -> SASLMechanism -> Bool
$c/= :: SASLMechanism -> SASLMechanism -> Bool
== :: SASLMechanism -> SASLMechanism -> Bool
$c== :: 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
min :: SASLMechanism -> SASLMechanism -> SASLMechanism
$cmin :: SASLMechanism -> SASLMechanism -> SASLMechanism
max :: SASLMechanism -> SASLMechanism -> SASLMechanism
$cmax :: SASLMechanism -> SASLMechanism -> SASLMechanism
>= :: SASLMechanism -> SASLMechanism -> Bool
$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
compare :: SASLMechanism -> SASLMechanism -> Ordering
$ccompare :: SASLMechanism -> SASLMechanism -> Ordering
$cp1Ord :: Eq SASLMechanism
Ord,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
enumFromThenTo :: SASLMechanism -> SASLMechanism -> SASLMechanism -> [SASLMechanism]
$cenumFromThenTo :: SASLMechanism -> SASLMechanism -> SASLMechanism -> [SASLMechanism]
enumFromTo :: SASLMechanism -> SASLMechanism -> [SASLMechanism]
$cenumFromTo :: SASLMechanism -> SASLMechanism -> [SASLMechanism]
enumFromThen :: SASLMechanism -> SASLMechanism -> [SASLMechanism]
$cenumFromThen :: SASLMechanism -> SASLMechanism -> [SASLMechanism]
enumFrom :: SASLMechanism -> [SASLMechanism]
$cenumFrom :: SASLMechanism -> [SASLMechanism]
fromEnum :: SASLMechanism -> Int
$cfromEnum :: SASLMechanism -> Int
toEnum :: Int -> SASLMechanism
$ctoEnum :: Int -> SASLMechanism
pred :: SASLMechanism -> SASLMechanism
$cpred :: SASLMechanism -> SASLMechanism
succ :: SASLMechanism -> SASLMechanism
$csucc :: SASLMechanism -> SASLMechanism
Enum,SASLMechanism
SASLMechanism -> SASLMechanism -> Bounded SASLMechanism
forall a. a -> a -> Bounded a
maxBound :: SASLMechanism
$cmaxBound :: SASLMechanism
minBound :: SASLMechanism
$cminBound :: SASLMechanism
Bounded)

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 (m :: * -> *) a. Monad m => a -> m a
return SASLMechanism
SASLPlain
    Text
"GSSAPI" -> SASLMechanism -> Parser SASLMechanism
forall (m :: * -> *) a. Monad m => a -> m a
return SASLMechanism
SASLGSSAPI
    Text
_ -> String -> Parser SASLMechanism
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown SASLMechanism: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
unpack Text
s)
  parseJSON Value
_ = Parser SASLMechanism
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 (Int -> Base64 -> ShowS
[Base64] -> ShowS
Base64 -> String
(Int -> Base64 -> ShowS)
-> (Base64 -> String) -> ([Base64] -> ShowS) -> Show Base64
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Base64] -> ShowS
$cshowList :: [Base64] -> ShowS
show :: Base64 -> String
$cshow :: Base64 -> String
showsPrec :: Int -> Base64 -> ShowS
$cshowsPrec :: Int -> Base64 -> ShowS
Show,Base64 -> Base64 -> Bool
(Base64 -> Base64 -> Bool)
-> (Base64 -> Base64 -> Bool) -> Eq Base64
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Base64 -> Base64 -> Bool
$c/= :: Base64 -> Base64 -> Bool
== :: Base64 -> Base64 -> Bool
$c== :: 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
min :: Base64 -> Base64 -> Base64
$cmin :: Base64 -> Base64 -> Base64
max :: Base64 -> Base64 -> Base64
$cmax :: Base64 -> Base64 -> Base64
>= :: Base64 -> Base64 -> Bool
$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
compare :: Base64 -> Base64 -> Ordering
$ccompare :: Base64 -> Base64 -> Ordering
$cp1Ord :: Eq Base64
Ord)

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) = (String -> Parser Base64)
-> (ByteString -> Parser Base64)
-> Either String ByteString
-> Parser Base64
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> Parser Base64
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (Base64 -> Parser Base64
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 String ByteString -> Parser Base64)
-> Either String ByteString -> Parser Base64
forall a b. (a -> b) -> a -> b
$ ByteString -> Either String ByteString
B64.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
encodeUtf8 Text
t
  parseJSON Value
_ = Parser Base64
forall (f :: * -> *) a. Alternative f => f a
empty