{-# 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)

-- | GraphQL HTTP Request Body
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)

-- | GraphQL Response
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