{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE 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                                (FromJSON (..), Object, ToJSON (..))
import           Data.HashMap.Strict                       (HashMap)
import           Data.Text                                 (Text)
import           Data.UUID                                 (UUID)
import           GHC.Generics                              (Generic)

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

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

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 (OpEval -> OpEval -> Bool
(OpEval -> OpEval -> Bool)
-> (OpEval -> OpEval -> Bool) -> Eq OpEval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpEval -> OpEval -> Bool
== :: OpEval -> OpEval -> Bool
$c/= :: OpEval -> OpEval -> Bool
/= :: 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
$cfrom :: forall x. OpEval -> Rep OpEval x
from :: forall x. OpEval -> Rep OpEval x
$cto :: forall x. Rep OpEval x -> OpEval
to :: forall x. Rep OpEval x -> OpEval
Generic, 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
$cshowsPrec :: Int -> OpEval -> ShowS
showsPrec :: Int -> OpEval -> ShowS
$cshow :: OpEval -> String
show :: OpEval -> String
$cshowList :: [OpEval] -> ShowS
showList :: [OpEval] -> ShowS
Show)

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 (OpClose -> OpClose -> Bool
(OpClose -> OpClose -> Bool)
-> (OpClose -> OpClose -> Bool) -> Eq OpClose
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: OpClose -> OpClose -> Bool
== :: OpClose -> OpClose -> Bool
$c/= :: OpClose -> OpClose -> Bool
/= :: OpClose -> OpClose -> Bool
Eq, (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
$cfrom :: forall x. OpClose -> Rep OpClose x
from :: forall x. OpClose -> Rep OpClose x
$cto :: forall x. Rep OpClose x -> OpClose
to :: forall x. Rep OpClose x -> OpClose
Generic, 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
$ccompare :: OpClose -> OpClose -> Ordering
compare :: OpClose -> OpClose -> Ordering
$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
>= :: OpClose -> OpClose -> Bool
$cmax :: OpClose -> OpClose -> OpClose
max :: OpClose -> OpClose -> OpClose
$cmin :: OpClose -> OpClose -> OpClose
min :: OpClose -> OpClose -> OpClose
Ord, 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
$cshowsPrec :: Int -> OpClose -> ShowS
showsPrec :: Int -> OpClose -> ShowS
$cshow :: OpClose -> String
show :: OpClose -> String
$cshowList :: [OpClose] -> ShowS
showList :: [OpClose] -> ShowS
Show)

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