2018-07-20 10:22:46 +03:00
|
|
|
module Hasura.GraphQL.Transport.HTTP.Protocol
|
2019-04-17 12:48:41 +03:00
|
|
|
( GQLReq(..)
|
|
|
|
, GQLReqUnparsed
|
|
|
|
, GQLReqParsed
|
|
|
|
, toParsed
|
|
|
|
, GQLQueryText
|
|
|
|
, GQLExecDoc(..)
|
2018-07-20 10:22:46 +03:00
|
|
|
, OperationName(..)
|
|
|
|
, VariableValues
|
|
|
|
, encodeGQErr
|
|
|
|
, encodeGQResp
|
|
|
|
, GQResp(..)
|
|
|
|
, isExecError
|
|
|
|
) where
|
|
|
|
|
2019-03-18 19:22:21 +03:00
|
|
|
import Hasura.EncJSON
|
2019-04-17 12:48:41 +03:00
|
|
|
import Hasura.GraphQL.Utils
|
2018-07-20 10:22:46 +03:00
|
|
|
import Hasura.Prelude
|
2019-03-18 19:22:21 +03:00
|
|
|
import Hasura.RQL.Types
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
import qualified Data.Aeson as J
|
|
|
|
import qualified Data.Aeson.Casing as J
|
|
|
|
import qualified Data.Aeson.TH as J
|
|
|
|
import qualified Data.ByteString.Lazy as BL
|
|
|
|
import qualified Data.HashMap.Strict as Map
|
|
|
|
import qualified Language.GraphQL.Draft.Parser as G
|
|
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
newtype GQLExecDoc
|
|
|
|
= GQLExecDoc { unGQLExecDoc :: [G.ExecutableDefinition] }
|
|
|
|
deriving (Ord, Show, Eq, Hashable)
|
2018-07-20 10:22:46 +03:00
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
instance J.FromJSON GQLExecDoc where
|
|
|
|
parseJSON = J.withText "GQLExecDoc" $ \t ->
|
2018-07-20 10:22:46 +03:00
|
|
|
case G.parseExecutableDoc t of
|
|
|
|
Left _ -> fail "parsing the graphql query failed"
|
2019-04-17 12:48:41 +03:00
|
|
|
Right q -> return $ GQLExecDoc $ G.getExecutableDefinitions q
|
2018-07-20 10:22:46 +03:00
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
instance J.ToJSON GQLExecDoc where
|
2018-07-20 10:22:46 +03:00
|
|
|
-- TODO, add pretty printer in graphql-parser
|
2019-04-17 12:48:41 +03:00
|
|
|
toJSON _ = J.String "toJSON not implemented for GQLExecDoc"
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
newtype OperationName
|
|
|
|
= OperationName { _unOperationName :: G.Name }
|
2019-04-17 12:48:41 +03:00
|
|
|
deriving (Ord, Show, Eq, Hashable, J.ToJSON)
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
instance J.FromJSON OperationName where
|
|
|
|
parseJSON v = OperationName . G.Name <$> J.parseJSON v
|
|
|
|
|
|
|
|
type VariableValues = Map.HashMap G.Variable J.Value
|
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
data GQLReq a
|
|
|
|
= GQLReq
|
2018-07-20 10:22:46 +03:00
|
|
|
{ _grOperationName :: !(Maybe OperationName)
|
2019-04-17 12:48:41 +03:00
|
|
|
, _grQuery :: !a
|
2018-07-20 10:22:46 +03:00
|
|
|
, _grVariables :: !(Maybe VariableValues)
|
|
|
|
} deriving (Show, Eq, Generic)
|
|
|
|
|
|
|
|
$(J.deriveJSON (J.aesonDrop 3 J.camelCase){J.omitNothingFields=True}
|
2019-04-17 12:48:41 +03:00
|
|
|
''GQLReq
|
2018-07-20 10:22:46 +03:00
|
|
|
)
|
|
|
|
|
2019-04-17 12:48:41 +03:00
|
|
|
instance (Hashable a) => Hashable (GQLReq a)
|
|
|
|
|
|
|
|
newtype GQLQueryText
|
|
|
|
= GQLQueryText
|
|
|
|
{ _unGQLQueryText :: Text
|
|
|
|
} deriving (Show, Eq, J.FromJSON, J.ToJSON, Hashable)
|
|
|
|
|
|
|
|
type GQLReqUnparsed = GQLReq GQLQueryText
|
|
|
|
type GQLReqParsed = GQLReq GQLExecDoc
|
|
|
|
|
|
|
|
toParsed :: (MonadError QErr m ) => GQLReqUnparsed -> m GQLReqParsed
|
|
|
|
toParsed req = case G.parseExecutableDoc gqlText of
|
|
|
|
Left _ -> withPathK "query" $ throwVE "not a valid graphql query"
|
|
|
|
Right a -> return $ req { _grQuery = GQLExecDoc $ G.getExecutableDefinitions a }
|
|
|
|
where
|
|
|
|
gqlText = _unGQLQueryText $ _grQuery req
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
encodeGQErr :: Bool -> QErr -> J.Value
|
|
|
|
encodeGQErr includeInternal qErr =
|
2018-12-04 16:37:38 +03:00
|
|
|
J.object [ "errors" J..= [encodeGQLErr includeInternal qErr]]
|
2018-07-20 10:22:46 +03:00
|
|
|
|
|
|
|
data GQResp
|
2019-03-18 19:22:21 +03:00
|
|
|
= GQSuccess !BL.ByteString
|
|
|
|
| GQPreExecError ![J.Value]
|
|
|
|
| GQExecError ![J.Value]
|
2018-07-20 10:22:46 +03:00
|
|
|
deriving (Show, Eq)
|
|
|
|
|
|
|
|
isExecError :: GQResp -> Bool
|
|
|
|
isExecError = \case
|
|
|
|
GQExecError _ -> True
|
|
|
|
_ -> False
|
|
|
|
|
2019-03-18 19:22:21 +03:00
|
|
|
encodeGQResp :: GQResp -> EncJSON
|
2018-07-20 10:22:46 +03:00
|
|
|
encodeGQResp gqResp =
|
2019-03-18 19:22:21 +03:00
|
|
|
encJFromAssocList $ case gqResp of
|
|
|
|
GQSuccess r -> [("data", encJFromLBS r)]
|
|
|
|
GQPreExecError e -> [("errors", encJFromJValue e)]
|
|
|
|
GQExecError e -> [("data", "null"), ("errors", encJFromJValue e)]
|