{-# LANGUAGE DeriveGeneric, DuplicateRecordFields, OverloadedStrings #-}
-- |
-- Module: Network.Greskell.WebSocket.Request.Session
-- Description: Operation objects for session OpProcessor
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- 
module Network.Greskell.WebSocket.Request.Session
       ( -- * OpAuthentication
         OpAuthentication(..),
         -- * OpEval
         SessionID,
         OpEval(..),
         -- * OpClose
         OpClose(..)
       ) where

import Data.Aeson (ToJSON(..), FromJSON(..), Object)
import Data.UUID (UUID)
import Data.Text (Text)
import Data.HashMap.Strict (HashMap)
import GHC.Generics (Generic)

import qualified Network.Greskell.WebSocket.Request.Aeson as GAeson
import Network.Greskell.WebSocket.Request.Common
  (Base64, SASLMechanism, Operation(..))

data OpAuthentication =
  OpAuthentication
  { OpAuthentication -> Maybe Int
batchSize :: !(Maybe Int),
    OpAuthentication -> Base64
sasl :: !Base64,
    OpAuthentication -> SASLMechanism
saslMechanism :: !SASLMechanism
  }
  deriving (Int -> OpAuthentication -> ShowS
[OpAuthentication] -> ShowS
OpAuthentication -> String
(Int -> OpAuthentication -> ShowS)
-> (OpAuthentication -> String)
-> ([OpAuthentication] -> ShowS)
-> Show OpAuthentication
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpAuthentication] -> ShowS
$cshowList :: [OpAuthentication] -> ShowS
show :: OpAuthentication -> String
$cshow :: OpAuthentication -> String
showsPrec :: Int -> OpAuthentication -> ShowS
$cshowsPrec :: Int -> OpAuthentication -> ShowS
Show,OpAuthentication -> OpAuthentication -> Bool
(OpAuthentication -> OpAuthentication -> Bool)
-> (OpAuthentication -> OpAuthentication -> Bool)
-> Eq OpAuthentication
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpAuthentication -> OpAuthentication -> Bool
$c/= :: OpAuthentication -> OpAuthentication -> Bool
== :: OpAuthentication -> OpAuthentication -> Bool
$c== :: OpAuthentication -> OpAuthentication -> Bool
Eq,Eq OpAuthentication
Eq OpAuthentication
-> (OpAuthentication -> OpAuthentication -> Ordering)
-> (OpAuthentication -> OpAuthentication -> Bool)
-> (OpAuthentication -> OpAuthentication -> Bool)
-> (OpAuthentication -> OpAuthentication -> Bool)
-> (OpAuthentication -> OpAuthentication -> Bool)
-> (OpAuthentication -> OpAuthentication -> OpAuthentication)
-> (OpAuthentication -> OpAuthentication -> OpAuthentication)
-> Ord OpAuthentication
OpAuthentication -> OpAuthentication -> Bool
OpAuthentication -> OpAuthentication -> Ordering
OpAuthentication -> OpAuthentication -> OpAuthentication
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 :: OpAuthentication -> OpAuthentication -> OpAuthentication
$cmin :: OpAuthentication -> OpAuthentication -> OpAuthentication
max :: OpAuthentication -> OpAuthentication -> OpAuthentication
$cmax :: OpAuthentication -> OpAuthentication -> OpAuthentication
>= :: OpAuthentication -> OpAuthentication -> Bool
$c>= :: OpAuthentication -> OpAuthentication -> Bool
> :: OpAuthentication -> OpAuthentication -> Bool
$c> :: OpAuthentication -> OpAuthentication -> Bool
<= :: OpAuthentication -> OpAuthentication -> Bool
$c<= :: OpAuthentication -> OpAuthentication -> Bool
< :: OpAuthentication -> OpAuthentication -> Bool
$c< :: OpAuthentication -> OpAuthentication -> Bool
compare :: OpAuthentication -> OpAuthentication -> Ordering
$ccompare :: OpAuthentication -> OpAuthentication -> Ordering
$cp1Ord :: Eq OpAuthentication
Ord,(forall x. OpAuthentication -> Rep OpAuthentication x)
-> (forall x. Rep OpAuthentication x -> OpAuthentication)
-> Generic OpAuthentication
forall x. Rep OpAuthentication x -> OpAuthentication
forall x. OpAuthentication -> Rep OpAuthentication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpAuthentication x -> OpAuthentication
$cfrom :: forall x. OpAuthentication -> Rep OpAuthentication x
Generic)

