{-# LANGUAGE OverloadedStrings #-}
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 Operation o where
opProcessor :: o -> Text
opName :: o -> Text
opArgs :: o -> Object
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
data SASLMechanism = SASLPlain
| SASLGSSAPI
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
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