{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: Network.Greskell.WebSocket.Response
-- Description: Response from Gremlin Server
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
--
module Network.Greskell.WebSocket.Response
    ( -- * ResponseMessage
      ResponseMessage (..)
      -- * ResponseStatus
    , ResponseStatus (..)
      -- * ResponseResult
    , ResponseResult (..)
      -- * ResponseCode
    , ResponseCode (..)
    , codeToInt
    , codeFromInt
    , isTerminating
    , isSuccess
    , isClientSideError
    , isServerSideError
    ) where

import           Control.Applicative           ((<$>), (<*>))
import           Data.Aeson                    (FromJSON (..), Object, ToJSON (..),
                                                Value (Number, Object), defaultOptions,
                                                genericParseJSON)
import           Data.Greskell.GraphSON        (FromGraphSON (..), GValueBody (..), gsonValue,
                                                parseUnwrapAll, (.:))
import           Data.Greskell.GraphSON.GValue (gValueBody)
import           Data.Text                     (Text)
import           Data.UUID                     (UUID)
import           GHC.Generics                  (Generic)



-- | Response status code
data ResponseCode = Success | NoContent | PartialContent | Unauthorized | Authenticate | MalformedRequest | InvalidRequestArguments | ServerError | ScriptEvaluationError | ServerTimeout | ServerSerializationError deriving
    ( ResponseCode
forall a. a -> a -> Bounded a
maxBound :: ResponseCode
$cmaxBound :: ResponseCode
minBound :: ResponseCode
$cminBound :: ResponseCode
Bounded
    , Int -> ResponseCode
ResponseCode -> Int
ResponseCode -> [ResponseCode]
ResponseCode -> ResponseCode
ResponseCode -> ResponseCode -> [ResponseCode]
ResponseCode -> ResponseCode -> ResponseCode -> [ResponseCode]
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 :: ResponseCode -> ResponseCode -> ResponseCode -> [ResponseCode]
$cenumFromThenTo :: ResponseCode -> ResponseCode -> ResponseCode -> [ResponseCode]
enumFromTo :: ResponseCode -> ResponseCode -> [ResponseCode]
$cenumFromTo :: ResponseCode -> ResponseCode -> [ResponseCode]
enumFromThen :: ResponseCode -> ResponseCode -> [ResponseCode]
$cenumFromThen :: ResponseCode -> ResponseCode -> [ResponseCode]
enumFrom :: ResponseCode -> [ResponseCode]
$cenumFrom :: ResponseCode -> [ResponseCode]
fromEnum :: ResponseCode -> Int
$cfromEnum :: ResponseCode -> Int
toEnum :: Int -> ResponseCode
$ctoEnum :: Int -> ResponseCode
pred :: ResponseCode -> ResponseCode
$cpred :: ResponseCode -> ResponseCode
succ :: ResponseCode -> ResponseCode
$csucc :: ResponseCode -> ResponseCode
Enum
    , ResponseCode -> ResponseCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseCode -> ResponseCode -> Bool
$c/= :: ResponseCode -> ResponseCode -> Bool
== :: ResponseCode -> ResponseCode -> Bool
$c== :: ResponseCode -> ResponseCode -> Bool
Eq
    , Eq ResponseCode
ResponseCode -> ResponseCode -> Bool
ResponseCode -> ResponseCode -> Ordering
ResponseCode -> ResponseCode -> ResponseCode
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 :: ResponseCode -> ResponseCode -> ResponseCode
$cmin :: ResponseCode -> ResponseCode -> ResponseCode
max :: ResponseCode -> ResponseCode -> ResponseCode
$cmax :: ResponseCode -> ResponseCode -> ResponseCode
>= :: ResponseCode -> ResponseCode -> Bool
$c>= :: ResponseCode -> ResponseCode -> Bool
> :: ResponseCode -> ResponseCode -> Bool
$c> :: ResponseCode -> ResponseCode -> Bool
<= :: ResponseCode -> ResponseCode -> Bool
$c<= :: ResponseCode -> ResponseCode -> Bool
< :: ResponseCode -> ResponseCode -> Bool
$c< :: ResponseCode -> ResponseCode -> Bool
compare :: ResponseCode -> ResponseCode -> Ordering
$ccompare :: ResponseCode -> ResponseCode -> Ordering
Ord
    , Int -> ResponseCode -> ShowS
[ResponseCode] -> ShowS
ResponseCode -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResponseCode] -> ShowS
$cshowList :: [ResponseCode] -> ShowS
show :: ResponseCode -> [Char]
$cshow :: ResponseCode -> [Char]
showsPrec :: Int -> ResponseCode -> ShowS
$cshowsPrec :: Int -> ResponseCode -> ShowS
Show
    )

