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

import           Data.Aeson                                (FromJSON (..), Object, ToJSON (..))
import           Data.HashMap.Strict                       (HashMap)
import           Data.Text                                 (Text)
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
""
  opName :: OpAuthentication -> Text
opName OpAuthentication
_ = Text
"authentication"
  opArgs :: OpAuthentication -> Object
opArgs = forall a. ToJSON a => a -> Object
GAeson.toObject

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)
      }
  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
""
  opName :: OpEval -> Text
opName OpEval
_ = Text
"eval"
  opArgs :: OpEval -> Object
opArgs = forall a. ToJSON a => a -> Object
GAeson.toObject