instance ToJSON OpAuthentication where
  toJSON :: OpAuthentication -> Value
toJSON = Options -> OpAuthentication -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
GAeson.genericToJSON Options
GAeson.opt
  toEncoding :: OpAuthentication -> Encoding
toEncoding = Options -> OpAuthentication -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
GAeson.genericToEncoding Options
GAeson.opt

instance FromJSON OpAuthentication where
  parseJSON :: Value -> Parser OpAuthentication
parseJSON = Options -> Value -> Parser OpAuthentication
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
GAeson.genericParseJSON Options
GAeson.opt

instance Operation OpAuthentication where
  opProcessor :: OpAuthentication -> Text
opProcessor OpAuthentication
_ = Text
"session"
  opName :: OpAuthentication -> Text
opName OpAuthentication
_ = Text
"authentication"
  opArgs :: OpAuthentication -> Object
opArgs = OpAuthentication -> Object
forall a. ToJSON a => a -> Object
GAeson.toObject


type SessionID = UUID

data OpEval =
  OpEval
  { OpEval -> Maybe Int
batchSize :: !(Maybe Int),
    OpEval -> Text
gremlin :: !Text,
    OpEval -> Maybe Object
bindings :: !(Maybe Object),
    OpEval -> Maybe Text
language :: !(Maybe Text),
    OpEval -> Maybe (HashMap Text Text)
aliases :: !(Maybe (HashMap Text Text)),
    OpEval -> Maybe Int
scriptEvaluationTimeout :: !(Maybe Int),
    OpEval -> SessionID
session :: !SessionID,
    OpEval -> Maybe Bool
manageTransaction :: !(Maybe Bool)
  }
  deriving (Int -> OpEval -> ShowS
[OpEval] -> ShowS
OpEval -> String
(Int -> OpEval -> ShowS)
-> (OpEval -> String) -> ([OpEval] -> ShowS) -> Show OpEval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpEval] -> ShowS
$cshowList :: [OpEval] -> ShowS
show :: OpEval -> String
$cshow :: OpEval -> String
showsPrec :: Int -> OpEval -> ShowS
$cshowsPrec :: Int -> OpEval -> ShowS
Show,OpEval -> OpEval -> Bool
(OpEval -> OpEval -> Bool)
-> (OpEval -> OpEval -> Bool) -> Eq OpEval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpEval -> OpEval -> Bool
$c/= :: OpEval -> OpEval -> Bool
== :: OpEval -> OpEval -> Bool
$c== :: OpEval -> OpEval -> Bool
Eq,(forall x. OpEval -> Rep OpEval x)
-> (forall x. Rep OpEval x -> OpEval) -> Generic OpEval
forall x. Rep OpEval x -> OpEval
forall x. OpEval -> Rep OpEval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpEval x -> OpEval
$cfrom :: forall x. OpEval -> Rep OpEval x
Generic)

instance ToJSON OpEval where
  toJSON :: OpEval -> Value
toJSON = Options -> OpEval -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
GAeson.genericToJSON Options
GAeson.opt
  toEncoding :: OpEval -> Encoding
toEncoding = Options -> OpEval -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
GAeson.genericToEncoding Options
GAeson.opt

instance FromJSON OpEval where
  parseJSON :: Value -> Parser OpEval
parseJSON = Options -> Value -> Parser OpEval
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
GAeson.genericParseJSON Options
GAeson.opt

instance Operation OpEval where
  opProcessor :: OpEval -> Text
opProcessor OpEval
_ = Text
"session"
  opName :: OpEval -> Text