codeToInt :: ResponseCode -> Int
codeToInt :: ResponseCode -> Int
codeToInt ResponseCode
c = case ResponseCode
c of
  ResponseCode
Success                  -> Int
200
  ResponseCode
NoContent                -> Int
204
  ResponseCode
PartialContent           -> Int
206
  ResponseCode
Unauthorized             -> Int
401
  ResponseCode
Authenticate             -> Int
407
  ResponseCode
MalformedRequest         -> Int
498
  ResponseCode
InvalidRequestArguments  -> Int
499
  ResponseCode
ServerError              -> Int
500
  ResponseCode
ScriptEvaluationError    -> Int
597
  ResponseCode
ServerTimeout            -> Int
598
  ResponseCode
ServerSerializationError -> Int
599

codeFromInt :: Int -> Maybe ResponseCode
codeFromInt :: Int -> Maybe ResponseCode
codeFromInt Int
i = case Int
i of
  Int
200 -> forall a. a -> Maybe a
Just ResponseCode
Success
  Int
204 -> forall a. a -> Maybe a
Just ResponseCode
NoContent
  Int
206 -> forall a. a -> Maybe a
Just ResponseCode
PartialContent
  Int
401 -> forall a. a -> Maybe a
Just ResponseCode
Unauthorized
  Int
407 -> forall a. a -> Maybe a
Just ResponseCode
Authenticate
  Int
498 -> forall a. a -> Maybe a
Just ResponseCode
MalformedRequest
  Int
499 -> forall a. a -> Maybe a
Just ResponseCode
InvalidRequestArguments
  Int
500 -> forall a. a -> Maybe a
Just ResponseCode
ServerError
  Int
597 -> forall a. a -> Maybe a
Just ResponseCode
ScriptEvaluationError
  Int
598 -> forall a. a -> Maybe a
Just ResponseCode
ServerTimeout
  Int
599 -> forall a. a -> Maybe a
Just ResponseCode
ServerSerializationError
  Int
_   -> forall a. Maybe a
Nothing

-- | Returns 'True' if the 'ResponseCode' is a terminating code.
isTerminating :: ResponseCode -> Bool
isTerminating :: ResponseCode -> Bool
isTerminating ResponseCode
PartialContent = Bool
False
isTerminating ResponseCode
_              = Bool
True

isCodeClass :: Int -> ResponseCode -> Bool
isCodeClass :: Int -> ResponseCode -> Bool
isCodeClass Int
n ResponseCode
c = (ResponseCode -> Int
codeToInt ResponseCode
c forall a. Integral a => a -> a -> a
`div` Int
100) forall a. Eq a => a -> a -> Bool
== Int
n

-- | Returns 'True' if the 'ResponseCode' is a success.
isSuccess :: ResponseCode -> Bool
isSuccess :: ResponseCode -> Bool
isSuccess = Int -> ResponseCode -> Bool
isCodeClass Int
2

-- | Returns 'True' if the 'ResponseCode' is a client-side failure.
isClientSideError :: ResponseCode -> Bool
isClientSideError :: ResponseCode -> Bool
isClientSideError = Int -> ResponseCode -> Bool
isCodeClass Int
4

-- | Returns 'True' if the 'ResponseCode' is a server-side failure.
isServerSideError :: ResponseCode -> Bool
isServerSideError :: ResponseCode -> Bool
isServerSideError = Int -> ResponseCode -> Bool
isCodeClass Int
5

instance FromJSON ResponseCode where
  parseJSON :: Value -> Parser ResponseCode
