{-# 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
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, 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, Eq 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
Ord, Int -> OpAuthentication -> ShowS
[OpAuthentication] -> ShowS
OpAuthentication -> String
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)

instance ToJSON OpAuthentication where
  toJSON :: OpAuthentication -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
GAeson.genericToJSON Options
GAeson.opt
  toEncoding :: OpAuthentication -> Encoding
toEncoding = 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 = 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 = 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
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. 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, Int -> OpEval -> ShowS
[OpEval] -> ShowS
OpEval -> String
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)

instance ToJSON OpEval where
  toJSON :: OpEval -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
GAeson.genericToJSON Options
GAeson.opt
  toEncoding :: OpEval -> Encoding
toEncoding = 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 = 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 = 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
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, 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, Eq 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
Ord, Int -> OpClose -> ShowS
[OpClose] -> ShowS
OpClose -> String
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)

instance ToJSON OpClose where
  toJSON :: OpClose -> Value
toJSON = forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
GAeson.genericToJSON Options
GAeson.opt
  toEncoding :: OpClose -> Encoding
toEncoding = 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 = 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 = forall a. ToJSON a => a -> Object
GAeson.toObject