{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}
module Data.Morpheus.Types.IO
( GQLRequest (..),
GQLResponse (..),
JSONResponse (..),
renderResponse,
MapAPI (..),
)
where
import Data.Aeson
( (.:?),
(.=),
FromJSON (..),
ToJSON (..),
encode,
object,
pairs,
withObject,
)
import qualified Data.Aeson as Aeson
( Value (..),
)
import Data.Aeson.Internal
( formatError,
ifromJSON,
)
import Data.Aeson.Parser
( eitherDecodeWith,
jsonNoDup,
)
import qualified Data.ByteString.Lazy.Char8 as LB
( ByteString,
fromStrict,
toStrict,
)
import qualified Data.HashMap.Lazy as LH
import Data.Morpheus.Error.Utils (badRequestError)
import Data.Morpheus.Types.Internal.AST
( FieldName,
GQLError (..),
ValidValue,
)
import Data.Morpheus.Types.Internal.Resolving.Core
( Failure (..),
Result (..),
)
import qualified Data.Text.Lazy as LT
( Text,
fromStrict,
toStrict,
)
import Data.Text.Lazy.Encoding
( decodeUtf8,
encodeUtf8,
)
import Relude hiding
( decodeUtf8,
encodeUtf8,
)
decodeNoDup :: Failure String m => LB.ByteString -> m GQLRequest
decodeNoDup :: ByteString -> m GQLRequest
decodeNoDup ByteString
str = case Parser Value
-> (Value -> IResult GQLRequest)
-> ByteString
-> Either (JSONPath, String) GQLRequest
forall a.
Parser Value
-> (Value -> IResult a)
-> ByteString
-> Either (JSONPath, String) a
eitherDecodeWith Parser Value
jsonNoDup Value -> IResult GQLRequest
forall a. FromJSON a => Value -> IResult a
ifromJSON ByteString
str of
Left (JSONPath
path, String
x) -> String -> m GQLRequest
forall error (f :: * -> *) v. Failure error f => error -> f v
failure (String -> m GQLRequest) -> String -> m GQLRequest
forall a b. (a -> b) -> a -> b
$ JSONPath -> String -> String
formatError JSONPath
path String
x
Right GQLRequest
value -> GQLRequest -> m GQLRequest
forall (f :: * -> *) a. Applicative f => a -> f a
pure GQLRequest
value
class MapAPI a b where
mapAPI :: Applicative m => (GQLRequest -> m GQLResponse) -> a -> m b
instance MapAPI GQLRequest GQLResponse where
mapAPI :: (GQLRequest -> m GQLResponse) -> GQLRequest -> m GQLResponse
mapAPI GQLRequest -> m GQLResponse
f = GQLRequest -> m GQLResponse
f
instance MapAPI LB.ByteString LB.ByteString where
mapAPI :: (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString
mapAPI GQLRequest -> m GQLResponse
api ByteString
request = case ByteString -> Either String GQLRequest
forall (m :: * -> *).
Failure String m =>
ByteString -> m GQLRequest
decodeNoDup ByteString
request of
Left String
aesonError -> ByteString -> m ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> m ByteString) -> ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ String -> ByteString
badRequestError String
aesonError
Right GQLRequest
req -> GQLResponse -> ByteString
forall a. ToJSON a => a -> ByteString
encode (GQLResponse -> ByteString) -> m GQLResponse -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GQLRequest -> m GQLResponse
api GQLRequest
req
instance MapAPI LT.Text LT.Text where
mapAPI :: (GQLRequest -> m GQLResponse) -> Text -> m Text
mapAPI GQLRequest -> m GQLResponse
api = (ByteString -> Text) -> m ByteString -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> Text
decodeUtf8 (m ByteString -> m Text)
-> (Text -> m ByteString) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString
forall a b (m :: * -> *).
(MapAPI a b, Applicative m) =>
(GQLRequest -> m GQLResponse) -> a -> m b
mapAPI GQLRequest -> m GQLResponse
api (ByteString -> m ByteString)
-> (Text -> ByteString) -> Text -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8
instance MapAPI ByteString ByteString where
mapAPI :: (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString
mapAPI GQLRequest -> m GQLResponse
api = (ByteString -> ByteString) -> m ByteString -> m ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ByteString -> ByteString
LB.toStrict (m ByteString -> m ByteString)
-> (ByteString -> m ByteString) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GQLRequest -> m GQLResponse) -> ByteString -> m ByteString
forall a b (m :: * -> *).
(MapAPI a b, Applicative m) =>
(GQLRequest -> m GQLResponse) -> a -> m b
mapAPI GQLRequest -> m GQLResponse
api (ByteString -> m ByteString)
-> (ByteString -> ByteString) -> ByteString -> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LB.fromStrict
instance MapAPI Text Text where
mapAPI :: (GQLRequest -> m GQLResponse) -> Text -> m Text
mapAPI GQLRequest -> m GQLResponse
api = (Text -> Text) -> m Text -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
LT.toStrict (m Text -> m Text) -> (Text -> m Text) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GQLRequest -> m GQLResponse) -> Text -> m Text
forall a b (m :: * -> *).
(MapAPI a b, Applicative m) =>
(GQLRequest -> m GQLResponse) -> a -> m b
mapAPI GQLRequest -> m GQLResponse
api (Text -> m Text) -> (Text -> Text) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
LT.fromStrict
renderResponse :: Result e ValidValue -> GQLResponse
renderResponse :: Result e ValidValue -> GQLResponse
renderResponse (Failure GQLErrors
errors) = GQLErrors -> GQLResponse
Errors ((GQLError -> [Position]) -> GQLErrors -> GQLErrors
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn GQLError -> [Position]
locations GQLErrors
errors)
renderResponse Success {ValidValue
result :: forall events a. Result events a -> a
result :: ValidValue
result} = ValidValue -> GQLResponse
Data ValidValue
result
instance FromJSON a => FromJSON (JSONResponse a) where
parseJSON :: Value -> Parser (JSONResponse a)
parseJSON = String
-> (Object -> Parser (JSONResponse a))
-> Value
-> Parser (JSONResponse a)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"JSONResponse" Object -> Parser (JSONResponse a)
forall a. FromJSON a => Object -> Parser (JSONResponse a)
objectParser
where
objectParser :: Object -> Parser (JSONResponse a)
objectParser Object
o = Maybe a -> Maybe GQLErrors -> JSONResponse a
forall a. Maybe a -> Maybe GQLErrors -> JSONResponse a
JSONResponse (Maybe a -> Maybe GQLErrors -> JSONResponse a)
-> Parser (Maybe a) -> Parser (Maybe GQLErrors -> JSONResponse a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe a)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"data" Parser (Maybe GQLErrors -> JSONResponse a)
-> Parser (Maybe GQLErrors) -> Parser (JSONResponse a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe GQLErrors)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"errors"
data JSONResponse a = JSONResponse
{ JSONResponse a -> Maybe a
responseData :: Maybe a,
JSONResponse a -> Maybe GQLErrors
responseErrors :: Maybe [GQLError]
}
deriving ((forall x. JSONResponse a -> Rep (JSONResponse a) x)
-> (forall x. Rep (JSONResponse a) x -> JSONResponse a)
-> Generic (JSONResponse a)
forall x. Rep (JSONResponse a) x -> JSONResponse a
forall x. JSONResponse a -> Rep (JSONResponse a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (JSONResponse a) x -> JSONResponse a
forall a x. JSONResponse a -> Rep (JSONResponse a) x
$cto :: forall a x. Rep (JSONResponse a) x -> JSONResponse a
$cfrom :: forall a x. JSONResponse a -> Rep (JSONResponse a) x
Generic, Int -> JSONResponse a -> String -> String
[JSONResponse a] -> String -> String
JSONResponse a -> String
(Int -> JSONResponse a -> String -> String)
-> (JSONResponse a -> String)
-> ([JSONResponse a] -> String -> String)
-> Show (JSONResponse a)
forall a. Show a => Int -> JSONResponse a -> String -> String
forall a. Show a => [JSONResponse a] -> String -> String
forall a. Show a => JSONResponse a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [JSONResponse a] -> String -> String
$cshowList :: forall a. Show a => [JSONResponse a] -> String -> String
show :: JSONResponse a -> String
$cshow :: forall a. Show a => JSONResponse a -> String
showsPrec :: Int -> JSONResponse a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> JSONResponse a -> String -> String
Show, [JSONResponse a] -> Encoding
[JSONResponse a] -> Value
JSONResponse a -> Encoding
JSONResponse a -> Value
(JSONResponse a -> Value)
-> (JSONResponse a -> Encoding)
-> ([JSONResponse a] -> Value)
-> ([JSONResponse a] -> Encoding)
-> ToJSON (JSONResponse a)
forall a. ToJSON a => [JSONResponse a] -> Encoding
forall a. ToJSON a => [JSONResponse a] -> Value
forall a. ToJSON a => JSONResponse a -> Encoding
forall a. ToJSON a => JSONResponse a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [JSONResponse a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [JSONResponse a] -> Encoding
toJSONList :: [JSONResponse a] -> Value
$ctoJSONList :: forall a. ToJSON a => [JSONResponse a] -> Value
toEncoding :: JSONResponse a -> Encoding
$ctoEncoding :: forall a. ToJSON a => JSONResponse a -> Encoding
toJSON :: JSONResponse a -> Value
$ctoJSON :: forall a. ToJSON a => JSONResponse a -> Value
ToJSON)
data GQLRequest = GQLRequest
{ GQLRequest -> Maybe FieldName
operationName :: Maybe FieldName,
GQLRequest -> Text
query :: Text,
GQLRequest -> Maybe Value
variables :: Maybe Aeson.Value
}
deriving (Int -> GQLRequest -> String -> String
[GQLRequest] -> String -> String
GQLRequest -> String
(Int -> GQLRequest -> String -> String)
-> (GQLRequest -> String)
-> ([GQLRequest] -> String -> String)
-> Show GQLRequest
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GQLRequest] -> String -> String
$cshowList :: [GQLRequest] -> String -> String
show :: GQLRequest -> String
$cshow :: GQLRequest -> String
showsPrec :: Int -> GQLRequest -> String -> String
$cshowsPrec :: Int -> GQLRequest -> String -> String
Show, (forall x. GQLRequest -> Rep GQLRequest x)
-> (forall x. Rep GQLRequest x -> GQLRequest) -> Generic GQLRequest
forall x. Rep GQLRequest x -> GQLRequest
forall x. GQLRequest -> Rep GQLRequest x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GQLRequest x -> GQLRequest
$cfrom :: forall x. GQLRequest -> Rep GQLRequest x
Generic, Value -> Parser [GQLRequest]
Value -> Parser GQLRequest
(Value -> Parser GQLRequest)
-> (Value -> Parser [GQLRequest]) -> FromJSON GQLRequest
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [GQLRequest]
$cparseJSONList :: Value -> Parser [GQLRequest]
parseJSON :: Value -> Parser GQLRequest
$cparseJSON :: Value -> Parser GQLRequest
FromJSON, [GQLRequest] -> Encoding
[GQLRequest] -> Value
GQLRequest -> Encoding
GQLRequest -> Value
(GQLRequest -> Value)
-> (GQLRequest -> Encoding)
-> ([GQLRequest] -> Value)
-> ([GQLRequest] -> Encoding)
-> ToJSON GQLRequest
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [GQLRequest] -> Encoding
$ctoEncodingList :: [GQLRequest] -> Encoding
toJSONList :: [GQLRequest] -> Value
$ctoJSONList :: [GQLRequest] -> Value
toEncoding :: GQLRequest -> Encoding
$ctoEncoding :: GQLRequest -> Encoding
toJSON :: GQLRequest -> Value
$ctoJSON :: GQLRequest -> Value
ToJSON)
data GQLResponse
= Data ValidValue
| Errors [GQLError]
deriving (Int -> GQLResponse -> String -> String
[GQLResponse] -> String -> String
GQLResponse -> String
(Int -> GQLResponse -> String -> String)
-> (GQLResponse -> String)
-> ([GQLResponse] -> String -> String)
-> Show GQLResponse
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [GQLResponse] -> String -> String
$cshowList :: [GQLResponse] -> String -> String
show :: GQLResponse -> String
$cshow :: GQLResponse -> String
showsPrec :: Int -> GQLResponse -> String -> String
$cshowsPrec :: Int -> GQLResponse -> String -> String
Show, (forall x. GQLResponse -> Rep GQLResponse x)
-> (forall x. Rep GQLResponse x -> GQLResponse)
-> Generic GQLResponse
forall x. Rep GQLResponse x -> GQLResponse
forall x. GQLResponse -> Rep GQLResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GQLResponse x -> GQLResponse
$cfrom :: forall x. GQLResponse -> Rep GQLResponse x
Generic)
instance FromJSON GQLResponse where
parseJSON :: Value -> Parser GQLResponse
parseJSON (Aeson.Object Object
hm) = case Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
LH.toList Object
hm of
[(Text
"data", Value
value)] -> ValidValue -> GQLResponse
Data (ValidValue -> GQLResponse)
-> Parser ValidValue -> Parser GQLResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ValidValue
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
[(Text
"errors", Value
value)] -> GQLErrors -> GQLResponse
Errors (GQLErrors -> GQLResponse)
-> Parser GQLErrors -> Parser GQLResponse
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GQLErrors
forall a. FromJSON a => Value -> Parser a
parseJSON Value
value
[(Text, Value)]
_ -> String -> Parser GQLResponse
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid GraphQL Response"
parseJSON Value
_ = String -> Parser GQLResponse
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid GraphQL Response"
instance ToJSON GQLResponse where
toJSON :: GQLResponse -> Value
toJSON (Data ValidValue
gqlData) = [(Text, Value)] -> Value
object [Text
"data" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ValidValue -> Value
forall a. ToJSON a => a -> Value
toJSON ValidValue
gqlData]
toJSON (Errors GQLErrors
errors) = [(Text, Value)] -> Value
object [Text
"errors" Text -> Value -> (Text, Value)
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GQLErrors -> Value
forall a. ToJSON a => a -> Value
toJSON GQLErrors
errors]
toEncoding :: GQLResponse -> Encoding
toEncoding (Data ValidValue
_data) = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Text
"data" Text -> ValidValue -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= ValidValue
_data
toEncoding (Errors GQLErrors
_errors) = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ Text
"errors" Text -> GQLErrors -> Series
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= GQLErrors
_errors