parseJSON (Number Scientific
n) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall {a}. Parser a
err forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Int -> Maybe ResponseCode
codeFromInt forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
floor Scientific
n
    where
      err :: Parser a
err = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Unknown response code: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Scientific
n)
  parseJSON Value
v = forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Expected Number, but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Value
v)

instance FromGraphSON ResponseCode where
  parseGraphSON :: GValue -> Parser ResponseCode
parseGraphSON = forall a. FromJSON a => GValue -> Parser a
parseUnwrapAll

instance ToJSON ResponseCode where
  toJSON :: ResponseCode -> Value
toJSON = forall a. ToJSON a => a -> Value
toJSON forall b c a. (b -> c) -> (a -> b) -> a -> c
. ResponseCode -> Int
codeToInt

-- | \"status\" field.
data ResponseStatus
  = ResponseStatus
      { ResponseStatus -> ResponseCode
code       :: !ResponseCode
      , ResponseStatus -> Text
message    :: !Text
      , ResponseStatus -> Object
attributes :: !Object
      }
  deriving (ResponseStatus -> ResponseStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseStatus -> ResponseStatus -> Bool
$c/= :: ResponseStatus -> ResponseStatus -> Bool
== :: ResponseStatus -> ResponseStatus -> Bool
$c== :: ResponseStatus -> ResponseStatus -> Bool
Eq, forall x. Rep ResponseStatus x -> ResponseStatus
forall x. ResponseStatus -> Rep ResponseStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ResponseStatus x -> ResponseStatus
$cfrom :: forall x. ResponseStatus -> Rep ResponseStatus x
Generic, Int -> ResponseStatus -> ShowS
[ResponseStatus] -> ShowS
ResponseStatus -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResponseStatus] -> ShowS
$cshowList :: [ResponseStatus] -> ShowS
show :: ResponseStatus -> [Char]
$cshow :: ResponseStatus -> [Char]
showsPrec :: Int -> ResponseStatus -> ShowS
$cshowsPrec :: Int -> ResponseStatus -> ShowS
Show)

instance FromJSON ResponseStatus where
  parseJSON :: Value -> Parser ResponseStatus
parseJSON Value
v = forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance FromGraphSON ResponseStatus where
  parseGraphSON :: GValue -> Parser ResponseStatus
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GObject KeyMap GValue
o ->
      ResponseCode -> Text -> Object -> ResponseStatus
ResponseStatus
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap GValue
o forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"code"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap GValue
o forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"message"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap GValue
o forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"attributes"
    GValueBody
gb -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Expected GObject, but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show GValueBody
gb)


-- | \"result\" field.
data ResponseResult s
  = ResponseResult
      { forall s. ResponseResult s -> s
resultData :: !s
        -- ^ \"data\" field.
      , forall s. ResponseResult s -> Object
meta       :: !Object
      }
  deriving (ResponseResult s -> ResponseResult s -> Bool
forall s. Eq s => ResponseResult s -> ResponseResult s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseResult s -> ResponseResult s -> Bool
$c/= :: forall s. Eq s => ResponseResult s -> ResponseResult s -> Bool
== :: ResponseResult s -> ResponseResult s -> Bool
$c== :: forall s. Eq s => ResponseResult s -> ResponseResult s -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (ResponseResult s) x -> ResponseResult s
forall s x. ResponseResult s -> Rep (ResponseResult s) x
$cto :: forall s x. Rep (ResponseResult s) x -> ResponseResult s
$cfrom :: forall s x. ResponseResult s -> Rep (ResponseResult s) x
Generic, Int -> ResponseResult s -> ShowS
forall s. Show s => Int -> ResponseResult s -> ShowS
forall s. Show s => [ResponseResult s] -> ShowS
forall s. Show s => ResponseResult s -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResponseResult s] -> ShowS
$cshowList :: forall s. Show s => [ResponseResult s] -> ShowS
show :: ResponseResult s -> [Char]
$cshow :: forall s. Show s => ResponseResult s -> [Char]
showsPrec :: Int -> ResponseResult s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> ResponseResult s -> ShowS
Show)

instance FromGraphSON s => FromJSON (ResponseResult s) where
  parseJSON :: Value -> Parser (ResponseResult s)