opName OpEval
_ = Text
"eval"
  opArgs :: OpEval -> Object
opArgs = OpEval -> Object
forall a. ToJSON a => a -> Object
GAeson.toObject


data OpClose =
  OpClose
  { OpClose -> Maybe Int
batchSize :: !(Maybe Int),
    OpClose -> SessionID
session :: !SessionID,
    OpClose -> Maybe Bool
force :: !(Maybe Bool)
  }
  deriving (Int -> OpClose -> ShowS
[OpClose] -> ShowS
OpClose -> String
(Int -> OpClose -> ShowS)
-> (OpClose -> String) -> ([OpClose] -> ShowS) -> Show OpClose
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OpClose] -> ShowS
$cshowList :: [OpClose] -> ShowS
show :: OpClose -> String
$cshow :: OpClose -> String
showsPrec :: Int -> OpClose -> ShowS
$cshowsPrec :: Int -> OpClose -> ShowS
Show,OpClose -> OpClose -> Bool
(OpClose -> OpClose -> Bool)
-> (OpClose -> OpClose -> Bool) -> Eq OpClose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OpClose -> OpClose -> Bool
$c/= :: OpClose -> OpClose -> Bool
== :: OpClose -> OpClose -> Bool
$c== :: OpClose -> OpClose -> Bool
Eq,Eq OpClose
Eq OpClose
-> (OpClose -> OpClose -> Ordering)
-> (OpClose -> OpClose -> Bool)
-> (OpClose -> OpClose -> Bool)
-> (OpClose -> OpClose -> Bool)
-> (OpClose -> OpClose -> Bool)
-> (OpClose -> OpClose -> OpClose)
-> (OpClose -> OpClose -> OpClose)
-> Ord OpClose
OpClose -> OpClose -> Bool
OpClose -> OpClose -> Ordering
OpClose -> OpClose -> OpClose
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 :: OpClose -> OpClose -> OpClose
$cmin :: OpClose -> OpClose -> OpClose
max :: OpClose -> OpClose -> OpClose
$cmax :: OpClose -> OpClose -> OpClose
>= :: OpClose -> OpClose -> Bool
$c>= :: OpClose -> OpClose -> Bool
> :: OpClose -> OpClose -> Bool
$c> :: OpClose -> OpClose -> Bool
<= :: OpClose -> OpClose -> Bool
$c<= :: OpClose -> OpClose -> Bool
< :: OpClose -> OpClose -> Bool
$c< :: OpClose -> OpClose -> Bool
compare :: OpClose -> OpClose -> Ordering
$ccompare :: OpClose -> OpClose -> Ordering
$cp1Ord :: Eq OpClose
Ord,(forall x. OpClose -> Rep OpClose x)
-> (forall x. Rep OpClose x -> OpClose) -> Generic OpClose
forall x. Rep OpClose x -> OpClose
forall x. OpClose -> Rep OpClose x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OpClose x -> OpClose
$cfrom :: forall x. OpClose -> Rep OpClose x
Generic)

instance ToJSON OpClose where
  toJSON :: OpClose -> Value
toJSON = Options -> OpClose -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
GAeson.genericToJSON Options
GAeson.opt
  toEncoding :: OpClose -> Encoding
toEncoding = Options -> OpClose -> Encoding
forall a.
(Generic a, GToJSON' Encoding Zero (Rep a)) =>
Options -> a -> Encoding
GAeson.genericToEncoding Options
GAeson.opt

instance FromJSON OpClose where
  parseJSON :: Value -> Parser OpClose
parseJSON = Options -> Value -> Parser OpClose
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
GAeson.genericParseJSON Options
GAeson.opt

instance Operation OpClose where
  opProcessor :: OpClose -> Text
opProcessor OpClose
_ = Text
"session"
  opName :: OpClose -> Text
opName OpClose
_ = Text
"close"
  opArgs :: OpClose -> Object
opArgs = OpClose -> Object
forall a. ToJSON a => a -> Object
GAeson.toObject