parseJSON Value
v = forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance FromGraphSON s => FromGraphSON (ResponseResult s) where
  parseGraphSON :: GValue -> Parser (ResponseResult s)
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GObject KeyMap GValue
o ->
      forall s. s -> Object -> ResponseResult s
ResponseResult
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyMap GValue
o forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"data"
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> KeyMap GValue
o forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"meta"
    GValueBody
gb -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Expected GObject, but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show GValueBody
gb)

instance Functor ResponseResult where
  fmap :: forall a b. (a -> b) -> ResponseResult a -> ResponseResult b
fmap a -> b
f ResponseResult a
rr = ResponseResult a
rr { resultData :: b
resultData = a -> b
f forall a b. (a -> b) -> a -> b
$ forall s. ResponseResult s -> s
resultData ResponseResult a
rr }

-- | ResponseMessage object from Gremlin Server. See
-- <http://tinkerpop.apache.org/docs/current/dev/provider/>.
--
-- Type @s@ is the type of the response data.
data ResponseMessage s
  = ResponseMessage
      { forall s. ResponseMessage s -> UUID
requestId :: !UUID
      , forall s. ResponseMessage s -> ResponseStatus
status    :: !ResponseStatus
      , forall s. ResponseMessage s -> ResponseResult s
result    :: !(ResponseResult s)
      }
  deriving (ResponseMessage s -> ResponseMessage s -> Bool
forall s. Eq s => ResponseMessage s -> ResponseMessage s -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ResponseMessage s -> ResponseMessage s -> Bool
$c/= :: forall s. Eq s => ResponseMessage s -> ResponseMessage s -> Bool
== :: ResponseMessage s -> ResponseMessage s -> Bool
$c== :: forall s. Eq s => ResponseMessage s -> ResponseMessage s -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall s x. Rep (ResponseMessage s) x -> ResponseMessage s
forall s x. ResponseMessage s -> Rep (ResponseMessage s) x
$cto :: forall s x. Rep (ResponseMessage s) x -> ResponseMessage s
$cfrom :: forall s x. ResponseMessage s -> Rep (ResponseMessage s) x
Generic, Int -> ResponseMessage s -> ShowS
forall s. Show s => Int -> ResponseMessage s -> ShowS
forall s. Show s => [ResponseMessage s] -> ShowS
forall s. Show s => ResponseMessage s -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ResponseMessage s] -> ShowS
$cshowList :: forall s. Show s => [ResponseMessage s] -> ShowS
show :: ResponseMessage s -> [Char]
$cshow :: forall s. Show s => ResponseMessage s -> [Char]
showsPrec :: Int -> ResponseMessage s -> ShowS
$cshowsPrec :: forall s. Show s => Int -> ResponseMessage s -> ShowS
Show)

instance FromGraphSON s => FromJSON (ResponseMessage s) where
  parseJSON :: Value -> Parser (ResponseMessage s)
parseJSON Value
v = forall a. FromGraphSON a => GValue -> Parser a
parseGraphSON forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromJSON a => Value -> Parser a
parseJSON Value
v

instance FromGraphSON s => FromGraphSON (ResponseMessage s) where
  parseGraphSON :: GValue -> Parser (ResponseMessage s)
parseGraphSON GValue
gv = case GValue -> GValueBody
gValueBody GValue
gv of
    GObject KeyMap GValue
o ->
      forall s.
UUID -> ResponseStatus -> ResponseResult s -> ResponseMessage s
ResponseMessage
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyMap GValue
o forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"requestId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap GValue
o forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"status")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (KeyMap GValue
o forall a. FromGraphSON a => KeyMap GValue -> Key -> Parser a
.: Key
"result")
    GValueBody
gb -> forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char]
"Expected GObject, but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show GValueBody
gb)

instance Functor ResponseMessage where
  fmap :: forall a b. (a -> b) -> ResponseMessage a -> ResponseMessage b
fmap a -> b
f ResponseMessage a
rm = ResponseMessage a
rm { result :: ResponseResult b
result = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall a b. (a -> b) -> a -> b
$ forall s. ResponseMessage s -> ResponseResult s
result ResponseMessage a
rm }