From b3ac563f4139783bf1ea70dc333cf861e1d80689 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Sun, 6 Oct 2019 23:19:05 +0530 Subject: [PATCH 01/62] basic doc for actions --- docs/graphql/manual/actions/index.rst | 115 ++++++++++++++++++++++++++ docs/graphql/manual/index.rst | 3 +- 2 files changed, 117 insertions(+), 1 deletion(-) create mode 100644 docs/graphql/manual/actions/index.rst diff --git a/docs/graphql/manual/actions/index.rst b/docs/graphql/manual/actions/index.rst new file mode 100644 index 0000000000000..24ef86102a072 --- /dev/null +++ b/docs/graphql/manual/actions/index.rst @@ -0,0 +1,115 @@ +Actions +======= + +.. contents:: Table of contents + :backlinks: none + :depth: 1 + :local: + +Actions are custom mutations that can be added to graphql-engine to handle various use cases such as validation, complex business logic etc. + +When the permissions system isn't enough to specify the required constraints, you would typically add such mutation through a remote schema, however actions can handle these use cases better because of the following reasons: + +1. Actions let you return graphql-engine's types without writing any resolvers for them. +2. They also provide the developers with a powerful asynchronous model for mutations which should enable building applications with the CQRS pattern. + +Example +------- +Let's say you are building an ecommerce application where you need to provide a mutation for placing an 'order', ``place_order``, you will need to first define the input types for this mutation: + +.. code-block:: graphql + + enum payment_method { + stripe + paytm + } + input type place_order_input { + selected_payment_mode payment_method! + items [order_item_input!]! + address_id uuid! + coupon_code String + } + input order_item_input { + skuId uuid! + quantity Int! + } + type place_order_response { + order_id uuid! + } + +You will then define an action called ``place_order`` with ``place_order_input`` as the "input" type, ``place_order_response`` as the "output" type and a http endpoint to be invoked when this action is called by the client. The logic could look something like this: + +.. code-block:: python + + def place_order(payload): + input_args = payload['input'] + session_variables = payload['session_variables'] + # code to validate this mutation and insert into the database + order_id = validate_and_insert_order(input_args, session_variables) + return {"order_id": order_id} + +Once you have the action setup, you'll have to define the permissions for the role for which you want to allow this action. For all such roles, this action will be exposed as a mutation. The client would then execute this mutation as follows: + +.. code-block:: graphql + + mutation place_order($order_input: place_order_input!) { + place_order(input: $order_input) { + action_id + response { + order_id + } + } + } + +Where ``action_id`` is a unique id generated for every action that has been performed. The response from the webhook can be accessed through the ``response`` field. + +Relationships +------------- + +As you may have noticed this isn't very different from what you would have done with remote schemas. This is where relationships on actions come in, letting you hook into the powerful schema that graphql-engine generates. Since the webhook returns an ``order_id``, you can link it to the ``order`` table through an object relationship on ``place_order_response`` called ``order``. The ``order`` information can be requested as follows: + +.. code-block:: graphql + + mutation place_order($order_input: place_order_input!) { + place_order(input: $order_input) { + action_id + response { + order { + id + payment_url + total_amount + discount + } + } + } + } + +You can fetch relationships of the ``order`` like you would when you query the ``order`` table. Thus with actions you can write the minimum needed code that is needed to validate the mutation and still not lose out on the powerful query fields that graphql-engine generates. + +Asynchronous actions +-------------------- + +Sometimes you may not want to wait for an action to complete (say if the business logic takes a long time). In such cases you can create an "asynchronous" action, which returns an ``action_id`` immediately to the client before contacting the webhook. + +If you mark an action as "asynchronous", graphql-engine also generates a query and a subscription field for the action so that you can query/subscribe to its status. In the above example, let's say ``place_order`` is an asnychronous action, your client code looks something like this: + +.. code-block:: graphql + + mutation place_order($order_input: place_order_input!) { + place_order(input: $order_input) { + action_id + } + } + +.. code-block:: graphql + + subscription order_status($action_id: uuid!) { + place_order(action_id: $action_id) { + order { + id + payment_url + total_amount + discount + } + } + } diff --git a/docs/graphql/manual/index.rst b/docs/graphql/manual/index.rst index 4d0a3a27065a1..c3d85b1d70f6b 100644 --- a/docs/graphql/manual/index.rst +++ b/docs/graphql/manual/index.rst @@ -20,6 +20,7 @@ The Hasura GraphQL engine lets you set up a GraphQL server and event triggers ov queries/index mutations/index subscriptions/index + actions/index remote-schemas/index event-triggers/index auth/index @@ -30,4 +31,4 @@ The Hasura GraphQL engine lets you set up a GraphQL server and event triggers ov How it works Troubleshooting guides/index - Vulnerability reporting / disclosure \ No newline at end of file + Vulnerability reporting / disclosure From 8946ba732267076d1266d875294485d5baf3674f Mon Sep 17 00:00:00 2001 From: Tirumarai Selvan A Date: Mon, 14 Oct 2019 10:46:30 +0530 Subject: [PATCH 02/62] wip docs --- .../manual/actions/action-handlers.rst | 36 ++++++ docs/graphql/manual/actions/async-actions.rst | 36 ++++++ .../manual/actions/getting-started.rst | 69 +++++++++++ docs/graphql/manual/actions/index.rst | 113 +++--------------- docs/graphql/manual/actions/input-types.rst | 45 +++++++ .../graphql/manual/actions/response-types.rst | 51 ++++++++ docs/graphql/manual/actions/use-cases.rst | 42 +++++++ 7 files changed, 298 insertions(+), 94 deletions(-) create mode 100644 docs/graphql/manual/actions/action-handlers.rst create mode 100644 docs/graphql/manual/actions/async-actions.rst create mode 100644 docs/graphql/manual/actions/getting-started.rst create mode 100644 docs/graphql/manual/actions/input-types.rst create mode 100644 docs/graphql/manual/actions/response-types.rst create mode 100644 docs/graphql/manual/actions/use-cases.rst diff --git a/docs/graphql/manual/actions/action-handlers.rst b/docs/graphql/manual/actions/action-handlers.rst new file mode 100644 index 0000000000000..b86d6dec73c96 --- /dev/null +++ b/docs/graphql/manual/actions/action-handlers.rst @@ -0,0 +1,36 @@ +Action handlers +=============== + + +.. contents:: Table of contents + :backlinks: none + :depth: 1 + :local: + +WORK IN PROGRESS + +Actions need to be backed by custom business logic. This business logic can be defined in different types of handlers. + + +HTTP handler +------------ + +WIP + +Postgres functions +------------------ + +WIP + +Postgres PLV8 +---- + +Similar to postgres functions but in nodejs. + + +Managing and deploying action handlers +-------------------------------------- + +HTTP handlers in serverless functions, micoservice APIs etc + +Postgres functions as migrations, etc diff --git a/docs/graphql/manual/actions/async-actions.rst b/docs/graphql/manual/actions/async-actions.rst new file mode 100644 index 0000000000000..857c28b6fcd44 --- /dev/null +++ b/docs/graphql/manual/actions/async-actions.rst @@ -0,0 +1,36 @@ +Async Actions +============= + + +.. contents:: Table of contents + :backlinks: none + :depth: 1 + :local: + +WORK IN PROGRESS + +Sometimes you may not want to wait for an action to complete (say if the business logic takes a long time). In such cases you can create an "asynchronous" action, which returns an ``action_id`` immediately to the client before contacting the webhook. + +If you mark an action as "asynchronous", graphql-engine also generates a query and a subscription field for the action so that you can query/subscribe to its status. In the above example, let's say ``place_order`` is an asnychronous action, your client code looks something like this: + +.. code-block:: graphql + + mutation place_order($order_input: place_order_input!) { + place_order(input: $order_input) { + action_id + } + } + +.. code-block:: graphql + + subscription order_status($action_id: uuid!) { + place_order(action_id: $action_id) { + order { + id + payment_url + total_amount + discount + } + } + } + diff --git a/docs/graphql/manual/actions/getting-started.rst b/docs/graphql/manual/actions/getting-started.rst new file mode 100644 index 0000000000000..5d79d2c429d53 --- /dev/null +++ b/docs/graphql/manual/actions/getting-started.rst @@ -0,0 +1,69 @@ +Getting Started with Actions +============================ + + +.. contents:: Table of contents + :backlinks: none + :depth: 1 + :local: + +WORK IN PROGRESS + +Here is a typical way to use an action. + +Example +------- + +WORK IN PROGRESS + +Let's say you are building an ecommerce application where you need to provide a mutation for placing an 'order', ``place_order``, you will need to first define the input types for this mutation: + +.. code-block:: graphql + + enum payment_method { + stripe + paypal + } + + input type place_order_input { + selected_payment_mode payment_method! + items [order_item_input!]! + address_id uuid! + coupon_code String + } + + input order_item_input { + skuId uuid! + quantity Int! + } + + type place_order_response { + order_id uuid! + } + +You will then define an action called ``place_order`` with ``place_order_input`` as the **input** type, ``place_order_response`` as the **output** type. + +Once you have the action setup, you'll have to define the permissions for the role for which you want to allow this action. For all such roles, this action will be exposed as a mutation. The client would then execute this mutation as follows: + +.. code-block:: graphql + + mutation place_order($order_input: place_order_input!) { + place_order(input: $order_input) { + action_id + response { + order_id + } + } + } + +Where ``action_id`` is a unique id generated for every action that has been performed. The response from the webhook can be accessed through the ``response`` field. + +An action can be linked to different types of handlers. In this example, let's use a HTTP handler which will be invoked when this action is called by the client. The logic of this handler could look something like this: + +.. code-block:: python + + def place_order(payload): + input_args = payload['input'] + session_variables = payload['session_variables'] + order_id = validate_and_insert_order(input_args, session_variables) # some business logic code + return {"order_id": order_id} diff --git a/docs/graphql/manual/actions/index.rst b/docs/graphql/manual/actions/index.rst index 24ef86102a072..dabe94f420505 100644 --- a/docs/graphql/manual/actions/index.rst +++ b/docs/graphql/manual/actions/index.rst @@ -6,110 +6,35 @@ Actions :depth: 1 :local: -Actions are custom mutations that can be added to graphql-engine to handle various use cases such as validation, complex business logic etc. -When the permissions system isn't enough to specify the required constraints, you would typically add such mutation through a remote schema, however actions can handle these use cases better because of the following reasons: - -1. Actions let you return graphql-engine's types without writing any resolvers for them. -2. They also provide the developers with a powerful asynchronous model for mutations which should enable building applications with the CQRS pattern. - -Example -------- -Let's say you are building an ecommerce application where you need to provide a mutation for placing an 'order', ``place_order``, you will need to first define the input types for this mutation: - -.. code-block:: graphql - - enum payment_method { - stripe - paytm - } - input type place_order_input { - selected_payment_mode payment_method! - items [order_item_input!]! - address_id uuid! - coupon_code String - } - input order_item_input { - skuId uuid! - quantity Int! - } - type place_order_response { - order_id uuid! - } - -You will then define an action called ``place_order`` with ``place_order_input`` as the "input" type, ``place_order_response`` as the "output" type and a http endpoint to be invoked when this action is called by the client. The logic could look something like this: - -.. code-block:: python +WORK IN PROGRESS - def place_order(payload): - input_args = payload['input'] - session_variables = payload['session_variables'] - # code to validate this mutation and insert into the database - order_id = validate_and_insert_order(input_args, session_variables) - return {"order_id": order_id} +Actions are user defined mutations with custom business logic. Actions can be added to Hasura to handle various use cases such as validation, data enrichment and other complex business logic. -Once you have the action setup, you'll have to define the permissions for the role for which you want to allow this action. For all such roles, this action will be exposed as a mutation. The client would then execute this mutation as follows: - -.. code-block:: graphql - - mutation place_order($order_input: place_order_input!) { - place_order(input: $order_input) { - action_id - response { - order_id - } - } - } - -Where ``action_id`` is a unique id generated for every action that has been performed. The response from the webhook can be accessed through the ``response`` field. - -Relationships -------------- - -As you may have noticed this isn't very different from what you would have done with remote schemas. This is where relationships on actions come in, letting you hook into the powerful schema that graphql-engine generates. Since the webhook returns an ``order_id``, you can link it to the ``order`` table through an object relationship on ``place_order_response`` called ``order``. The ``order`` information can be requested as follows: +When the permissions system isn't enough to specify the required constraints, you would typically add such mutation through a remote schema, however actions can handle these use cases better because of the following reasons: -.. code-block:: graphql +1. No need to write a graphql server. - mutation place_order($order_input: place_order_input!) { - place_order(input: $order_input) { - action_id - response { - order { - id - payment_url - total_amount - discount - } - } - } - } +2. Return graphql-engine's types without writing any extra code -You can fetch relationships of the ``order`` like you would when you query the ``order`` table. Thus with actions you can write the minimum needed code that is needed to validate the mutation and still not lose out on the powerful query fields that graphql-engine generates. +3. Gives a powerful model for mutations which should enable building event-driven apps easily -Asynchronous actions +Architecture Diagram -------------------- -Sometimes you may not want to wait for an action to complete (say if the business logic takes a long time). In such cases you can create an "asynchronous" action, which returns an ``action_id`` immediately to the client before contacting the webhook. - -If you mark an action as "asynchronous", graphql-engine also generates a query and a subscription field for the action so that you can query/subscribe to its status. In the above example, let's say ``place_order`` is an asnychronous action, your client code looks something like this: +WORK IN PROGRESS -.. code-block:: graphql - mutation place_order($order_input: place_order_input!) { - place_order(input: $order_input) { - action_id - } - } +Learn more +---------- -.. code-block:: graphql +.. toctree:: + :maxdepth: 1 + :titlesonly: - subscription order_status($action_id: uuid!) { - place_order(action_id: $action_id) { - order { - id - payment_url - total_amount - discount - } - } - } + Getting started + Input types + Response types + Action handlers + Async actions + Sample use cases diff --git a/docs/graphql/manual/actions/input-types.rst b/docs/graphql/manual/actions/input-types.rst new file mode 100644 index 0000000000000..a543e56068643 --- /dev/null +++ b/docs/graphql/manual/actions/input-types.rst @@ -0,0 +1,45 @@ +Action Input Types +================== + +.. contents:: Table of contents + :backlinks: none + :depth: 1 + :local: + +WORK IN PROGRESS + +Reference for creating different input types. + + +Scalar Input Types +------------------ + +WORK IN PROGRESS + +.. code-block:: graphql + + enum payment_method { + stripe + paytm + } + + +Object Input Types +------------------ + +WORK IN PROGRESS + +.. code-block:: graphql + + input type place_order_input { + selected_payment_mode payment_method! + items [order_item_input!]! + address_id uuid! + coupon_code String + } + + input order_item_input { + skuId uuid! + quantity Int! + } + diff --git a/docs/graphql/manual/actions/response-types.rst b/docs/graphql/manual/actions/response-types.rst new file mode 100644 index 0000000000000..bd75a6374ae9d --- /dev/null +++ b/docs/graphql/manual/actions/response-types.rst @@ -0,0 +1,51 @@ +Action Response Types +===================== + + +.. contents:: Table of contents + :backlinks: none + :depth: 1 + :local: + + +WORK IN PROGRESS + +You can return different types of responses when an action is executed. + +Basic Response +-------------- + +WORK IN PROGRESS + +.. code-block:: graphql + + + mutation place_order($order_input: place_order_input!) { + place_order(input: $order_input) { + action_id + } + } + +Complex response with relationships +----------------------------------- + +WORK IN PROGRESS + +.. code-block:: graphql + + mutation place_order($order_input: place_order_input!) { + place_order(input: $order_input) { + action_id + response { + order { + id + payment_url + total_amount + discount + } + } + } + } + +You can fetch relationships of the ``order`` like you would when you query the ``order`` table. Thus with actions you can write the minimum needed code that is needed to validate the mutation and still not lose out on the powerful query fields that graphql-engine generates. + diff --git a/docs/graphql/manual/actions/use-cases.rst b/docs/graphql/manual/actions/use-cases.rst new file mode 100644 index 0000000000000..217e9b8f351f8 --- /dev/null +++ b/docs/graphql/manual/actions/use-cases.rst @@ -0,0 +1,42 @@ +Actions sample use cases +======================== + + +.. contents:: Table of contents + :backlinks: none + :depth: 1 + :local: + + +WORK IN PROGRESS + +Actions are ideal for doing custom business logic including data validation, etc. + + +Data validation +--------------- + +Suppose you want to insert an article only if the article's character length is greater than 500 and the author has less than 10 articles. + +WORK IN PROGRESS + +Complex form data +----------------- + +When you have to take input in a custom structure or your table models are not best suited for input forms. + +WORK IN PROGRESS + +Data enrichment +--------------- + +After performing some custom logic, you may need to return more data to the front-end client. You can do this by creating relationships between actions and your tables. + +WORK IN PROGRESS + +Custom auth +----------- + +Suppose you have an existing auth system which is hard to map to Hasura's permission system. Then, you can allow only actions to mutate data and perform custom auth in the action handler. + +WORK IN PROGRESS From 05684e8f7bb5a740c9755f37326fec65ec59de18 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Tue, 15 Oct 2019 20:31:27 +0530 Subject: [PATCH 03/62] wip: custom_types, sync and async actions --- server/graphql-engine.cabal | 8 + server/src-exec/Migrate/Version.hs | 2 +- server/src-lib/Data/List/Extended.hs | 15 + server/src-lib/Hasura/GraphQL/Context.hs | 9 + server/src-lib/Hasura/GraphQL/Execute.hs | 2 + server/src-lib/Hasura/GraphQL/Resolve.hs | 80 +++-- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 270 ++++++++++++++++ .../Hasura/GraphQL/Resolve/InputValue.hs | 2 +- .../Hasura/GraphQL/Resolve/Introspect.hs | 4 +- .../Hasura/GraphQL/Resolve/Mutation.hs | 4 +- .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 70 +---- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 19 +- server/src-lib/Hasura/GraphQL/Schema.hs | 61 ++-- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 276 ++++++++++++++++ .../src-lib/Hasura/GraphQL/Schema/Builder.hs | 75 +++++ .../Hasura/GraphQL/Validate/InputValue.hs | 2 +- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 45 ++- server/src-lib/Hasura/RQL/DDL/Action.hs | 261 +++++++++++++++ server/src-lib/Hasura/RQL/DDL/CustomTypes.hs | 256 +++++++++++++++ server/src-lib/Hasura/RQL/DDL/Metadata.hs | 4 +- server/src-lib/Hasura/RQL/DDL/RemoteSchema.hs | 17 - server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs | 79 ++++- .../src-lib/Hasura/RQL/DDL/Schema/Catalog.hs | 3 +- server/src-lib/Hasura/RQL/DML/Internal.hs | 6 +- server/src-lib/Hasura/RQL/Types.hs | 2 + server/src-lib/Hasura/RQL/Types/Action.hs | 127 ++++++++ server/src-lib/Hasura/RQL/Types/Catalog.hs | 5 + .../src-lib/Hasura/RQL/Types/CustomTypes.hs | 135 ++++++++ server/src-lib/Hasura/RQL/Types/Error.hs | 2 + server/src-lib/Hasura/RQL/Types/Metadata.hs | 3 + .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 296 ++++++++++++------ server/src-lib/Hasura/SQL/Types.hs | 32 +- server/src-lib/Hasura/SQL/Value.hs | 34 ++ server/src-lib/Hasura/Server/Query.hs | 21 ++ server/src-rsr/catalog_metadata.sql | 42 ++- server/src-rsr/initialise.sql | 32 ++ server/src-rsr/migrations/25_to_26.sql | 40 +++ server/stack.yaml | 13 +- server/stack.yaml.lock | 36 +-- 39 files changed, 2059 insertions(+), 331 deletions(-) create mode 100644 server/src-lib/Data/List/Extended.hs create mode 100644 server/src-lib/Hasura/GraphQL/Resolve/Action.hs create mode 100644 server/src-lib/Hasura/GraphQL/Schema/Action.hs create mode 100644 server/src-lib/Hasura/GraphQL/Schema/Builder.hs create mode 100644 server/src-lib/Hasura/RQL/DDL/Action.hs create mode 100644 server/src-lib/Hasura/RQL/DDL/CustomTypes.hs create mode 100644 server/src-lib/Hasura/RQL/Types/Action.hs create mode 100644 server/src-lib/Hasura/RQL/Types/CustomTypes.hs create mode 100644 server/src-rsr/migrations/25_to_26.sql diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index c9de5c1f45bf2..c3fc53fca44cd 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -186,7 +186,9 @@ library , Hasura.RQL.Types.Metadata , Hasura.RQL.Types.Permission , Hasura.RQL.Types.QueryCollection + , Hasura.RQL.Types.Action , Hasura.RQL.Types.RemoteSchema + , Hasura.RQL.Types.CustomTypes , Hasura.RQL.DDL.Deps , Hasura.RQL.DDL.Permission.Internal , Hasura.RQL.DDL.Permission.Triggers @@ -208,6 +210,8 @@ library , Hasura.RQL.DDL.Headers , Hasura.RQL.DDL.RemoteSchema , Hasura.RQL.DDL.QueryCollection + , Hasura.RQL.DDL.Action + , Hasura.RQL.DDL.CustomTypes , Hasura.RQL.DML.Delete , Hasura.RQL.DML.Internal , Hasura.RQL.DML.Insert @@ -227,6 +231,8 @@ library , Hasura.GraphQL.Transport.WebSocket , Hasura.GraphQL.Schema.BoolExp , Hasura.GraphQL.Schema.Common + , Hasura.GraphQL.Schema.Builder + , Hasura.GraphQL.Schema.Action , Hasura.GraphQL.Schema.Function , Hasura.GraphQL.Schema.OrderBy , Hasura.GraphQL.Schema.Select @@ -253,6 +259,7 @@ library , Hasura.GraphQL.Execute.LiveQuery.State , Hasura.GraphQL.Execute.LiveQuery.TMap , Hasura.GraphQL.Resolve + , Hasura.GraphQL.Resolve.Action , Hasura.GraphQL.Resolve.Types , Hasura.GraphQL.Resolve.Context , Hasura.GraphQL.Resolve.BoolExp @@ -273,6 +280,7 @@ library , Control.Concurrent.Extended , Control.Lens.Extended , Data.Aeson.Extended + , Data.List.Extended , Data.HashMap.Strict.InsOrd.Extended , Data.Parser.JSONPath , Data.Sequence.NonEmpty diff --git a/server/src-exec/Migrate/Version.hs b/server/src-exec/Migrate/Version.hs index f5fab989ad87a..09e0767b65f6f 100644 --- a/server/src-exec/Migrate/Version.hs +++ b/server/src-exec/Migrate/Version.hs @@ -12,7 +12,7 @@ import Hasura.Prelude import qualified Data.Text as T latestCatalogVersion :: Integer -latestCatalogVersion = 25 +latestCatalogVersion = 26 latestCatalogVersionString :: T.Text latestCatalogVersionString = T.pack $ show latestCatalogVersion diff --git a/server/src-lib/Data/List/Extended.hs b/server/src-lib/Data/List/Extended.hs new file mode 100644 index 0000000000000..81c92793283e5 --- /dev/null +++ b/server/src-lib/Data/List/Extended.hs @@ -0,0 +1,15 @@ +module Data.List.Extended + ( duplicates + , module L + ) where + +import Data.Hashable (Hashable) +import Prelude + +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import Data.List as L + +duplicates :: (Eq a, Hashable a) => [a] -> Set.HashSet a +duplicates = + Map.keysSet . Map.filter (> 1) . Map.fromListWith (+) . map (,1::Int) diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index 3a4896baff5b7..c29a1e89fce45 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -53,6 +53,15 @@ instance ToJSON GCtx where type GCtxMap = Map.HashMap RoleName GCtx +-- data GCtxMap +-- = GCtxMap +-- { _gcmAdminCtx :: !GCtx +-- , _gcmRoles :: !(Map.HashMap RoleName GCtx) +-- } deriving (Show, Eq) + +-- getAdminGCtx :: GCtxMap -> GCtx +-- getAdminGCtx = _gcmAdminCtx + mkQueryRootTyInfo :: [ObjFldInfo] -> ObjTyInfo mkQueryRootTyInfo flds = mkHsraObjTyInfo (Just "query root") diff --git a/server/src-lib/Hasura/GraphQL/Execute.hs b/server/src-lib/Hasura/GraphQL/Execute.hs index 6c3106010186a..d2404c508c85f 100644 --- a/server/src-lib/Hasura/GraphQL/Execute.hs +++ b/server/src-lib/Hasura/GraphQL/Execute.hs @@ -144,6 +144,8 @@ getExecPlanPartial userInfo sc enableAL req = do return $ GExPHasura (gCtx, rootSelSet) VT.TLRemoteType _ rsi -> return $ GExPRemote rsi opDef + VT.TLCustom -> + throw500 "unexpected custom type for top level field" where role = userRole userInfo gCtxRoleMap = scGCtxMap sc diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index b50ef608eec10..8653a6edd41d7 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -1,16 +1,18 @@ module Hasura.GraphQL.Resolve ( mutFldToTx , queryFldToPGAST - , RS.traverseQueryRootFldAST - , RS.toPGQuery + , traverseQueryRootFldAST , UnresolvedVal(..) , AnnPGVal(..) , txtConverter - , RS.QueryRootFldUnresolved + , QueryRootFldAST(..) + , QueryRootFldUnresolved + , QueryRootFldResolved + , toPGQuery + , resolveValPrep - , queryFldToSQL , RIntro.schemaR , RIntro.typeR ) where @@ -23,15 +25,51 @@ import qualified Language.GraphQL.Draft.Syntax as G import Hasura.GraphQL.Resolve.Context import Hasura.Prelude -import Hasura.RQL.DML.Internal (sessVarFromCurrentSetting) import Hasura.RQL.Types import Hasura.SQL.Types +import qualified Hasura.GraphQL.Resolve.Action as RA import qualified Hasura.GraphQL.Resolve.Insert as RI import qualified Hasura.GraphQL.Resolve.Introspect as RIntro import qualified Hasura.GraphQL.Resolve.Mutation as RM import qualified Hasura.GraphQL.Resolve.Select as RS import qualified Hasura.GraphQL.Validate as V +import qualified Hasura.RQL.DML.Select as DS +import qualified Hasura.SQL.DML as S + +data QueryRootFldAST v + = QRFPk !(DS.AnnSimpleSelG v) + | QRFSimple !(DS.AnnSimpleSelG v) + | QRFAgg !(DS.AnnAggSelG v) + | QRFFnSimple !(DS.AnnFnSelSimpleG v) + | QRFFnAgg !(DS.AnnFnSelAggG v) + | QRFActionSelect !(RA.ActionSelect v) + deriving (Show, Eq) + +type QueryRootFldUnresolved = QueryRootFldAST UnresolvedVal +type QueryRootFldResolved = QueryRootFldAST S.SQLExp + +traverseQueryRootFldAST + :: (Applicative f) + => (a -> f b) + -> QueryRootFldAST a + -> f (QueryRootFldAST b) +traverseQueryRootFldAST f = \case + QRFPk s -> QRFPk <$> DS.traverseAnnSimpleSel f s + QRFSimple s -> QRFSimple <$> DS.traverseAnnSimpleSel f s + QRFAgg s -> QRFAgg <$> DS.traverseAnnAggSel f s + QRFFnSimple s -> QRFFnSimple <$> DS.traverseAnnFnSimple f s + QRFFnAgg s -> QRFFnAgg <$> DS.traverseAnnFnAgg f s + QRFActionSelect s -> QRFActionSelect <$> RA.traverseActionSelect f s + +toPGQuery :: QueryRootFldResolved -> Q.Query +toPGQuery = \case + QRFPk s -> DS.selectQuerySQL True s + QRFSimple s -> DS.selectQuerySQL False s + QRFAgg s -> DS.selectAggQuerySQL s + QRFFnSimple s -> DS.mkFuncSelectSimple s + QRFFnAgg s -> DS.mkFuncSelectAgg s + QRFActionSelect s -> RA.actionSelectToSql s validateHdrs :: (Foldable t, QErrM m) => UserInfo -> t Text -> m () @@ -47,42 +85,28 @@ queryFldToPGAST , Has QueryCtxMap r ) => V.Field - -> m RS.QueryRootFldUnresolved + -> m QueryRootFldUnresolved queryFldToPGAST fld = do opCtx <- getOpCtx $ V._fName fld userInfo <- asks getter case opCtx of QCSelect ctx -> do validateHdrs userInfo (_socHeaders ctx) - RS.convertSelect ctx fld + QRFSimple <$> RS.convertSelect ctx fld QCSelectPkey ctx -> do validateHdrs userInfo (_spocHeaders ctx) - RS.convertSelectByPKey ctx fld + QRFPk <$> RS.convertSelectByPKey ctx fld QCSelectAgg ctx -> do validateHdrs userInfo (_socHeaders ctx) - RS.convertAggSelect ctx fld + QRFAgg <$> RS.convertAggSelect ctx fld QCFuncQuery ctx -> do validateHdrs userInfo (_fqocHeaders ctx) - RS.convertFuncQuerySimple ctx fld + QRFFnSimple <$> RS.convertFuncQuerySimple ctx fld QCFuncAggQuery ctx -> do validateHdrs userInfo (_fqocHeaders ctx) - RS.convertFuncQueryAgg ctx fld - -queryFldToSQL - :: ( MonadResolve m, MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r, Has UserInfo r - , Has QueryCtxMap r - ) - => PrepFn m - -> V.Field - -> m Q.Query -queryFldToSQL fn fld = do - pgAST <- queryFldToPGAST fld - resolvedAST <- flip RS.traverseQueryRootFldAST pgAST $ \case - UVPG annPGVal -> fn annPGVal - UVSQL sqlExp -> return sqlExp - UVSessVar colTy sessVar -> sessVarFromCurrentSetting colTy sessVar - return $ RS.toPGQuery resolvedAST + QRFFnAgg <$> RS.convertFuncQueryAgg ctx fld + QCActionFetch ctx -> + QRFActionSelect <$> RA.resolveActionSelect ctx fld mutFldToTx :: ( MonadResolve m @@ -110,6 +134,8 @@ mutFldToTx fld = do MCDelete ctx -> do validateHdrs userInfo (_docHeaders ctx) RM.convertDelete ctx fld + MCAction ctx -> + RA.resolveActionInsert fld ctx (userVars userInfo) getOpCtx :: ( MonadResolve m diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs new file mode 100644 index 0000000000000..d681bbb23132a --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -0,0 +1,270 @@ +module Hasura.GraphQL.Resolve.Action + ( resolveActionSelect + , resolveActionInsert + -- , resolveResponseSelectionSet + + , ActionSelect(..) + , traverseActionSelect + , actionSelectToSql + ) where + +import Data.Has +import Hasura.Prelude + +import qualified Data.Aeson as J +import qualified Data.UUID as UUID +import qualified Database.PG.Query as Q +import qualified Language.GraphQL.Draft.Syntax as G + +import qualified Hasura.SQL.DML as S + +import Hasura.RQL.DML.Internal (dmlTxErrorHandler) + +import Hasura.RQL.DML.Select (asSingleRowJsonResp) + +import Hasura.GraphQL.Resolve.Context +import Hasura.GraphQL.Resolve.InputValue +import Hasura.GraphQL.Validate.Field +import Hasura.GraphQL.Validate.Types +import Hasura.RQL.Types +import Hasura.SQL.Types +import Hasura.SQL.Value (pgScalarValueToJson) + +data InputFieldResolved + = InputFieldSimple !Text + | InputFieldTypename !G.NamedType + deriving (Show, Eq) + +data OutputFieldResolved + = OutputFieldSimple !Text + | OutputFieldRelationship + | OutputFieldTypename !G.NamedType + deriving (Show, Eq) + +data ResponseFieldResolved + = ResponseFieldOutput ![(Text, OutputFieldResolved)] + | ResponseFieldMetadata !PGCol + | ResponseFieldTypename !G.NamedType + deriving (Show, Eq) + +resolveOutputSelectionSet + :: ( MonadError QErr m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => G.NamedType + -> SelSet + -> m [(Text, OutputFieldResolved)] +resolveOutputSelectionSet ty selSet = + withSelSet selSet $ \fld -> case _fName fld of + "__typename" -> return $ OutputFieldTypename ty + G.Name t -> return $ OutputFieldSimple t + +resolveResponseSelectionSet + :: ( MonadError QErr m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => G.NamedType + -> SelSet + -> m [(Text, ResponseFieldResolved)] +resolveResponseSelectionSet ty selSet = + withSelSet selSet $ \fld -> case _fName fld of + "__typename" -> return $ ResponseFieldTypename ty + + "output" -> + ResponseFieldOutput <$> + resolveOutputSelectionSet (_fType fld) (_fSelSet fld) + + -- the metadata columns + "id" -> return $ mkMetadataField "id" + "created_at" -> return $ mkMetadataField "created_at" + "status" -> return $ mkMetadataField "status" + + G.Name t -> throw500 $ "unexpected field in actions' response : " <> t + + where + mkMetadataField = ResponseFieldMetadata . PGCol + +data ActionSelect v + = ActionSelect + { _asId :: !v + , _asSelection :: ![(Text, ResponseFieldResolved)] + , _asFilter :: !(AnnBoolExp v) + } deriving (Show, Eq, Functor) + +traverseActionSelect + :: (Applicative f) + => (a -> f b) + -> ActionSelect a + -> f (ActionSelect b) +traverseActionSelect f (ActionSelect idText selection rowFilter) = + ActionSelect <$> f idText <*> pure selection <*> traverseAnnBoolExp f rowFilter + +type ActionSelectResolved = ActionSelect S.SQLExp +type ActionSelectUnresolved = ActionSelect UnresolvedVal + +actionSelectToSql :: ActionSelectResolved -> Q.Query +actionSelectToSql (ActionSelect actionIdExp selection filter) = + Q.fromBuilder $ toSQL selectAST + where + selectAST = + S.mkSelect + { S.selFrom = Just $ S.FromExp $ pure $ S.FISimple actionLogTable Nothing + , S.selExtr = pure $ S.Extractor + (usingJsonBuildObj selection responseFieldToSQLExp) + -- we need the root alias because subscription refers + -- to this particular field + (Just $ S.toAlias $ Iden "root") + , S.selWhere = Just $ S.WhereFrag whereExpression + } + + whereExpression = + S.BECompare S.SEQ (S.mkSIdenExp actionIdColumn) actionIdExp + -- we need this annotation because ID is mapped to text + -- and hence the prepared value will be a PGText + -- S.SETyAnn actionIdExp $ S.TypeAnn "uuid" + where + actionIdColumn = PGCol "id" + + actionLogTable = + QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log") + + responseFieldToSQLExp = \case + ResponseFieldOutput fields -> usingJsonBuildObj fields outputFieldToSQLExp + ResponseFieldMetadata columnName -> S.SEIden $ toIden columnName + ResponseFieldTypename ty -> S.SELit $ G.unName $ G.unNamedType ty + + outputFieldToSQLExp = \case + OutputFieldSimple fieldName -> + S.SEOpApp (S.SQLOp "->>") [outputColumn, S.SELit fieldName] + OutputFieldRelationship -> undefined + OutputFieldTypename ty -> S.SELit $ G.unName $ G.unNamedType ty + where + outputColumn = S.SEIden $ toIden $ PGCol "response_payload" + + usingJsonBuildObj :: [(Text, a)] -> (a -> S.SQLExp) -> S.SQLExp + usingJsonBuildObj l f = + S.applyJsonBuildObj $ flip concatMap l $ + \(alias, field) -> [S.SELit alias, f field] + + +resolveActionSelect + :: ( MonadError QErr m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r, MonadResolve m + ) + => ActionSelectOpContext + -> Field + -> m ActionSelectUnresolved +resolveActionSelect selectContext field = do + actionId <- withArg (_fArguments field) "id" parseActionId + responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ + _fSelSet field + return $ ActionSelect actionId responseSelectionSet unresolvedFilter + where + unresolvedFilter = + fmapAnnBoolExp partialSQLExpToUnresolvedVal $ + _asocFilter selectContext + parseActionId annInpValue = do + mkParameterizablePGValue <$> asPGColumnValue annInpValue + -- onNothing (UUID.fromText idText) $ + -- throwVE $ "invalid value for uuid: " <> idText + +actionSelectToTx :: ActionSelectResolved -> RespTx +actionSelectToTx actionSelect = + asSingleRowJsonResp (actionSelectToSql actionSelect) [] + +resolveActionInsertSync + :: ( MonadError QErr m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => Field + -> Text + -- We need the sesion variables for column presets + -> UserVars + -> m RespTx +resolveActionInsertSync field executionContext sessionVariables = + throw500 "sync actions not yet implemented" + +resolveActionInsert + :: ( MonadError QErr m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => Field + -> ActionExecutionContext + -- We need the sesion variables for column presets + -> UserVars + -> m RespTx +resolveActionInsert field executionContext sessionVariables = + case executionContext of + ActionExecutionSyncWebhook webhook -> + resolveActionInsertSync field webhook sessionVariables + ActionExecutionAsync actionFilter -> + resolveActionInsertAsync field actionFilter sessionVariables + +resolveActionInsertAsync + :: ( MonadError QErr m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => Field + -> AnnBoolExpPartialSQL + -- We need the sesion variables for column presets + -> UserVars + -> m RespTx +resolveActionInsertAsync field actionFilter sessionVariables = do + + responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ _fSelSet field + + inputArgs <- withArg (_fArguments field) "input" (return . annInpValueToJson) + + -- resolvedPresetFields <- resolvePresetFields + + -- The order of the union doesn't matter as the allowed input + -- and the present fields are mutually exclusive + -- let actionInput = OMap.union inputArgs resolvedPresetFields + + -- resolvedFilter <- resolveFilter + let resolvedFilter = annBoolExpTrue + + return $ do + actionId <- runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler [Q.sql| + INSERT INTO + "hdb_catalog"."hdb_action_log" + ("action_name", "session_variables", "input_payload", "status") + VALUES + ($1, $2, $3, $4) + RETURNING "id" + |] + (actionName, Q.AltJ sessionVariables, Q.AltJ inputArgs, "created"::Text) False + + actionSelectToTx $ + ActionSelect (S.SELit $ UUID.toText actionId) + responseSelectionSet resolvedFilter + where + actionName = G.unName $ _fName field + + -- resolveFilter = + -- flip traverseAnnBoolExp (_aiocSelectFilter insertContext) $ \case + -- PSESQLExp e -> return e + -- PSESessVar variableTy sessVar -> do + -- sessionVariableValueExp <- S.SELit <$> fetchSessionVariableValue sessVar + -- return $ undefined variableTy sessionVariableValueExp + + -- fetchSessionVariableValue sessionVariable = + -- onNothing (getVarVal sessionVariable sessionVariables) $ + -- throw500 $ "missing required session variable: " <> sessionVariable + + -- resolvePresetFields = + -- fmap OMap.fromList $ forM (Map.toList $ _aiocPresetFields insertContext) $ + -- \(k, v) -> (unActionInputField k,) <$> case v of + -- Left sessVariable -> J.toJSON <$> fetchSessionVariableValue sessVariable + -- Right scalarValue -> return scalarValue + + +annInpValueToJson :: AnnInpVal -> J.Value +annInpValueToJson annInpValue = + case _aivValue annInpValue of + AGScalar _ pgColumnValueM -> maybe J.Null pgScalarValueToJson pgColumnValueM + AGEnum _ enumValue -> case enumValue of + AGESynthetic enumValueM -> J.toJSON enumValueM + AGEReference _ enumValueM -> J.toJSON enumValueM + AGObject _ objectM -> J.toJSON $ fmap (fmap annInpValueToJson) objectM + AGArray _ valuesM -> J.toJSON $ fmap (fmap annInpValueToJson) valuesM diff --git a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs index f03e86d626973..9448d5d9eccb7 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/InputValue.hs @@ -175,7 +175,7 @@ onlyText :: (MonadError QErr m) => PGScalarValue -> m Text onlyText = \case - PGValText t -> return t + PGValText t -> return t PGValVarchar t -> return t _ -> throw500 "expecting text for asPGColText" diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs b/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs index be5b199de262c..130ac4cf2d6da 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Introspect.hs @@ -59,13 +59,13 @@ scalarR => ScalarTyInfo -> Field -> m J.Object -scalarR (ScalarTyInfo descM pgColType _) fld = +scalarR (ScalarTyInfo descM name _ _) fld = withSubFields (_fSelSet fld) $ \subFld -> case _fName subFld of "__typename" -> retJT "__Type" "kind" -> retJ TKSCALAR "description" -> retJ $ fmap G.unDescription descM - "name" -> retJ $ pgColTyToScalar pgColType + "name" -> retJ name _ -> return J.Null -- 4.5.2.2 diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index bffb88328867b..f14ce6ad54b7c 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -24,7 +24,7 @@ import Hasura.EncJSON import Hasura.GraphQL.Resolve.BoolExp import Hasura.GraphQL.Resolve.Context import Hasura.GraphQL.Resolve.InputValue -import Hasura.GraphQL.Resolve.Select (fromSelSet) +import Hasura.GraphQL.Resolve.Select (processTableSelectionSet) import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types import Hasura.RQL.Types @@ -41,7 +41,7 @@ convertMutResp ty selSet = "__typename" -> return $ RR.MExp $ G.unName $ G.unNamedType ty "affected_rows" -> return RR.MCount "returning" -> do - annFlds <- fromSelSet (_fType fld) $ _fSelSet fld + annFlds <- processTableSelectionSet (_fType fld) $ _fSelSet fld annFldsResolved <- traverse (traverse (RS.traverseAnnFld convertUnresolvedVal)) annFlds return $ RR.MRet annFldsResolved diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index d2adc17578a40..93af27a84b8e9 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -5,12 +5,7 @@ module Hasura.GraphQL.Resolve.Select , convertFuncQuerySimple , convertFuncQueryAgg , parseColumns - , fromSelSet - , QueryRootFldAST(..) - , traverseQueryRootFldAST - , QueryRootFldUnresolved - , QueryRootFldResolved - , toPGQuery + , processTableSelectionSet ) where import Data.Has @@ -23,7 +18,6 @@ import qualified Data.List.NonEmpty as NE import qualified Data.Text as T import qualified Language.GraphQL.Draft.Syntax as G -import qualified Database.PG.Query as Q import qualified Hasura.RQL.DML.Select as RS import qualified Hasura.SQL.DML as S @@ -55,12 +49,12 @@ argsToColOp args = maybe (return Nothing) toOp $ Map.lookup "path" args type AnnFlds = RS.AnnFldsG UnresolvedVal -fromSelSet +processTableSelectionSet :: ( MonadResolve m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) => G.NamedType -> SelSet -> m AnnFlds -fromSelSet fldTy flds = +processTableSelectionSet fldTy flds = forM (toList flds) $ \fld -> do let fldName = _fName fld let rqlFldName = FieldName $ G.unName $ G.unAlias $ _fAlias fld @@ -99,7 +93,7 @@ fromAggSelSet colGNameMap fldTy selSet = fmap toFields $ case _fName f of "__typename" -> return $ RS.TAFExp $ G.unName $ G.unNamedType fldTy "aggregate" -> RS.TAFAgg <$> convertAggFld colGNameMap fTy fSelSet - "nodes" -> RS.TAFNodes <$> fromSelSet fTy fSelSet + "nodes" -> RS.TAFNodes <$> processTableSelectionSet fTy fSelSet G.Name t -> throw500 $ "unexpected field in _agg node: " <> t type TableArgs = RS.TableArgsG UnresolvedVal @@ -147,7 +141,7 @@ fromField -> Field -> m AnnSimpleSelect fromField tn colGNameMap permFilter permLimitM fld = fieldAsPath fld $ do tableArgs <- parseTableArgs colGNameMap args - annFlds <- fromSelSet (_fType fld) $ _fSelSet fld + annFlds <- processTableSelectionSet (_fType fld) $ _fSelSet fld let unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter let tabFrom = RS.TableFrom tn Nothing tabPerm = RS.TablePerm unresolvedPermFltr permLimitM @@ -295,7 +289,7 @@ fromFieldByPKey -> AnnBoolExpPartialSQL -> Field -> m AnnSimpleSel fromFieldByPKey tn colArgMap permFilter fld = fieldAsPath fld $ do boolExp <- pgColValToBoolExp colArgMap $ _fArguments fld - annFlds <- fromSelSet fldTy $ _fSelSet fld + annFlds <- processTableSelectionSet fldTy $ _fSelSet fld let tabFrom = RS.TableFrom tn Nothing unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter @@ -310,9 +304,9 @@ convertSelect :: ( MonadResolve m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => SelOpCtx -> Field -> m QueryRootFldUnresolved + => SelOpCtx -> Field -> m (RS.AnnSimpleSelG UnresolvedVal) convertSelect opCtx fld = - withPathK "selectionSet" $ QRFSimple <$> + withPathK "selectionSet" $ fromField qt colGNameMap permFilter permLimit fld where SelOpCtx qt _ colGNameMap permFilter permLimit = opCtx @@ -321,9 +315,9 @@ convertSelectByPKey :: ( MonadResolve m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => SelPkOpCtx -> Field -> m QueryRootFldUnresolved + => SelPkOpCtx -> Field -> m (RS.AnnSimpleSelG UnresolvedVal) convertSelectByPKey opCtx fld = - withPathK "selectionSet" $ QRFPk <$> + withPathK "selectionSet" $ fromFieldByPKey qt colArgMap permFilter fld where SelPkOpCtx qt _ permFilter colArgMap = opCtx @@ -409,11 +403,10 @@ convertAggSelect :: ( MonadResolve m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => SelOpCtx -> Field -> m QueryRootFldUnresolved + => SelOpCtx -> Field -> m (RS.AnnAggSelG UnresolvedVal) convertAggSelect opCtx fld = - withPathK "selectionSet" $ QRFAgg <$> + withPathK "selectionSet" $ fromAggField qt colGNameMap permFilter permLimit fld - -- return $ RS.selectAggQuerySQL selData where SelOpCtx qt _ colGNameMap permFilter permLimit = opCtx @@ -460,9 +453,9 @@ convertFuncQuerySimple , Has OrdByCtx r , Has SQLGenCtx r ) - => FuncQOpCtx -> Field -> m QueryRootFldUnresolved + => FuncQOpCtx -> Field -> m (RS.AnnFnSelSimpleG UnresolvedVal) convertFuncQuerySimple funcOpCtx fld = - withPathK "selectionSet" $ QRFFnSimple <$> + withPathK "selectionSet" $ fromFuncQueryField (fromField qt colGNameMap permFilter permLimit) qf argSeq fld where FuncQOpCtx qt _ colGNameMap permFilter permLimit qf argSeq = funcOpCtx @@ -474,40 +467,9 @@ convertFuncQueryAgg , Has OrdByCtx r , Has SQLGenCtx r ) - => FuncQOpCtx -> Field -> m QueryRootFldUnresolved + => FuncQOpCtx -> Field -> m (RS.AnnFnSelAggG UnresolvedVal) convertFuncQueryAgg funcOpCtx fld = - withPathK "selectionSet" $ QRFFnAgg <$> + withPathK "selectionSet" $ fromFuncQueryField (fromAggField qt colGNameMap permFilter permLimit) qf argSeq fld where FuncQOpCtx qt _ colGNameMap permFilter permLimit qf argSeq = funcOpCtx - -data QueryRootFldAST v - = QRFPk !(RS.AnnSimpleSelG v) - | QRFSimple !(RS.AnnSimpleSelG v) - | QRFAgg !(RS.AnnAggSelG v) - | QRFFnSimple !(RS.AnnFnSelSimpleG v) - | QRFFnAgg !(RS.AnnFnSelAggG v) - deriving (Show, Eq) - -type QueryRootFldUnresolved = QueryRootFldAST UnresolvedVal -type QueryRootFldResolved = QueryRootFldAST S.SQLExp - -traverseQueryRootFldAST - :: (Applicative f) - => (a -> f b) - -> QueryRootFldAST a - -> f (QueryRootFldAST b) -traverseQueryRootFldAST f = \case - QRFPk s -> QRFPk <$> RS.traverseAnnSimpleSel f s - QRFSimple s -> QRFSimple <$> RS.traverseAnnSimpleSel f s - QRFAgg s -> QRFAgg <$> RS.traverseAnnAggSel f s - QRFFnSimple s -> QRFFnSimple <$> RS.traverseAnnFnSimple f s - QRFFnAgg s -> QRFFnAgg <$> RS.traverseAnnFnAgg f s - -toPGQuery :: QueryRootFldResolved -> Q.Query -toPGQuery = \case - QRFPk s -> RS.selectQuerySQL True s - QRFSimple s -> RS.selectQuerySQL False s - QRFAgg s -> RS.selectAggQuerySQL s - QRFFnSimple s -> RS.mkFuncSelectSimple s - QRFFnAgg s -> RS.mkFuncSelectAgg s diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 4cd8a5055a422..e29459b6a05d4 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -26,12 +26,14 @@ data QueryCtx | QCSelectAgg !SelOpCtx | QCFuncQuery !FuncQOpCtx | QCFuncAggQuery !FuncQOpCtx + | QCActionFetch !ActionSelectOpContext deriving (Show, Eq) data MutationCtx = MCInsert !InsOpCtx | MCUpdate !UpdOpCtx | MCDelete !DelOpCtx + | MCAction !ActionExecutionContext deriving (Show, Eq) type OpCtxMap a = Map.HashMap G.Name a @@ -89,17 +91,16 @@ data DelOpCtx , _docAllCols :: ![PGColumnInfo] } deriving (Show, Eq) -data OpCtx - = OCSelect !SelOpCtx - | OCSelectPkey !SelPkOpCtx - | OCSelectAgg !SelOpCtx - | OCFuncQuery !FuncQOpCtx - | OCFuncAggQuery !FuncQOpCtx - | OCInsert !InsOpCtx - | OCUpdate !UpdOpCtx - | OCDelete !DelOpCtx +data ActionExecutionContext + = ActionExecutionSyncWebhook !Text + | ActionExecutionAsync !AnnBoolExpPartialSQL deriving (Show, Eq) +newtype ActionSelectOpContext + = ActionSelectOpContext + { _asocFilter :: AnnBoolExpPartialSQL + } deriving (Show, Eq) + -- (custom name | generated name) -> PG column info -- used in resolvers type PGColGNameMap = Map.HashMap G.Name PGColumnInfo diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index d344057c23b81..1bd15f09a3b04 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -35,7 +35,9 @@ import Hasura.RQL.Types import Hasura.Server.Utils (duplicates) import Hasura.SQL.Types +import Hasura.GraphQL.Schema.Action import Hasura.GraphQL.Schema.BoolExp +import Hasura.GraphQL.Schema.Builder import Hasura.GraphQL.Schema.Common import Hasura.GraphQL.Schema.Function import Hasura.GraphQL.Schema.Merge @@ -313,7 +315,7 @@ getRootFldsRole' getRootFldsRole' tn primCols constraints fields funcs insM selM updM delM viM tableConfig = RootFields - { rootQueryFields = makeFieldMap + { _rootQueryFields = makeFieldMap $ funcQueries <> funcAggQueries <> catMaybes @@ -321,7 +323,7 @@ getRootFldsRole' tn primCols constraints fields funcs insM , getSelAggDet selM , getPKeySelDet selM primCols ] - , rootMutationFields = makeFieldMap $ catMaybes + , _rootMutationFields = makeFieldMap $ catMaybes [ mutHelper viIsInsertable getInsDet insM , mutHelper viIsUpdatable getUpdDet updM , mutHelper viIsDeletable getDelDet delM @@ -627,19 +629,25 @@ noFilter = annBoolExpTrue mkGCtxMap :: (MonadError QErr m) - => TableCache PGColumnInfo -> FunctionCache -> m GCtxMap -mkGCtxMap tableCache functionCache = do + => TableCache PGColumnInfo -> FunctionCache -> ActionCache -> m GCtxMap +mkGCtxMap tableCache functionCache actionCache = do typesMapL <- mapM (mkGCtxMapTable tableCache functionCache) $ filter tableFltr $ Map.elems tableCache -- since root field names are customisable, we need to check for -- duplicate root field names across all tables - duplicateRootFlds <- (duplicates . concat) <$> forM typesMapL getRootFlds + duplicateRootFlds <- duplicates . concat <$> forM typesMapL getRootFlds unless (null duplicateRootFlds) $ throw400 Unexpected $ "following root fields are duplicated: " <> showNames duplicateRootFlds - let typesMap = foldr (Map.unionWith mappend) Map.empty typesMapL - return $ flip Map.map typesMap $ \(ty, flds, insCtxMap) -> - mkGCtx ty flds insCtxMap + + let actionsSchema = mkActionsSchema actionCache + -- TODO: clean this up + let typesMap = foldr (Map.unionWith mappend) + (fmap (\(rootFields, tyAgg) -> (tyAgg, rootFields, mempty)) + actionsSchema) typesMapL + gCtxMap = flip Map.map typesMap $ + \(ty, flds, insCtxMap) -> mkGCtx ty flds insCtxMap + return gCtxMap where tableFltr ti = not (isSystemDefined $ _tiSystemDefined ti) && isValidObjectName (_tiName ti) @@ -648,13 +656,14 @@ mkGCtxMap tableCache functionCache = do (Map.lookup adminRole roleMap) $ throw500 "admin schema not found" return $ Map.keys query <> Map.keys mutation + -- | build GraphQL schema from postgres tables and functions buildGCtxMapPG :: (QErrM m, CacheRWM m) => m () buildGCtxMapPG = do sc <- askSchemaCache - gCtxMap <- mkGCtxMap (scTables sc) (scFunctions sc) + gCtxMap <- mkGCtxMap (scTables sc) (scFunctions sc) (scActions sc) writeSchemaCache sc {scGCtxMap = gCtxMap} getGCtx :: (CacheRM m) => RoleName -> GCtxMap -> m GCtx @@ -684,40 +693,6 @@ ppGCtx gCtx = mRootO = _gMutRoot gCtx sRootO = _gSubRoot gCtx --- | A /types aggregate/, which holds role-specific information about visible GraphQL types. --- Importantly, it holds more than just the information needed by GraphQL: it also includes how the --- GraphQL types relate to Postgres types, which is used to validate literals provided for --- Postgres-specific scalars. -data TyAgg - = TyAgg - { _taTypes :: !TypeMap - , _taFields :: !FieldMap - , _taScalars :: !(Set.HashSet PGScalarType) - , _taOrdBy :: !OrdByCtx - } deriving (Show, Eq) - -instance Semigroup TyAgg where - (TyAgg t1 f1 s1 o1) <> (TyAgg t2 f2 s2 o2) = - TyAgg (Map.union t1 t2) (Map.union f1 f2) - (Set.union s1 s2) (Map.union o1 o2) - -instance Monoid TyAgg where - mempty = TyAgg Map.empty Map.empty Set.empty Map.empty - --- | A role-specific mapping from root field names to allowed operations. -data RootFields - = RootFields - { rootQueryFields :: !(Map.HashMap G.Name (QueryCtx, ObjFldInfo)) - , rootMutationFields :: !(Map.HashMap G.Name (MutationCtx, ObjFldInfo)) - } deriving (Show, Eq) - -instance Semigroup RootFields where - RootFields a1 b1 <> RootFields a2 b2 - = RootFields (Map.union a1 a2) (Map.union b1 b2) - -instance Monoid RootFields where - mempty = RootFields Map.empty Map.empty - mkGCtx :: TyAgg -> RootFields -> InsCtxMap -> GCtx mkGCtx tyAgg (RootFields queryFields mutationFields) insCtxMap = let queryRoot = mkQueryRootTyInfo qFlds diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs new file mode 100644 index 0000000000000..62a788b8746a9 --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -0,0 +1,276 @@ +module Hasura.GraphQL.Schema.Action + ( mkActionsSchema + ) where + +import qualified Data.HashMap.Strict as Map +import qualified Language.GraphQL.Draft.Syntax as G + +import Hasura.GraphQL.Schema.Builder +-- import qualified Data.HashSet as Set + +import Hasura.GraphQL.Resolve.Types +import Hasura.GraphQL.Validate.Types +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.SQL.Types + +-- mkOutputSelectionTypeName :: ActionName -> G.Name +-- mkOutputSelectionTypeName actionName = +-- unActionName actionName <> "_output_selection" + +-- mkOutputSelectionType :: ActionName -> G.NamedType +-- mkOutputSelectionType = +-- G.NamedType . mkOutputSelectionTypeName + +-- mkOutputSelectionTypeInfo +-- :: ActionName +-- -- Name of the action +-- -> ActionOutputFieldTypes +-- -- allowed response columns +-- -> ObjTyInfo +-- mkOutputSelectionTypeInfo actionName allowedOutputFields = +-- mkHsraObjTyInfo +-- (Just description) +-- (mkOutputSelectionType actionName) -- "(action_name)_output" +-- mempty -- no arguments +-- (mapFromL _fiName outputFieldDefinitions) +-- where +-- description = G.Description $ "output fields of action: " <>> actionName +-- outputFieldDefinitions = +-- map (uncurry outputFieldToGqlField) $ Map.toList allowedOutputFields + + -- outputFieldToGqlField :: ActionOutputField -> PGColType -> ObjFldInfo + -- outputFieldToGqlField fieldName fieldType = + -- mkHsraObjFldInfo + -- Nothing + -- (unActionOutputField fieldName) + -- mempty + -- (G.toGT $ mkScalarTy fieldType) + +-- mkInputSelectionTypeName :: ActionName -> G.Name +-- mkInputSelectionTypeName actionName = +-- unActionName actionName <> "_input_selection" + +-- mkInputSelectionType :: ActionName -> G.NamedType +-- mkInputSelectionType = +-- G.NamedType . mkInputSelectionTypeName + +-- mkInputSelectionTypeInfo +-- :: ActionName +-- -- Name of the action +-- -> ActionInputFieldTypes +-- -- input columns that are allowed to be read +-- -> ObjTyInfo +-- mkInputSelectionTypeInfo actionName allowedInputFields = +-- mkHsraObjTyInfo +-- (Just description) +-- (mkInputSelectionType actionName) -- "(action_name)_input" +-- mempty -- no arguments +-- (mapFromL _fiName inputFieldDefinitions) +-- where +-- description = G.Description $ "input fields of action: " <>> actionName +-- inputFieldDefinitions = +-- map (uncurry inputFieldToGqlField) $ Map.toList allowedInputFields + +-- inputFieldToGqlField :: ActionInputField -> PGColType -> ObjFldInfo +-- inputFieldToGqlField fieldName fieldType = +-- mkHsraObjFldInfo +-- Nothing +-- (unActionInputField fieldName) +-- mempty +-- (G.toGT $ mkScalarTy fieldType) + +mkActionSelectionType :: ActionName -> G.NamedType +mkActionSelectionType = + G.NamedType . unActionName + +mkActionResponseTypeInfo + :: ActionName + -- Name of the action + -> GraphQLType + -- output type + -> ObjTyInfo +mkActionResponseTypeInfo actionName outputType = + mkHsraObjTyInfo + (Just description) + (mkActionSelectionType actionName) -- "(action_name)_input" + mempty -- no arguments + (mapFromL _fiName fieldDefinitions) + where + description = G.Description $ "fields of action: " <>> actionName + + mkFieldDefinition (fieldName, fieldDescription, fieldType) = + mkHsraObjFldInfo + (Just fieldDescription) + fieldName + mempty + fieldType + + fieldDefinitions = map mkFieldDefinition + [ ( "id", "the unique id of an action" + , G.toGT $ mkScalarTy PGUUID) + , ( "created_at", "the time at which this action was created" + , G.toGT $ mkScalarTy PGTimeStampTZ) + -- , ( "status", "the status of this action, whether it is processed, etc." + -- , G.toGT $ G.NamedType "action_status") + , ( "output", "the output fields of this action" + , unGraphQLType outputType) + ] + +-- mkActionInputType :: ActionName -> G.NamedType +-- mkActionInputType actionName = +-- G.NamedType $ unActionName actionName <> "_input" + +-- makes the input type for the allowed fields +-- mkInputTypeInfo +-- :: ActionName +-- -- Name of the action +-- -> ActionInputFieldTypes +-- -> InpObjTyInfo +-- mkInputTypeInfo actionName allowedInputFields = +-- mkHsraInpTyInfo +-- (Just description) +-- (mkActionInputType actionName) +-- inputFields +-- where +-- description = +-- G.Description $ "input arguments for action: " <>> actionName + +-- inputFields = +-- mapFromL _iviName $ +-- map (uncurry mkInputField) $ Map.toList allowedInputFields + +-- mkInputField :: ActionInputField -> PGColType -> InpValInfo +-- mkInputField inputField ty = +-- InpValInfo +-- Nothing +-- (unActionInputField inputField) +-- Nothing -- no default value +-- (G.toGT $ mkScalarTy ty) + +mkMutationField + :: ActionName + -> ResolvedActionDefinition + -> ActionPermissionInfo + -> (ActionExecutionContext, ObjFldInfo) +mkMutationField actionName definition permission = + ( actionExecutionContext + , fieldInfo + ) + where + actionExecutionContext = + case getActionKind definition of + ActionSynchronous -> ActionExecutionSyncWebhook $ _adWebhook definition + ActionAsynchronous -> ActionExecutionAsync $ _apiFilter permission + + -- TODO: we need to capture the comment from action definition + description = + G.Description $ "perform the action: " <>> actionName + + inputType = _adInputType definition + + fieldInfo = + mkHsraObjFldInfo + (Just description) + (unActionName actionName) + (mapFromL _iviName [inputArgument]) $ + actionFieldResponseType actionName definition + + inputArgument = + InpValInfo (Just inputDescription) "input" Nothing $ + unGraphQLType inputType + where + inputDescription = G.Description $ "input for action: " <>> actionName + +actionFieldResponseType :: ActionName -> ActionDefinition a -> G.GType +actionFieldResponseType actionName definition = + case getActionKind definition of + ActionSynchronous -> unGraphQLType $ _adOutputType definition + ActionAsynchronous -> G.toGT $ G.toGT $ mkActionSelectionType actionName + +mkQueryField + :: ActionName + -> ResolvedActionDefinition + -> ActionPermissionInfo + -> Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) +mkQueryField actionName definition permission = + case getActionKind definition of + ActionAsynchronous -> + Just ( ActionSelectOpContext $ _apiFilter permission + , fieldInfo + , TIObj $ mkActionResponseTypeInfo actionName $ + _adOutputType definition + ) + ActionSynchronous -> Nothing + where + -- TODO: we need to capture the comment from action definition + description = + G.Description $ "retrieve the result of action: " <>> actionName + + idArgument = + InpValInfo (Just idDescription) "id" Nothing $ G.toNT $ mkScalarTy PGUUID + where + idDescription = G.Description $ "id of the action: " <>> actionName + + fieldInfo = + mkHsraObjFldInfo + (Just description) + (unActionName actionName) + (mapFromL _iviName [idArgument]) + (actionFieldResponseType actionName definition) + +mkActionFieldsAndTypes + :: ActionName + -> ResolvedActionDefinition + -> ActionPermissionInfo + -> ( Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) + -- context, field, response type info + , (ActionExecutionContext, ObjFldInfo) -- mutation field + ) +mkActionFieldsAndTypes actionName definition permission = + ( mkQueryField actionName definition permission + , mkMutationField actionName definition permission + ) + +mkActionSchemaOne + :: ActionInfo + -> Map.HashMap RoleName + ( Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) + , (ActionExecutionContext, ObjFldInfo) + ) +mkActionSchemaOne actionInfo = + flip fmap permissions $ \permission -> + mkActionFieldsAndTypes (_aiName actionInfo) (_aiDefintion actionInfo) permission + where + adminPermission = ActionPermissionInfo adminRole annBoolExpTrue + permissions = Map.insert adminRole adminPermission $ _aiPermissions actionInfo + +mkActionsSchema + :: ActionCache + -> Map.HashMap RoleName (RootFields, TyAgg) +mkActionsSchema = + foldr (\actionInfo aggregate -> + Map.foldrWithKey f aggregate $ mkActionSchemaOne actionInfo) + mempty + where + -- we'll need to add uuid and timestamptz for actions + newRoleState = (mempty, addScalarToTyAgg PGTimeStampTZ $ + addScalarToTyAgg PGUUID mempty) + f roleName (queryFieldM, mutationField) = + Map.alter (Just . addToState . fromMaybe newRoleState) roleName + where + addToState = case queryFieldM of + Just (fldCtx, fldDefinition, responseTypeInfo) -> + addToStateAsync (fldCtx, fldDefinition) responseTypeInfo + Nothing -> addToStateSync + addToStateSync (rootFields, tyAgg) = + ( addMutationField (first MCAction mutationField) rootFields + , tyAgg + ) + addToStateAsync queryField responseTypeInfo (rootFields, tyAgg) = + ( addMutationField (first MCAction mutationField) $ + addQueryField + (first QCActionFetch queryField) + rootFields + , addTypeInfoToTyAgg responseTypeInfo tyAgg + ) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Builder.hs b/server/src-lib/Hasura/GraphQL/Schema/Builder.hs new file mode 100644 index 0000000000000..0a69680ad4a27 --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Schema/Builder.hs @@ -0,0 +1,75 @@ +module Hasura.GraphQL.Schema.Builder + ( TyAgg(..) + , taTypes + , taFields + , taScalars + , taOrdBy + , addTypeInfoToTyAgg + , addScalarToTyAgg + , RootFields(..) + , addQueryField + , addMutationField + ) where + +import Control.Lens + +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import qualified Language.GraphQL.Draft.Syntax as G + +import Hasura.GraphQL.Resolve.Types +import Hasura.GraphQL.Validate.Types +import Hasura.Prelude +import Hasura.SQL.Types + +-- | A /types aggregate/, which holds role-specific information about visible GraphQL types. +-- Importantly, it holds more than just the information needed by GraphQL: it also includes how the +-- GraphQL types relate to Postgres types, which is used to validate literals provided for +-- Postgres-specific scalars. +data TyAgg + = TyAgg + { _taTypes :: !TypeMap + , _taFields :: !FieldMap + , _taScalars :: !(Set.HashSet PGScalarType) + , _taOrdBy :: !OrdByCtx + } deriving (Show, Eq) +$(makeLenses ''TyAgg) + +addTypeInfoToTyAgg :: TypeInfo -> TyAgg -> TyAgg +addTypeInfoToTyAgg typeInfo tyAgg = + tyAgg & taTypes.at (getNamedTy typeInfo) ?~ typeInfo + +addScalarToTyAgg :: PGScalarType -> TyAgg -> TyAgg +addScalarToTyAgg pgScalarType = + over taScalars (Set.insert pgScalarType) + +instance Semigroup TyAgg where + (TyAgg t1 f1 s1 o1) <> (TyAgg t2 f2 s2 o2) = + TyAgg (Map.union t1 t2) (Map.union f1 f2) + (Set.union s1 s2) (Map.union o1 o2) + +instance Monoid TyAgg where + mempty = TyAgg Map.empty Map.empty Set.empty Map.empty + +-- | A role-specific mapping from root field names to allowed operations. +data RootFields + = RootFields + { _rootQueryFields :: !(Map.HashMap G.Name (QueryCtx, ObjFldInfo)) + , _rootMutationFields :: !(Map.HashMap G.Name (MutationCtx, ObjFldInfo)) + } deriving (Show, Eq) +$(makeLenses ''RootFields) + +addQueryField :: (QueryCtx, ObjFldInfo) -> RootFields -> RootFields +addQueryField v rootFields = + rootFields & rootQueryFields.at (_fiName $ snd v) ?~ v + +addMutationField :: (MutationCtx, ObjFldInfo) -> RootFields -> RootFields +addMutationField v rootFields = + rootFields & rootMutationFields.at (_fiName $ snd v) ?~ v + +instance Semigroup RootFields where + RootFields a1 b1 <> RootFields a2 b2 + = RootFields (Map.union a1 a2) (Map.union b1 b2) + +instance Monoid RootFields where + mempty = RootFields Map.empty Map.empty diff --git a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs index 1582ae13dd9c3..5be76e9435a39 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/InputValue.hs @@ -252,7 +252,7 @@ validateNamedTypeVal inpValParser (nullability, nt) val = do TIEnum eti -> withParsed gType (getEnum inpValParser) val $ fmap (AGEnum nt) . validateEnum eti - TIScalar (ScalarTyInfo _ pgColTy _) -> + TIScalar (ScalarTyInfo _ _ pgColTy _) -> withParsed gType (getScalar inpValParser) val $ fmap (AGScalar pgColTy) . mapM (validateScalar pgColTy) where diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index d721a363da02c..6b7692a60f9c7 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -29,6 +29,7 @@ module Hasura.GraphQL.Validate.Types , mkHsraInpTyInfo , ScalarTyInfo(..) + , fromScalarTyDef , mkHsraScalarTyInfo , DirectiveInfo(..) @@ -172,8 +173,15 @@ type ParamMap = Map.HashMap G.Name InpValInfo data TypeLoc = TLHasuraType | TLRemoteType !RemoteSchemaName !RemoteSchemaInfo + | TLCustom deriving (Show, Eq, TH.Lift, Generic) +$(J.deriveJSON + J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 2 + , J.sumEncoding = J.TaggedObject "type" "detail" + } + ''TypeLoc) + instance Hashable TypeLoc data ObjFldInfo @@ -348,12 +356,14 @@ mkHsraInpTyInfo descM ty flds = data ScalarTyInfo = ScalarTyInfo { _stiDesc :: !(Maybe G.Description) + , _stiName :: !G.Name , _stiType :: !PGScalarType , _stiLoc :: !TypeLoc } deriving (Show, Eq, TH.Lift) mkHsraScalarTyInfo :: PGScalarType -> ScalarTyInfo -mkHsraScalarTyInfo ty = ScalarTyInfo Nothing ty TLHasuraType +mkHsraScalarTyInfo ty = + ScalarTyInfo Nothing (G.Name $ pgColTyToScalar ty) ty TLHasuraType instance EquatableGType ScalarTyInfo where type EqProps ScalarTyInfo = PGScalarType @@ -362,16 +372,17 @@ instance EquatableGType ScalarTyInfo where fromScalarTyDef :: G.ScalarTypeDefinition -> TypeLoc - -> Either Text ScalarTyInfo -fromScalarTyDef (G.ScalarTypeDefinition descM n _) loc = - ScalarTyInfo descM <$> ty <*> pure loc + -> ScalarTyInfo +fromScalarTyDef (G.ScalarTypeDefinition descM n _) = + ScalarTyInfo descM n ty where ty = case n of - "Int" -> return PGInteger - "Float" -> return PGFloat - "String" -> return PGText - "Boolean" -> return PGBoolean - _ -> return $ txtToPgColTy $ G.unName n + "Int" -> PGInteger + "Float" -> PGFloat + "String" -> PGText + "Boolean" -> PGBoolean + "ID" -> PGText + _ -> txtToPgColTy $ G.unName n data TypeInfo = TIScalar !ScalarTyInfo @@ -382,6 +393,18 @@ data TypeInfo | TIUnion !UnionTyInfo deriving (Show, Eq, TH.Lift) +instance J.ToJSON TypeInfo where + toJSON typeInfo = J.String "toJSON not implemented for TypeInfo" + +instance J.FromJSON TypeInfo where + parseJSON value = fail "FromJSON not implemented for TypeInfo" + +-- $(J.deriveJSON +-- J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 2 +-- , J.sumEncoding = J.TaggedObject "type" "detail" +-- } +-- ''TypeInfo) + data AsObjType = AOTObj ObjTyInfo | AOTIFace IFaceTyInfo @@ -585,7 +608,7 @@ mkScalarTy = getNamedTy :: TypeInfo -> G.NamedType getNamedTy = \case - TIScalar t -> mkScalarTy $ _stiType t + TIScalar t -> G.NamedType $ _stiName t TIObj t -> _otiName t TIIFace i -> _ifName i TIEnum t -> _etiName t @@ -598,7 +621,7 @@ mkTyInfoMap tyInfos = fromTyDef :: G.TypeDefinition -> TypeLoc -> Either Text TypeInfo fromTyDef tyDef loc = case tyDef of - G.TypeDefinitionScalar t -> TIScalar <$> fromScalarTyDef t loc + G.TypeDefinitionScalar t -> return $ TIScalar $ fromScalarTyDef t loc G.TypeDefinitionObject t -> return $ TIObj $ fromObjTyDef t loc G.TypeDefinitionInterface t -> return $ TIIFace $ fromIFaceDef t loc diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs new file mode 100644 index 0000000000000..2c077f5dc619c --- /dev/null +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -0,0 +1,261 @@ +module Hasura.RQL.DDL.Action + ( CreateAction + , validateAndCacheAction + , runCreateAction + + , DropAction + , runDropAction + + , fetchActions + + , CreateActionPermission + , validateAndCacheActionPermission + , runCreateActionPermission + + , DropActionPermission + , runDropActionPermission + ) where + +import Hasura.EncJSON +import Hasura.GraphQL.Utils +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.SQL.Types + +import qualified Hasura.GraphQL.Validate.Types as VT + +import qualified Data.Aeson as J +import qualified Data.Aeson.Casing as J +import qualified Data.Aeson.TH as J +import qualified Data.HashMap.Strict as Map +import qualified Database.PG.Query as Q +import qualified Language.GraphQL.Draft.Syntax as G + +import Language.Haskell.TH.Syntax (Lift) +-- data RetryConf +-- = RetryConf +-- { _rcNumRetries :: !Word64 +-- , _rcIntervalSec :: !Word64 +-- , _rcTimeoutSec :: !(Maybe Word64) +-- } deriving (Show, Eq, Lift) + +-- data WebhookConf +-- = WebhookConf +-- { _wcUrl :: !Text +-- , _wcTimeout :: !Word64 +-- , _wcRetry :: !RetryConf +-- } deriving (Show, Eq) + +getActionInfo + :: (QErrM m, CacheRM m) + => ActionName -> m ActionInfo +getActionInfo actionName = do + actionMap <- scActions <$> askSchemaCache + case Map.lookup actionName actionMap of + Just actionInfo -> return actionInfo + Nothing -> + throw400 NotExists $ + "action with name " <> actionName <<> " does not exist" + +runCreateAction + :: ( QErrM m, UserInfoM m + , CacheRWM m, MonadTx m + ) + => CreateAction -> m EncJSON +runCreateAction q@(CreateAction actionName actionDefinition comment) = do + adminOnly + validateAndCacheAction q + persistCreateAction + return successMsg + where + persistCreateAction :: (MonadTx m) => m () + persistCreateAction = do + liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql| + INSERT into hdb_catalog.hdb_action + (action_name, action_defn, comment) + VALUES ($1, $2, $3) + |] (actionName, Q.AltJ actionDefinition, comment) True + +validateAndCacheAction + :: (QErrM m, CacheRWM m) + => CreateAction -> m () +validateAndCacheAction q = do + actionMap <- scActions <$> askSchemaCache + onJust (Map.lookup actionName actionMap) $ + const $ throw400 AlreadyExists $ + "action with name " <> actionName <<> " already exists" + actionInfo <- buildActionInfo q + addActionToCache actionInfo + where + actionName = _caName q + +buildActionInfo + :: (QErrM m, CacheRM m) + => CreateAction -> m ActionInfo +buildActionInfo q = do + let inputBaseType = G.getBaseType $ unGraphQLType $ _adInputType actionDefinition + responseType = unGraphQLType $ _adOutputType actionDefinition + responseBaseType = G.getBaseType responseType + inputTypeInfo <- getCustomTypeInfo inputBaseType + case inputTypeInfo of + VT.TIScalar _ -> return () + VT.TIEnum _ -> return () + VT.TIInpObj _ -> return () + _ -> throw400 InvalidParams $ "the input type: " + <> showNamedTy inputBaseType <> + " should be a scalar/enum/input_object" + when (hasList responseType) $ throw400 InvalidParams $ + "the output type: " <> G.showGT responseType <> " cannot be a list" + responseTypeInfo <- getCustomTypeInfo responseBaseType + case responseTypeInfo of + VT.TIScalar _ -> return () + VT.TIEnum _ -> return () + VT.TIObj _ -> return () + _ -> throw400 InvalidParams $ "the output type: " <> + showNamedTy responseBaseType <> + " should be a scalar/enum/object" + return $ ActionInfo actionName actionDefinition mempty + where + getCustomTypeInfo typeName = do + customTypes <- scCustomTypes <$> askSchemaCache + onNothing (Map.lookup typeName customTypes) $ + throw400 NotExists $ "the type: " <> showNamedTy typeName <> + " is not defined in custom types" + CreateAction actionName actionDefinition _ = q + + hasList = \case + G.TypeList _ _ -> True + G.TypeNamed _ _ -> False + +data DropAction + = DropAction + { _daName :: !ActionName + , _daClearData :: !(Maybe Bool) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''DropAction) + +runDropAction + :: (QErrM m, UserInfoM m, CacheRWM m, MonadTx m) + => DropAction -> m EncJSON +runDropAction (DropAction actionName clearDataM)= do + adminOnly + void $ getActionInfo actionName + delActionFromCache actionName + liftTx $ do + deleteActionFromCatalog + when clearData clearActionData + return successMsg + where + -- When clearData is not present we assume that + -- the data needs to be retained + clearData = fromMaybe False clearDataM + + deleteActionFromCatalog :: Q.TxE QErr () + deleteActionFromCatalog = + Q.unitQE defaultTxErrorHandler [Q.sql| + DELETE FROM hdb_catalog.hdb_action + WHERE action_name = $1 + |] (Identity actionName) True + + clearActionData :: Q.TxE QErr () + clearActionData = + Q.unitQE defaultTxErrorHandler [Q.sql| + DELETE FROM hdb_catalog.hdb_action_log + WHERE action_name = $1 + |] (Identity actionName) True + +fetchActions :: Q.TxE QErr [CreateAction] +fetchActions = + map fromRow <$> Q.listQE defaultTxErrorHandler + [Q.sql| + SELECT action_name, action_defn, comment + FROM hdb_catalog.hdb_action + |] () True + where + fromRow (actionName, Q.AltJ definition, comment) = + CreateAction actionName definition comment + +newtype ActionMetadataField + = ActionMetadataField { unActionMetadataField :: Text } + deriving (Show, Eq, J.FromJSON, J.ToJSON) + + +validateAndCacheActionPermission + :: (QErrM m, CacheRWM m, MonadTx m) + => CreateActionPermission -> m () +validateAndCacheActionPermission createActionPermission = do + actionInfo <- getActionInfo actionName + onJust (Map.lookup role $ _aiPermissions actionInfo) $ \_ -> + throw400 AlreadyExists $ + "permission for role: " <> role <<> " is already defined on " <>> actionName + actionFilter <- buildActionFilter (_apdSelect permissionDefinition) + addActionPermissionToCache actionName $ + ActionPermissionInfo role actionFilter + where + actionName = _capAction createActionPermission + role = _capRole createActionPermission + permissionDefinition = _capDefinition createActionPermission + -- TODO + buildActionFilter + :: (QErrM m) + => ActionPermissionSelect + -> m AnnBoolExpPartialSQL + buildActionFilter permission = undefined + +runCreateActionPermission + :: ( QErrM m, UserInfoM m + , CacheRWM m, MonadTx m + ) + => CreateActionPermission -> m EncJSON +runCreateActionPermission createActionPermission = do + adminOnly + validateAndCacheActionPermission createActionPermission + persistCreateActionPermission + return successMsg + where + actionName = _capAction createActionPermission + role = _capRole createActionPermission + permissionDefinition = _capDefinition createActionPermission + comment = _capComment createActionPermission + + persistCreateActionPermission :: (MonadTx m) => m () + persistCreateActionPermission = do + liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql| + INSERT into hdb_catalog.hdb_action_permission + (action_name, role_name, definition, comment) + VALUES ($1, $2, $3) + |] (actionName, role, Q.AltJ permissionDefinition, comment) True + +data DropActionPermission + = DropActionPermission + { _dapAction :: !ActionName + , _dapRole :: !RoleName + -- , _capIfExists :: !(Maybe IfExists) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''DropActionPermission) + +runDropActionPermission + :: ( QErrM m, UserInfoM m + , CacheRWM m, MonadTx m + ) + => DropActionPermission -> m EncJSON +runDropActionPermission dropActionPermission = do + adminOnly + actionInfo <- getActionInfo actionName + void $ onNothing (Map.lookup role $ _aiPermissions actionInfo) $ + throw400 NotExists $ + "permission for role: " <> role <<> " is not defined on " <>> actionName + delActionPermissionFromCache actionName role + liftTx deleteActionPermissionFromCatalog + return successMsg + where + actionName = _dapAction dropActionPermission + role = _dapRole dropActionPermission + + deleteActionPermissionFromCatalog :: Q.TxE QErr () + deleteActionPermissionFromCatalog = + Q.unitQE defaultTxErrorHandler [Q.sql| + DELETE FROM hdb_catalog.hdb_action_permission + WHERE action_name = $1 + AND role_name = $2 + |] (actionName, role) True diff --git a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs new file mode 100644 index 0000000000000..5be0ef68279a3 --- /dev/null +++ b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs @@ -0,0 +1,256 @@ +module Hasura.RQL.DDL.CustomTypes + ( runSetCustomTypes + , clearCustomTypes + , validateCustomTypesAndAddToCache + ) where + +import Control.Monad.Validate + +import qualified Data.HashSet as Set +import qualified Data.List.Extended as L +import qualified Data.Text as T +import qualified Database.PG.Query as Q +import qualified Language.GraphQL.Draft.Syntax as G + +import Hasura.EncJSON +import Hasura.Prelude +import Hasura.RQL.Types + +import qualified Hasura.GraphQL.Validate.Types as VT + +validateCustomTypeDefinitions + :: (MonadValidate [CustomTypeValidationError] m) + => CustomTypes -> m () +validateCustomTypeDefinitions customTypes = do + unless (null duplicateTypes) $ dispute $ pure $ DuplicateTypeNames duplicateTypes + traverse_ validateEnum enumDefinitions + traverse_ validateInputObject inputObjectDefinitions + traverse_ validateObject objectDefinitions + where + inputObjectDefinitions = fromMaybe [] $ _ctInputObjects customTypes + objectDefinitions = fromMaybe [] $ _ctObjects customTypes + scalarDefinitions = fromMaybe [] $ _ctScalars customTypes + enumDefinitions = fromMaybe [] $ _ctEnums customTypes + + duplicateTypes = L.duplicates allTypes + allTypes = + map _stdName scalarDefinitions <> + map (unEnumTypeName . _etdName) enumDefinitions <> + map (unInputObjectTypeName . _iotdName) inputObjectDefinitions <> + map (unObjectTypeName . _otdName) objectDefinitions + + -- TODO: add default types + scalarAndEnumTypes = + Set.fromList $ + map _stdName scalarDefinitions <> defaultScalars <> + map (unEnumTypeName . _etdName) enumDefinitions + + -- TODO + defaultScalars = map G.NamedType ["Int", "Float", "String", "Boolean"] + + validateEnum + :: (MonadValidate [CustomTypeValidationError] m) + => EnumTypeDefinition -> m () + validateEnum enumDefinition = do + let duplicateEnumValues = L.duplicates $ map _evdValue $ toList $ + _etdValues enumDefinition + -- check for duplicate field names + unless (null duplicateEnumValues) $ + dispute $ pure $ DuplicateEnumValues + (_etdName enumDefinition) duplicateEnumValues + + validateInputObject + :: (MonadValidate [CustomTypeValidationError] m) + => InputObjectTypeDefinition -> m () + validateInputObject inputObjectDefinition = do + let inputObjectTypeName = _iotdName inputObjectDefinition + duplicateFieldNames = + L.duplicates $ map _iofdName $ toList $ + _iotdFields inputObjectDefinition + + -- check for duplicate field names + unless (null duplicateFieldNames) $ + dispute $ pure $ InputObjectDuplicateFields + inputObjectTypeName duplicateFieldNames + + let inputTypes = scalarAndEnumTypes `Set.union` Set.fromList + (map (unInputObjectTypeName . _iotdName) inputObjectDefinitions) + -- check that fields reference input types + for_ (_iotdFields inputObjectDefinition) $ + \inputObjectField -> do + let fieldBaseType = G.getBaseType $ unGraphQLType $ _iofdType inputObjectField + unless (Set.member fieldBaseType inputTypes) $ + refute $ pure $ InputObjectFieldTypeDoesNotExist + (_iotdName inputObjectDefinition) + (_iofdName inputObjectField) fieldBaseType + + validateObject + :: (MonadValidate [CustomTypeValidationError] m) + => ObjectTypeDefinition -> m () + validateObject objectDefinition = do + let objectTypeName = _otdName objectDefinition + duplicateFieldNames = + L.duplicates $ map _ofdName $ toList $ _otdFields objectDefinition + + -- check for duplicate field names + unless (null duplicateFieldNames) $ + dispute $ pure $ ObjectDuplicateFields objectTypeName duplicateFieldNames + + for_ (_otdFields objectDefinition) $ + \objectField -> do + let fieldBaseType = G.getBaseType $ unGraphQLType $ _ofdType objectField + fieldName = _ofdName objectField + + -- check that arguments are not defined + when (isJust $ _ofdArguments objectField) $ + dispute $ pure $ ObjectFieldArgumentsNotAllowed + objectTypeName fieldName + + let objectTypes = Set.fromList $ map (unObjectTypeName . _otdName) + objectDefinitions + -- check that the fields only reference scalars and enums + -- and not other object types + if | Set.member fieldBaseType scalarAndEnumTypes -> return () + | Set.member fieldBaseType objectTypes -> + dispute $ pure $ ObjectFieldObjectBaseType + objectTypeName fieldName fieldBaseType + | otherwise -> + dispute $ pure $ ObjectFieldTypeDoesNotExist + objectTypeName fieldName fieldBaseType + +data CustomTypeValidationError + -- ^ type names have to be unique across all types + = DuplicateTypeNames !(Set.HashSet G.NamedType) + -- ^ field name and the field's base type + | InputObjectFieldTypeDoesNotExist + !InputObjectTypeName !InputObjectFieldName !G.NamedType + -- ^ duplicate field declaration in input objects + | InputObjectDuplicateFields + !InputObjectTypeName !(Set.HashSet InputObjectFieldName) + -- ^ field name and the field's base type + | ObjectFieldTypeDoesNotExist + !ObjectTypeName !ObjectFieldName !G.NamedType + -- ^ duplicate field declaration in objects + | ObjectDuplicateFields !ObjectTypeName !(Set.HashSet ObjectFieldName) + -- ^ object fields can't have arguments + | ObjectFieldArgumentsNotAllowed !ObjectTypeName !ObjectFieldName + -- ^ object fields can't have object types as base types + | ObjectFieldObjectBaseType !ObjectTypeName !ObjectFieldName !G.NamedType + -- ^ duplicate enum values + | DuplicateEnumValues !EnumTypeName !(Set.HashSet G.EnumValue) + deriving (Show, Eq) + +showCustomTypeValidationError + :: CustomTypeValidationError -> T.Text +showCustomTypeValidationError = + -- TODO + T.pack . show + +runSetCustomTypes + :: ( MonadError QErr m + , UserInfoM m + , CacheRWM m + , MonadTx m + ) + => CustomTypes -> m EncJSON +runSetCustomTypes customTypes = do + adminOnly + validateCustomTypesAndAddToCache customTypes + persistCustomTypes + return successMsg + where + persistCustomTypes :: (MonadTx m) => m () + persistCustomTypes = liftTx $ do + clearCustomTypes + Q.unitQE defaultTxErrorHandler [Q.sql| + INSERT into hdb_catalog.hdb_custom_graphql_types + (custom_types) + VALUES ($1) + |] (Identity $ Q.AltJ customTypes) False + +clearCustomTypes :: Q.TxE QErr () +clearCustomTypes = do + Q.unitQE defaultTxErrorHandler [Q.sql| + DELETE FROM hdb_catalog.hdb_custom_graphql_types + |] () False + +validateCustomTypesAndAddToCache + :: ( MonadError QErr m + , CacheRWM m + ) + => CustomTypes -> m () +validateCustomTypesAndAddToCache customTypes = do + either (throw400 ConstraintViolation . showErrors) pure + =<< runValidateT (validateCustomTypeDefinitions customTypes) + let typeInfos = + map (VT.TIEnum . convertEnumDefinition) enumDefinitions <> + map (VT.TIObj . convertObjectDefinition) objectDefinitions <> + map (VT.TIInpObj . convertInputObjectDefinition) inputObjectDefinitions <> + map (VT.TIScalar . convertScalarDefinition) scalarDefinitions + setCustomTypesInCache $ VT.mapFromL VT.getNamedTy typeInfos + where + inputObjectDefinitions = fromMaybe [] $ _ctInputObjects customTypes + objectDefinitions = fromMaybe [] $ _ctObjects customTypes + scalarDefinitions = fromMaybe [] $ _ctScalars customTypes + enumDefinitions = fromMaybe [] $ _ctEnums customTypes + + showErrors :: [CustomTypeValidationError] -> T.Text + showErrors allErrors = + "validation for the given custom types failed " <> reasonsMessage + where + reasonsMessage = case allErrors of + [singleError] -> "because " <> showCustomTypeValidationError singleError + _ -> "for the following reasons:\n" <> T.unlines + (map ((" • " <>) . showCustomTypeValidationError) allErrors) + + convertScalarDefinition scalarDefinition = + flip VT.fromScalarTyDef VT.TLCustom $ G.ScalarTypeDefinition + (_stdDescription scalarDefinition) + (G.unNamedType $ _stdName scalarDefinition) mempty + + convertEnumDefinition enumDefinition = + VT.EnumTyInfo (_etdDescription enumDefinition) + (unEnumTypeName $ _etdName enumDefinition) + (VT.EnumValuesSynthetic $ VT.mapFromL VT._eviVal $ + map convertEnumValueDefinition $ toList $ _etdValues enumDefinition) + VT.TLCustom + where + convertEnumValueDefinition enumValueDefinition = + VT.EnumValInfo (_evdDescription enumValueDefinition) + (_evdValue enumValueDefinition) + (fromMaybe False $ _evdIsDeprecated enumValueDefinition) + + convertObjectDefinition objectDefinition = + VT.ObjTyInfo + { VT._otiDesc = _otdDescription objectDefinition + , VT._otiName = unObjectTypeName $ _otdName objectDefinition + , VT._otiImplIFaces = mempty + , VT._otiFields = VT.mapFromL VT._fiName $ map convertObjectFieldDefinition $ + toList $ _otdFields objectDefinition + } + where + convertObjectFieldDefinition fieldDefinition = + VT.ObjFldInfo + { VT._fiDesc = _ofdDescription fieldDefinition + , VT._fiName = unObjectFieldName $ _ofdName fieldDefinition + , VT._fiParams = mempty + , VT._fiTy = unGraphQLType $ _ofdType fieldDefinition + , VT._fiLoc = VT.TLCustom + } + + convertInputObjectDefinition inputObjectDefinition = + VT.InpObjTyInfo + { VT._iotiDesc = _iotdDescription inputObjectDefinition + , VT._iotiName = unInputObjectTypeName $ _iotdName inputObjectDefinition + , VT._iotiFields = VT.mapFromL VT._iviName $ map convertInputFieldDefinition $ + toList $ _iotdFields inputObjectDefinition + , VT._iotiLoc = VT.TLCustom + } + where + convertInputFieldDefinition fieldDefinition = + VT.InpValInfo + { VT._iviDesc = _iofdDescription fieldDefinition + , VT._iviName = unInputObjectFieldName $ _iofdName fieldDefinition + , VT._iviDefVal = Nothing + , VT._iviType = unGraphQLType $ _iofdType fieldDefinition + } diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index 7365cfaee5eba..3f8b990333c8a 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -41,6 +41,7 @@ import Hasura.RQL.Types import Hasura.SQL.Types import qualified Database.PG.Query as Q +import qualified Hasura.RQL.DDL.CustomTypes as DC import qualified Hasura.RQL.DDL.EventTrigger as DE import qualified Hasura.RQL.DDL.Permission as DP import qualified Hasura.RQL.DDL.Permission.Internal as DP @@ -286,7 +287,7 @@ applyQP2 (ReplaceMetadata tables mFunctions mSchemas mCollections mAllowlist) = indexedMapM_ (void . DRS.addRemoteSchemaP2) schemas -- build GraphQL Context with Remote schemas - DRS.buildGCtxMap + DS.buildGCtxMap return successMsg @@ -516,6 +517,7 @@ purgeMetadataObj = liftTx . \case (MOTable qt) -> DS.deleteTableFromCatalog qt (MOFunction qf) -> DS.delFunctionFromCatalog qf (MORemoteSchema rsn) -> DRS.removeRemoteSchemaFromCatalog rsn + (MOCustomTypes) -> DC.clearCustomTypes (MOTableObj qt (MTORel rn _)) -> DR.delRelFromCatalog qt rn (MOTableObj qt (MTOPerm rn pt)) -> DP.dropPermFromCatalog qt rn pt (MOTableObj _ (MTOTrigger trn)) -> DE.delEventTriggerFromCatalog trn diff --git a/server/src-lib/Hasura/RQL/DDL/RemoteSchema.hs b/server/src-lib/Hasura/RQL/DDL/RemoteSchema.hs index e51c1e9ce9004..395413b58a575 100644 --- a/server/src-lib/Hasura/RQL/DDL/RemoteSchema.hs +++ b/server/src-lib/Hasura/RQL/DDL/RemoteSchema.hs @@ -3,7 +3,6 @@ module Hasura.RQL.DDL.RemoteSchema , runRemoveRemoteSchema , removeRemoteSchemaFromCatalog , runReloadRemoteSchema - , buildGCtxMap , fetchRemoteSchemas , addRemoteSchemaP1 , addRemoteSchemaP2Setup @@ -21,8 +20,6 @@ import Hasura.GraphQL.RemoteServer import Hasura.RQL.Types import Hasura.SQL.Types -import qualified Hasura.GraphQL.Schema as GS - runAddRemoteSchema :: ( QErrM m, UserInfoM m , CacheRWM m, MonadTx m @@ -115,20 +112,6 @@ runReloadRemoteSchema (RemoteSchemaNameQuery name) = do addRemoteSchemaToCache $ RemoteSchemaCtx name gCtx rsi return successMsg --- | build GraphQL schema -buildGCtxMap - :: (QErrM m, CacheRWM m) => m () -buildGCtxMap = do - -- build GraphQL Context with Hasura schema - GS.buildGCtxMapPG - sc <- askSchemaCache - let gCtxMap = scGCtxMap sc - -- Stitch remote schemas - (mergedGCtxMap, defGCtx) <- mergeSchemas (scRemoteSchemas sc) gCtxMap - writeSchemaCache sc { scGCtxMap = mergedGCtxMap - , scDefaultRemoteGCtx = defGCtx - } - addRemoteSchemaToCatalog :: AddRemoteSchemaQuery -> Q.TxE QErr () diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index 7481707dce361..7fa3feef9bac0 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -8,6 +8,7 @@ trigger schema cache rebuilds. -} module Hasura.RQL.DDL.Schema.Cache ( CacheBuildM , buildSchemaCache + , buildGCtxMap , buildSchemaCacheFor , buildSchemaCacheStrict , buildSchemaCacheWithoutSetup @@ -30,9 +31,14 @@ import qualified Database.PG.Query as Q import Data.Aeson import qualified Hasura.GraphQL.Schema as GS +import qualified Hasura.GraphQL.Validate.Types as VT +import qualified Language.GraphQL.Draft.Syntax as G import Hasura.Db import Hasura.GraphQL.RemoteServer +import Hasura.GraphQL.Utils (showNames) +import Hasura.RQL.DDL.Action +import Hasura.RQL.DDL.CustomTypes import Hasura.RQL.DDL.Deps import Hasura.RQL.DDL.EventTrigger import Hasura.RQL.DDL.Permission @@ -68,7 +74,8 @@ buildSchemaCacheWithOptions withSetup = do -- fetch all catalog metadata CatalogMetadata tables relationships permissions - eventTriggers remoteSchemas functions fkeys' allowlistDefs + eventTriggers remoteSchemas functions fkeys' allowlistDefs customTypes + actions actionPermissions <- liftTx fetchCatalogData let fkeys = HS.fromList fkeys' @@ -134,12 +141,31 @@ buildSchemaCacheWithOptions withSetup = do -- allow list replaceAllowlist $ concatMap _cdQueries allowlistDefs + -- TODO: all of this needs to change + validateCustomTypesAndAddToCache customTypes + mapM_ validateAndCacheAction actions + mapM_ validateAndCacheActionPermission actionPermissions + -- build GraphQL context with tables and functions GS.buildGCtxMapPG -- remote schemas forM_ remoteSchemas resolveSingleRemoteSchema + -- custom types + let mkInconistentCustomTypes = + InconsistentMetadataObj MOCustomTypes MOTCustomTypes $ toJSON customTypes + withSchemaObject_ mkInconistentCustomTypes $ do + validateCustomTypesAndAddToCache customTypes + -- TODO + sc <- askSchemaCache + (finalGCtxMap, finalDefaultGCtx) <- + mergeCustomTypes (scGCtxMap sc) (scDefaultRemoteGCtx sc) $ scCustomTypes sc + writeSchemaCache + sc { scGCtxMap = finalGCtxMap + , scDefaultRemoteGCtx = finalDefaultGCtx + } + where permHelper setup sqlGenCtx qt rn pDef pa = do qCtx <- mkAdminQCtx sqlGenCtx <$> askSchemaCache @@ -167,6 +193,57 @@ buildSchemaCacheWithOptions withSetup = do , scDefaultRemoteGCtx = mergedDefGCtx } +-- | build GraphQL schema +buildGCtxMap + :: (QErrM m, CacheRWM m) => m () +buildGCtxMap = do + -- build GraphQL Context with Hasura schema + GS.buildGCtxMapPG + sc <- askSchemaCache + let gCtxMap = scGCtxMap sc + -- Stitch remote schemas + (mergedGCtxMap, defGCtx) <- mergeSchemas (scRemoteSchemas sc) gCtxMap + + -- ensure that there are no conflicts between autogenerated types + -- and custom types + (finalGCtxMap, finalDefaultGCtx) <- + mergeCustomTypes mergedGCtxMap defGCtx $ scCustomTypes sc + + writeSchemaCache + sc { scGCtxMap = finalGCtxMap + , scDefaultRemoteGCtx = finalDefaultGCtx + } + +mergeCustomTypes + :: MonadError QErr f + => M.HashMap RoleName GS.GCtx -> GS.GCtx -> VT.TypeMap + -> f (GS.GCtxMap, GS.GCtx) +mergeCustomTypes gCtxMap remoteSchemaCtx customTypes = do + let commonTypes = M.intersectionWith (,) existingTypes customTypes + conflictingCustomTypes = + map (G.unNamedType . fst) $ M.toList $ + flip M.filter commonTypes $ \case + -- only scalars can be common + (VT.TIScalar _, VT.TIScalar _) -> False + (_, _) -> True + unless (null conflictingCustomTypes) $ + throw400 InvalidCustomTypes $ + "following custom types confilct with the " <> + "autogenerated hasura types or from remote schemas: " + <> showNames conflictingCustomTypes + + -- populate the gctx of each role with the custom types + return ( fmap addCustomTypes gCtxMap + , addCustomTypes remoteSchemaCtx + ) + where + addCustomTypes gCtx = + gCtx { GS._gTypes = GS._gTypes gCtx <> customTypes} + existingTypes = + case (M.lookup adminRole gCtxMap) of + Just gCtx -> GS._gTypes gCtx + Nothing -> GS._gTypes remoteSchemaCtx + -- | Rebuilds the schema cache. If an object with the given object id became newly inconsistent, -- raises an error about it specifically. Otherwise, raises a generic metadata inconsistency error. buildSchemaCacheFor :: (CacheBuildM m) => MetadataObjId -> m () diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs index 34abb427e0ded..43b58839e3676 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Catalog.hs @@ -22,7 +22,8 @@ import Hasura.RQL.Types.SchemaCache import Hasura.SQL.Types fetchCatalogData :: (MonadTx m) => m CatalogMetadata -fetchCatalogData = liftTx $ Q.getAltJ . runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler +fetchCatalogData = + liftTx $ Q.getAltJ . runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler $(Q.sqlFromFile "src-rsr/catalog_metadata.sql") () True saveTableToCatalog :: (MonadTx m) => QualifiedTable -> SystemDefined -> Bool -> TableConfig -> m () diff --git a/server/src-lib/Hasura/RQL/DML/Internal.hs b/server/src-lib/Hasura/RQL/DML/Internal.hs index 4f1e881b4c709..0e1c4fb286e6e 100644 --- a/server/src-lib/Hasura/RQL/DML/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Internal.hs @@ -213,7 +213,7 @@ convPartialSQLExp -> f S.SQLExp convPartialSQLExp f = \case PSESQLExp sqlExp -> pure sqlExp - PSESessVar colTy sessVar -> f colTy sessVar + PSESessVar colTy sessionVariable -> f colTy sessionVariable sessVarFromCurrentSetting :: (Applicative f) => PGType PGScalarType -> SessVar -> f S.SQLExp @@ -228,8 +228,8 @@ sessVarFromCurrentSetting' ty sessVar = PGTypeArray _ -> sessVarVal where curSess = S.SEUnsafe "current_setting('hasura.user')::json" - sessVarVal = S.SEOpApp (S.SQLOp "->>") - [curSess, S.SELit $ T.toLower sessVar] + sessVarVal = + S.SEOpApp (S.SQLOp "->>") [curSess, S.SELit $ T.toLower sessVar] checkSelPerm :: (UserInfoM m, QErrM m, CacheRM m) diff --git a/server/src-lib/Hasura/RQL/Types.hs b/server/src-lib/Hasura/RQL/Types.hs index b11c2b3c5fdbe..130fc2d40c008 100644 --- a/server/src-lib/Hasura/RQL/Types.hs +++ b/server/src-lib/Hasura/RQL/Types.hs @@ -40,6 +40,7 @@ module Hasura.RQL.Types import Hasura.Db as R import Hasura.EncJSON import Hasura.Prelude +import Hasura.RQL.Types.Action as R import Hasura.RQL.Types.BoolExp as R import Hasura.RQL.Types.Column as R import Hasura.RQL.Types.Common as R @@ -50,6 +51,7 @@ import Hasura.RQL.Types.Metadata as R import Hasura.RQL.Types.Permission as R import Hasura.RQL.Types.RemoteSchema as R import Hasura.RQL.Types.SchemaCache as R +import Hasura.RQL.Types.CustomTypes as R import Hasura.SQL.Types import qualified Hasura.GraphQL.Context as GC diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs new file mode 100644 index 0000000000000..4e40b893d3615 --- /dev/null +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -0,0 +1,127 @@ +module Hasura.RQL.Types.Action + ( ActionInfo(..) + , ActionName(..) + + , ActionKind(..) + , ActionDefinition(..) + , getActionKind + , CreateAction(..) + , ActionDefinitionInput + + , ResolvedActionDefinition + + , ActionPermissionInfo(..) + + , ActionPermissionMap + + , ActionPermissionSelect(..) + , ActionPermissionDefinition(..) + , CreateActionPermission(..) + ) where + + +import Hasura.Prelude +import Hasura.RQL.Types.BoolExp +import Hasura.RQL.Types.CustomTypes +import Hasura.RQL.Types.DML +import Hasura.RQL.Types.Permission +import Hasura.SQL.Types +import Language.Haskell.TH.Syntax (Lift) + +import qualified Data.Aeson as J +import qualified Data.Aeson.Casing as J +import qualified Data.Aeson.TH as J +import qualified Data.HashMap.Strict as Map +import qualified Database.PG.Query as Q +import qualified Language.GraphQL.Draft.Syntax as G + +newtype ActionName + = ActionName { unActionName :: G.Name } + deriving ( Show, Eq, J.FromJSON, J.ToJSON, J.FromJSONKey, J.ToJSONKey + , Hashable, DQuote, Lift) + +instance Q.FromCol ActionName where + fromCol bs = ActionName . G.Name <$> Q.fromCol bs + +instance Q.ToPrepArg ActionName where + toPrepVal = Q.toPrepVal . G.unName . unActionName + +type ResolvedWebhook = Text + +data ActionKind + = ActionSynchronous + | ActionAsynchronous + deriving (Show, Eq, Lift) +$(J.deriveJSON + J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 6} + ''ActionKind) + +data ActionDefinition a + = ActionDefinition + { _adInputType :: !GraphQLType + , _adOutputType :: !GraphQLType + , _adKind :: !(Maybe ActionKind) + , _adWebhook :: !a + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ActionDefinition) + +getActionKind :: ActionDefinition a -> ActionKind +getActionKind = fromMaybe ActionSynchronous . _adKind + +type ResolvedActionDefinition = ActionDefinition ResolvedWebhook + +data ActionPermissionInfo + = ActionPermissionInfo + { _apiRole :: !RoleName + , _apiFilter :: !AnnBoolExpPartialSQL + } deriving (Show, Eq) +$(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ActionPermissionInfo) + +type ActionPermissionMap + = Map.HashMap RoleName ActionPermissionInfo + +data ActionMetadataField + = ActionMetadataFieldId + | ActionMetadataFieldCreatedAt + | ActionMetadataFieldStatus + deriving (Show, Eq) + +data ActionInfo + = ActionInfo + { _aiName :: !ActionName + , _aiDefintion :: !ResolvedActionDefinition + , _aiPermissions :: !ActionPermissionMap + } deriving (Show, Eq) +$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionInfo) + +type InputWebhook = Text +type ActionDefinitionInput = ActionDefinition InputWebhook + +data CreateAction + = CreateAction + { _caName :: !ActionName + , _caDefinition :: !ActionDefinitionInput + , _caComment :: !(Maybe Text) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''CreateAction) + +newtype ActionPermissionSelect + = ActionPermissionSelect + { _apsFilter :: BoolExp + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionPermissionSelect) + +newtype ActionPermissionDefinition + = ActionPermissionDefinition + { _apdSelect :: ActionPermissionSelect + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionPermissionDefinition) + +data CreateActionPermission + = CreateActionPermission + { _capAction :: !ActionName + , _capRole :: !RoleName + , _capDefinition :: !ActionPermissionDefinition + , _capComment :: !(Maybe Text) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''CreateActionPermission) diff --git a/server/src-lib/Hasura/RQL/Types/Catalog.hs b/server/src-lib/Hasura/RQL/Types/Catalog.hs index d112d8dde8ea2..093aea4238531 100644 --- a/server/src-lib/Hasura/RQL/Types/Catalog.hs +++ b/server/src-lib/Hasura/RQL/Types/Catalog.hs @@ -26,6 +26,8 @@ import Hasura.RQL.Types.Permission import Hasura.RQL.Types.QueryCollection import Hasura.RQL.Types.RemoteSchema import Hasura.RQL.Types.SchemaCache +import Hasura.RQL.Types.CustomTypes +import Hasura.RQL.Types.Action import Hasura.SQL.Types data CatalogTableInfo @@ -93,5 +95,8 @@ data CatalogMetadata , _cmFunctions :: ![CatalogFunction] , _cmForeignKeys :: ![ForeignKey] , _cmAllowlistCollections :: ![CollectionDef] + , _cmCustomTypes :: !CustomTypes + , _cmActions :: ![CreateAction] + , _cmActionPermissions :: ![CreateActionPermission] } deriving (Show, Eq) $(deriveJSON (aesonDrop 3 snakeCase) ''CatalogMetadata) diff --git a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs new file mode 100644 index 0000000000000..666b8111b7429 --- /dev/null +++ b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs @@ -0,0 +1,135 @@ +module Hasura.RQL.Types.CustomTypes + ( CustomTypes(..) + , GraphQLType(..) + , EnumTypeName(..) + , EnumValueDefinition(..) + , EnumTypeDefinition(..) + , ScalarTypeDefinition(..) + , InputObjectFieldName(..) + , InputObjectFieldDefinition(..) + , InputObjectTypeName(..) + , InputObjectTypeDefinition(..) + , ObjectFieldName(..) + , ObjectFieldDefinition(..) + , ObjectTypeName(..) + , ObjectTypeDefinition(..) + ) where + +import Language.Haskell.TH.Syntax (Lift) + +import qualified Data.Aeson as J +import qualified Data.Aeson.Casing as J +import qualified Data.Aeson.TH as J +import qualified Data.Text as T + +import qualified Data.List.NonEmpty as NEList +import qualified Language.GraphQL.Draft.Parser as GParse +import qualified Language.GraphQL.Draft.Printer as GPrint +import qualified Language.GraphQL.Draft.Printer.Text as GPrintText +import qualified Language.GraphQL.Draft.Syntax as G + +import Hasura.Prelude + +newtype GraphQLType + = GraphQLType { unGraphQLType :: G.GType } + deriving (Show, Eq, Lift) + +instance J.ToJSON GraphQLType where + toJSON = J.toJSON . GPrintText.render GPrint.graphQLType . unGraphQLType + +instance J.FromJSON GraphQLType where + parseJSON = + J.withText "GraphQLType" $ \t -> + case GParse.parseGraphQLType t of + Left _ -> fail $ "not a valid GraphQL type: " <> T.unpack t + Right a -> return $ GraphQLType a + +newtype InputObjectFieldName + = InputObjectFieldName { unInputObjectFieldName :: G.Name } + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) + +data InputObjectFieldDefinition + = InputObjectFieldDefinition + { _iofdName :: !InputObjectFieldName + , _iofdDescription :: !(Maybe G.Description) + , _iofdType :: !GraphQLType + -- TODO: default + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''InputObjectFieldDefinition) + +newtype InputObjectTypeName + = InputObjectTypeName { unInputObjectTypeName :: G.NamedType } + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) + +data InputObjectTypeDefinition + = InputObjectTypeDefinition + { _iotdName :: !InputObjectTypeName + , _iotdDescription :: !(Maybe G.Description) + , _iotdFields :: !(NEList.NonEmpty InputObjectFieldDefinition) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''InputObjectTypeDefinition) + +newtype ObjectFieldName + = ObjectFieldName { unObjectFieldName :: G.Name } + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) + +data ObjectFieldDefinition + = ObjectFieldDefinition + { _ofdName :: !ObjectFieldName + -- we don't care about field arguments/directives + -- as objectDefinitions types are only used as the return + -- type of a webhook response and as such the extra + -- context will be hard to pass to the webhook + , _ofdArguments :: !(Maybe J.Value) + , _ofdDescription :: !(Maybe G.Description) + , _ofdType :: !GraphQLType + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectFieldDefinition) + +newtype ObjectTypeName + = ObjectTypeName { unObjectTypeName :: G.NamedType } + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) + +data ObjectTypeDefinition + = ObjectTypeDefinition + { _otdName :: !ObjectTypeName + , _otdDescription :: !(Maybe G.Description) + , _otdFields :: !(NEList.NonEmpty ObjectFieldDefinition) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectTypeDefinition) + +data ScalarTypeDefinition + = ScalarTypeDefinition + { _stdName :: !G.NamedType + , _stdDescription :: !(Maybe G.Description) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ScalarTypeDefinition) + +newtype EnumTypeName + = EnumTypeName { unEnumTypeName :: G.NamedType } + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) + +data EnumValueDefinition + = EnumValueDefinition + { _evdValue :: !G.EnumValue + , _evdDescription :: !(Maybe G.Description) + , _evdIsDeprecated :: !(Maybe Bool) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''EnumValueDefinition) + +data EnumTypeDefinition + = EnumTypeDefinition + { _etdName :: !EnumTypeName + , _etdDescription :: !(Maybe G.Description) + , _etdValues :: !(NEList.NonEmpty EnumValueDefinition) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''EnumTypeDefinition) + +data CustomTypes + = CustomTypes + { _ctInputObjects :: !(Maybe [InputObjectTypeDefinition]) + , _ctObjects :: !(Maybe [ObjectTypeDefinition]) + , _ctScalars :: !(Maybe [ScalarTypeDefinition]) + , _ctEnums :: !(Maybe [EnumTypeDefinition]) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''CustomTypes) diff --git a/server/src-lib/Hasura/RQL/Types/Error.hs b/server/src-lib/Hasura/RQL/Types/Error.hs index af9352b065600..364fdb4f3e341 100644 --- a/server/src-lib/Hasura/RQL/Types/Error.hs +++ b/server/src-lib/Hasura/RQL/Types/Error.hs @@ -85,6 +85,7 @@ data Code | RemoteSchemaConflicts -- Websocket/Subscription errors | StartFailed + | InvalidCustomTypes deriving (Eq) instance Show Code where @@ -123,6 +124,7 @@ instance Show Code where RemoteSchemaError -> "remote-schema-error" RemoteSchemaConflicts -> "remote-schema-conflicts" StartFailed -> "start-failed" + InvalidCustomTypes -> "invalid-custom-types" data QErr = QErr diff --git a/server/src-lib/Hasura/RQL/Types/Metadata.hs b/server/src-lib/Hasura/RQL/Types/Metadata.hs index ff890eab4c3ed..0e0cccbac2eae 100644 --- a/server/src-lib/Hasura/RQL/Types/Metadata.hs +++ b/server/src-lib/Hasura/RQL/Types/Metadata.hs @@ -18,6 +18,7 @@ data MetadataObjType | MOTEventTrigger | MOTFunction | MOTRemoteSchema + | MOTCustomTypes deriving (Eq, Generic) instance Hashable MetadataObjType @@ -28,6 +29,7 @@ instance Show MetadataObjType where show MOTEventTrigger = "event_trigger" show MOTFunction = "function" show MOTRemoteSchema = "remote_schema" + show MOTCustomTypes = "custom_types" instance ToJSON MetadataObjType where toJSON = String . T.pack . show @@ -44,6 +46,7 @@ data MetadataObjId | MOFunction !QualifiedFunction | MORemoteSchema !RemoteSchemaName | MOTableObj !QualifiedTable !TableMetadataObjId + | MOCustomTypes deriving (Show, Eq, Generic) instance Hashable MetadataObjId diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index d7736480b972e..e63399c9fa158 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -86,6 +86,8 @@ module Hasura.RQL.Types.SchemaCache , delPermFromCache , PreSetColsPartial + , setCustomTypesInCache + , addEventTriggerToCache , delEventTriggerFromCache , EventTriggerInfo(..) @@ -115,11 +117,19 @@ module Hasura.RQL.Types.SchemaCache , updateFunctionDescription , replaceAllowlist + , ActionCache + + , addActionToCache + , delActionFromCache + , addActionPermissionToCache + , delActionPermissionFromCache ) where import qualified Hasura.GraphQL.Context as GC +import qualified Hasura.GraphQL.Validate.Types as RT import Hasura.Prelude +import Hasura.RQL.Types.Action import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.Column import Hasura.RQL.Types.Common @@ -454,12 +464,17 @@ incSchemaCacheVer :: SchemaCacheVer -> SchemaCacheVer incSchemaCacheVer (SchemaCacheVer prev) = SchemaCacheVer $ prev + 1 +type ActionCache = + M.HashMap ActionName ActionInfo + data SchemaCache = SchemaCache { scTables :: !(TableCache PGColumnInfo) + , scActions :: !ActionCache , scFunctions :: !FunctionCache , scRemoteSchemas :: !RemoteSchemaMap , scAllowlist :: !(HS.HashSet GQLQuery) + , scCustomTypes :: !RT.TypeMap , scGCtxMap :: !GC.GCtxMap , scDefaultRemoteGCtx :: !GC.GCtx , scDepMap :: !DepMap @@ -468,16 +483,6 @@ data SchemaCache $(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaCache) -getFuncsOfTable :: QualifiedTable -> FunctionCache -> [FunctionInfo] -getFuncsOfTable qt fc = flip filter allFuncs $ \f -> qt == fiReturnType f - where - allFuncs = M.elems fc - -modDepMapInCache :: (CacheRWM m) => (DepMap -> DepMap) -> m () -modDepMapInCache f = do - sc <- askSchemaCache - writeSchemaCache $ sc { scDepMap = f (scDepMap sc)} - class (Monad m) => CacheRM m where askSchemaCache :: m SchemaCache @@ -490,10 +495,31 @@ class (CacheRM m) => CacheRWM m where instance (Monad m) => CacheRWM (StateT SchemaCache m) where writeSchemaCache = put +getFuncsOfTable :: QualifiedTable -> FunctionCache -> [FunctionInfo] +getFuncsOfTable qt fc = + flip filter allFuncs $ \f -> qt == fiReturnType f + where + allFuncs = M.elems fc + +modDepMapInCache :: (CacheRWM m) => (DepMap -> DepMap) -> m () +modDepMapInCache f = do + sc <- askSchemaCache + writeSchemaCache $ sc { scDepMap = f (scDepMap sc)} + emptySchemaCache :: SchemaCache emptySchemaCache = - SchemaCache M.empty M.empty M.empty - HS.empty M.empty GC.emptyGCtx mempty [] + SchemaCache + { scTables = M.empty + , scActions = mempty + , scFunctions = mempty + , scRemoteSchemas = mempty + , scAllowlist = mempty + , scCustomTypes = mempty + , scGCtxMap = mempty + , scDefaultRemoteGCtx = GC.emptyGCtx + , scDepMap = mempty + , scInconsistentObjs = mempty + } modTableCache :: (CacheRWM m) => TableCache PGColumnInfo -> m () modTableCache tc = do @@ -504,10 +530,24 @@ addTableToCache :: (QErrM m, CacheRWM m) => TableInfo PGColumnInfo -> m () addTableToCache ti = do sc <- askSchemaCache - assertTableNotExists tn sc + assertTableNotExists sc modTableCache $ M.insert tn ti $ scTables sc where tn = _tiName ti + assertTableNotExists :: (QErrM m) => SchemaCache -> m () + assertTableNotExists sc = + case M.lookup tn (scTables sc) of + Nothing -> return () + Just _ -> throw500 $ "table exists in cache : " <>> tn + +getTableInfoFromCache :: (QErrM m) + => QualifiedTable + -> SchemaCache + -> m (TableInfo PGColumnInfo) +getTableInfoFromCache tn sc = + case M.lookup tn (scTables sc) of + Nothing -> throw500 $ "table not found in cache : " <>> tn + Just ti -> return ti delTableFromCache :: (QErrM m, CacheRWM m) => QualifiedTable -> m () @@ -520,24 +560,6 @@ delTableFromCache tn = do notThisTableObj (SOTableObj depTn _) _ = depTn /= tn notThisTableObj _ _ = True -getTableInfoFromCache :: (QErrM m) - => QualifiedTable - -> SchemaCache - -> m (TableInfo PGColumnInfo) -getTableInfoFromCache tn sc = - case M.lookup tn (scTables sc) of - Nothing -> throw500 $ "table not found in cache : " <>> tn - Just ti -> return ti - -assertTableNotExists :: (QErrM m) - => QualifiedTable - -> SchemaCache - -> m () -assertTableNotExists tn sc = - case M.lookup tn (scTables sc) of - Nothing -> return () - Just _ -> throw500 $ "table exists in cache : " <>> tn - modTableInCache :: (QErrM m, CacheRWM m) => (TableInfo PGColumnInfo -> m (TableInfo PGColumnInfo)) -> QualifiedTable @@ -548,23 +570,6 @@ modTableInCache f tn = do newTi <- f ti modTableCache $ M.insert tn newTi $ scTables sc -addColToCache - :: (QErrM m, CacheRWM m) - => PGCol -> PGColumnInfo - -> QualifiedTable -> m () -addColToCache cn ci = - addFldToCache (fromPGCol cn) (FIColumn ci) - -addRelToCache - :: (QErrM m, CacheRWM m) - => RelName -> RelInfo -> [SchemaDependency] - -> QualifiedTable -> m () -addRelToCache rn ri deps tn = do - addFldToCache (fromRel rn) (FIRelationship ri) tn - modDepMapInCache (addToDepMap schObjId deps) - where - schObjId = SOTableObj tn $ TORel $ riName ri - addFldToCache :: (QErrM m, CacheRWM m) => FieldName -> FieldInfo PGColumnInfo @@ -591,11 +596,36 @@ delFldFromCache fn = ti { _tiFieldInfoMap = M.delete fn fim } Nothing -> throw500 "field does not exist" +setCustomTypesInCache + :: (QErrM m, CacheRWM m) + => RT.TypeMap + -> m () +setCustomTypesInCache customTypes = do + sc <- askSchemaCache + writeSchemaCache sc {scCustomTypes = customTypes} + +addColToCache + :: (QErrM m, CacheRWM m) + => PGCol -> PGColumnInfo + -> QualifiedTable -> m () +addColToCache cn ci = + addFldToCache (fromPGCol cn) (FIColumn ci) + delColFromCache :: (QErrM m, CacheRWM m) => PGCol -> QualifiedTable -> m () delColFromCache cn = delFldFromCache (fromPGCol cn) +addRelToCache + :: (QErrM m, CacheRWM m) + => RelName -> RelInfo -> [SchemaDependency] + -> QualifiedTable -> m () +addRelToCache rn ri deps tn = do + addFldToCache (fromRel rn) (FIRelationship ri) tn + modDepMapInCache (addToDepMap schObjId deps) + where + schObjId = SOTableObj tn $ TORel $ riName ri + delRelFromCache :: (QErrM m, CacheRWM m) => RelName -> QualifiedTable -> m () delRelFromCache rn tn = do @@ -636,6 +666,54 @@ withPermType PTSelect f = f PASelect withPermType PTUpdate f = f PAUpdate withPermType PTDelete f = f PADelete +addPermToCache + :: (QErrM m, CacheRWM m) + => QualifiedTable + -> RoleName + -> PermAccessor a + -> a + -> [SchemaDependency] + -> m () +addPermToCache tn rn pa i deps = do + modTableInCache modRolePermInfo tn + modDepMapInCache (addToDepMap schObjId deps) + where + permLens = permAccToLens pa + modRolePermInfo ti = do + let rpim = _tiRolePermInfoMap ti + rpi = fromMaybe mkRolePermInfo $ M.lookup rn rpim + newRPI = rpi & permLens ?~ i + assertPermNotExists pa rpi + return $ ti { _tiRolePermInfoMap = M.insert rn newRPI rpim } + schObjId = SOTableObj tn $ TOPerm rn $ permAccToType pa + + assertPermNotExists :: (QErrM m) => PermAccessor a -> RolePermInfo -> m () + assertPermNotExists f rpi = + when (isJust $ rpi ^. permAccToLens f) $ throw500 "permission exists" + +delPermFromCache + :: (QErrM m, CacheRWM m) + => PermAccessor a + -> RoleName + -> QualifiedTable + -> m () +delPermFromCache pa rn tn = do + modTableInCache modRolePermInfo tn + modDepMapInCache (removeFromDepMap schObjId) + where + permLens = permAccToLens pa + modRolePermInfo ti = do + let rpim = _tiRolePermInfoMap ti + rpi = fromMaybe mkRolePermInfo $ M.lookup rn rpim + assertPermExists pa rpi + let newRPI = rpi & permLens .~ Nothing + return $ ti { _tiRolePermInfoMap = M.insert rn newRPI rpim } + schObjId = SOTableObj tn $ TOPerm rn $ permAccToType pa + + assertPermExists :: (QErrM m) => PermAccessor a -> RolePermInfo -> m () + assertPermExists f rpi = + unless (isJust $ rpi ^. permAccToLens f) $ throw500 "permission does not exist" + addEventTriggerToCache :: (QErrM m, CacheRWM m) => QualifiedTable @@ -666,6 +744,74 @@ delEventTriggerFromCache qt trn = do return $ ti { _tiEventTriggerInfoMap = M.delete trn etim } schObjId = SOTableObj qt $ TOTrigger trn +modifyActionCache :: (CacheRWM m) => (ActionCache -> ActionCache) -> m () +modifyActionCache f = do + schemaCache <- askSchemaCache + writeSchemaCache $ schemaCache { scActions = f $ scActions schemaCache } + +addActionToCache + :: (QErrM m, CacheRWM m) => ActionInfo -> m () +addActionToCache actionInfo = do + assertActionNotExists + modifyActionCache (M.insert actionName actionInfo) + where + actionName = _aiName actionInfo + assertActionNotExists :: (CacheRM m, QErrM m) => m () + assertActionNotExists = do + schemaCache <- askSchemaCache + case M.lookup actionName (scActions schemaCache) of + Nothing -> return () + Just _ -> throw500 $ "action already exists in cache: " <>> actionName + +getActionInfoFromCache + :: (QErrM m) => ActionName -> SchemaCache -> m ActionInfo +getActionInfoFromCache actionName schemaCache = + case M.lookup actionName (scActions schemaCache) of + Nothing -> throw500 $ "action not found in cache: " <>> actionName + Just ti -> return ti + +delActionFromCache + :: (QErrM m, CacheRWM m) => ActionName -> m () +delActionFromCache actionName = do + schemaCache <- askSchemaCache + void $ getActionInfoFromCache actionName schemaCache + modifyActionCache (M.delete actionName) + +modifyActionInfoInCache + :: (QErrM m, CacheRWM m) => ActionName -> (ActionInfo -> m ActionInfo) -> m () +modifyActionInfoInCache actionName f = do + schemaCache <- askSchemaCache + actionInfo <- getActionInfoFromCache actionName schemaCache + newActionInfo <- f actionInfo + modifyActionCache (M.insert actionName newActionInfo) + +-- TODO: use lens +addActionPermissionToCache + :: (QErrM m, CacheRWM m) => ActionName -> ActionPermissionInfo -> m () +addActionPermissionToCache actionName permissionInfo = + modifyActionInfoInCache actionName $ \actionInfo -> do + let currentPermissions = _aiPermissions actionInfo + case M.lookup role currentPermissions of + Just _ -> throw500 $ "action permission already exists in cache: " <> + actionName <<> ", " <>> role + Nothing -> + return $ actionInfo + { _aiPermissions = M.insert role permissionInfo currentPermissions } + where + role = _apiRole permissionInfo + +delActionPermissionFromCache + :: (QErrM m, CacheRWM m) => ActionName -> RoleName -> m () +delActionPermissionFromCache actionName role = + modifyActionInfoInCache actionName $ \actionInfo -> do + let currentPermissions = _aiPermissions actionInfo + case M.lookup role currentPermissions of + Just _ -> + return $ actionInfo + { _aiPermissions = M.delete role currentPermissions } + Nothing -> throw500 $ "action permission does not exist in cache: " <> + actionName <<> ", " <>> role + addFunctionToCache :: (QErrM m, CacheRWM m) => FunctionInfo -> m () @@ -716,60 +862,6 @@ updateFunctionDescription qf descM = do newFuncCache = M.insert qf newFuncInfo $ scFunctions sc writeSchemaCache sc{scFunctions = newFuncCache} -addPermToCache - :: (QErrM m, CacheRWM m) - => QualifiedTable - -> RoleName - -> PermAccessor a - -> a - -> [SchemaDependency] - -> m () -addPermToCache tn rn pa i deps = do - modTableInCache modRolePermInfo tn - modDepMapInCache (addToDepMap schObjId deps) - where - paL = permAccToLens pa - modRolePermInfo ti = do - let rpim = _tiRolePermInfoMap ti - rpi = fromMaybe mkRolePermInfo $ M.lookup rn rpim - newRPI = rpi & paL ?~ i - assertPermNotExists pa rpi - return $ ti { _tiRolePermInfoMap = M.insert rn newRPI rpim } - schObjId = SOTableObj tn $ TOPerm rn $ permAccToType pa - -assertPermNotExists - :: (QErrM m) - => PermAccessor a - -> RolePermInfo -> m () -assertPermNotExists f rpi = - when (isJust $ rpi ^. permAccToLens f) $ throw500 "permission exists" - -assertPermExists - :: (QErrM m) - => PermAccessor a - -> RolePermInfo -> m () -assertPermExists f rpi = - unless (isJust $ rpi ^. permAccToLens f) $ throw500 "permission does not exist" - -delPermFromCache - :: (QErrM m, CacheRWM m) - => PermAccessor a - -> RoleName - -> QualifiedTable - -> m () -delPermFromCache pa rn tn = do - modTableInCache modRolePermInfo tn - modDepMapInCache (removeFromDepMap schObjId) - where - paL = permAccToLens pa - modRolePermInfo ti = do - let rpim = _tiRolePermInfoMap ti - rpi = fromMaybe mkRolePermInfo $ M.lookup rn rpim - assertPermExists pa rpi - let newRPI = rpi & paL .~ Nothing - return $ ti { _tiRolePermInfoMap = M.insert rn newRPI rpim } - schObjId = SOTableObj tn $ TOPerm rn $ permAccToType pa - addRemoteSchemaToCache :: (QErrM m, CacheRWM m) => RemoteSchemaCtx -> m () addRemoteSchemaToCache rmCtx = do diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index cfdcd1636d456..85bbaba43f5c5 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -16,8 +16,8 @@ module Hasura.SQL.Types , PGDescription(..) - , PGCol - , getPGColTxt + , PGCol(..) + -- , getPGColTxt , showPGCols , isIntegerType @@ -58,22 +58,23 @@ module Hasura.SQL.Types ) where -import qualified Database.PG.Query as Q -import qualified Database.PG.Query.PTI as PTI +import qualified Database.PG.Query as Q +import qualified Database.PG.Query.PTI as PTI import Hasura.Prelude import Data.Aeson -import Data.Aeson.Encoding (text) import Data.Aeson.TH -import Data.Aeson.Types (toJSONKeyText) -import Instances.TH.Lift () -import Language.Haskell.TH.Syntax (Lift) +import Data.Aeson.Encoding (text) +import Data.Aeson.Types (toJSONKeyText) +import Instances.TH.Lift () +import Language.Haskell.TH.Syntax (Lift) -import qualified Data.Text.Extended as T -import qualified Database.PostgreSQL.LibPQ as PQ -import qualified PostgreSQL.Binary.Decoding as PD -import qualified Text.Builder as TB +import qualified Data.Text.Extended as T +import qualified Database.PostgreSQL.LibPQ as PQ +import qualified Language.GraphQL.Draft.Syntax as G +import qualified PostgreSQL.Binary.Decoding as PD +import qualified Text.Builder as TB class ToSQL a where toSQL :: a -> TB.Builder @@ -126,6 +127,9 @@ infixr 6 <<> (<<>) a rTxt = dquote a <> rTxt {-# INLINE (<<>) #-} +instance DQuote G.Name where + dquoteTxt = G.unName + pgFmtIden :: T.Text -> T.Text pgFmtIden x = "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\"" @@ -330,6 +334,7 @@ data PGScalarType | PGGeometry | PGGeography | PGRaster + | PGUUID | PGUnknown !T.Text deriving (Show, Eq, Lift, Generic, Data) @@ -357,6 +362,7 @@ instance ToSQL PGScalarType where PGGeometry -> "geometry" PGGeography -> "geography" PGRaster -> "raster" + PGUUID -> "uuid" PGUnknown t -> TB.text t instance ToJSON PGScalarType where @@ -417,6 +423,7 @@ txtToPgColTy t = case t of "geography" -> PGGeography "raster" -> PGRaster + "uuid" -> PGUUID _ -> PGUnknown t @@ -447,6 +454,7 @@ pgTypeOid PGGeometry = PTI.text pgTypeOid PGGeography = PTI.text -- we are using the ST_RastFromHexWKB($i) instead of $i pgTypeOid PGRaster = PTI.text +pgTypeOid PGUUID = PTI.uuid pgTypeOid (PGUnknown _) = PTI.auto isIntegerType :: PGScalarType -> Bool diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index 794f28d1e8049..bfdb3cb42393a 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -1,6 +1,7 @@ module Hasura.SQL.Value ( PGScalarValue(..) , pgColValueToInt + , pgScalarValueToJson , withConstructorFn , parsePGValue @@ -35,6 +36,7 @@ import qualified Data.Text as T import qualified Data.Text.Conversions as TC import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL +import qualified Data.UUID as UUID import qualified Database.PostgreSQL.LibPQ as PQ import qualified PostgreSQL.Binary.Encoding as PE @@ -51,6 +53,9 @@ instance FromJSON RasterWKB where "invalid hexadecimal representation of raster well known binary format" _ -> fail "expecting String for raster" +instance ToJSON RasterWKB where + toJSON = toJSON . TC.toText . getRasterWKB + -- Binary value. Used in prepared sq data PGScalarValue = PGValInteger !Int32 @@ -71,9 +76,35 @@ data PGScalarValue | PGValJSONB !Q.JSONB | PGValGeo !GeometryWithCRS | PGValRaster !RasterWKB + | PGValUUID !UUID.UUID | PGValUnknown !T.Text deriving (Show, Eq) +pgScalarValueToJson :: PGScalarValue -> Value +pgScalarValueToJson = \case + PGValInteger i -> toJSON i + PGValSmallInt i -> toJSON i + PGValBigInt i -> toJSON i + PGValFloat f -> toJSON f + PGValDouble d -> toJSON d + PGValNumeric sc -> toJSON sc + PGValBoolean b -> toJSON b + PGValChar t -> toJSON t + PGValVarchar t -> toJSON t + PGValText t -> toJSON t + PGValDate d -> toJSON d + PGValTimeStampTZ u -> + toJSON $ formatTime defaultTimeLocale "%FT%T%QZ" u + PGValTimeTZ (ZonedTimeOfDay tod tz) -> + toJSON (show tod ++ timeZoneOffsetString tz) + PGNull _ -> Null + PGValJSON (Q.JSON j) -> j + PGValJSONB (Q.JSONB j) -> j + PGValGeo o -> toJSON o + PGValRaster r -> toJSON r + PGValUUID u -> toJSON u + PGValUnknown t -> toJSON t + pgColValueToInt :: PGScalarValue -> Maybe Int pgColValueToInt (PGValInteger i) = Just $ fromIntegral i pgColValueToInt (PGValSmallInt i) = Just $ fromIntegral i @@ -115,6 +146,7 @@ parsePGValue ty val = case (ty, val) of PGGeometry -> PGValGeo <$> parseJSON val PGGeography -> PGValGeo <$> parseJSON val PGRaster -> PGValRaster <$> parseJSON val + PGUUID -> PGValUUID <$> parseJSON val PGUnknown tyName -> fail $ "A string is expected for type : " ++ T.unpack tyName @@ -156,6 +188,7 @@ txtEncodedPGVal colVal = case colVal of PGValGeo o -> TELit $ TL.toStrict $ AE.encodeToLazyText o PGValRaster r -> TELit $ TC.toText $ getRasterWKB r + PGValUUID u -> TELit $ UUID.toText u PGValUnknown t -> TELit t binEncoder :: PGScalarValue -> Q.PrepArg @@ -178,6 +211,7 @@ binEncoder colVal = case colVal of PGValJSONB u -> Q.toPrepVal u PGValGeo o -> Q.toPrepVal $ TL.toStrict $ AE.encodeToLazyText o PGValRaster r -> Q.toPrepVal $ TC.toText $ getRasterWKB r + PGValUUID u -> Q.toPrepVal u PGValUnknown t -> (PTI.auto, Just (TE.encodeUtf8 t, PQ.Text)) txtEncoder :: PGScalarValue -> S.SQLExp diff --git a/server/src-lib/Hasura/Server/Query.hs b/server/src-lib/Hasura/Server/Query.hs index 43506d4978251..55c626532e8f8 100644 --- a/server/src-lib/Hasura/Server/Query.hs +++ b/server/src-lib/Hasura/Server/Query.hs @@ -11,9 +11,11 @@ import qualified Network.HTTP.Client as HTTP import Hasura.EncJSON import Hasura.Prelude +import Hasura.RQL.DDL.Action import Hasura.RQL.DDL.EventTrigger import Hasura.RQL.DDL.Metadata import Hasura.RQL.DDL.Permission +import Hasura.RQL.DDL.CustomTypes import Hasura.RQL.DDL.QueryCollection import Hasura.RQL.DDL.Relationship import Hasura.RQL.DDL.Relationship.Rename @@ -91,7 +93,13 @@ data RQLQueryV1 | RQClearMetadata !ClearMetadata | RQReloadMetadata !ReloadMetadata + | RQCreateAction !CreateAction + | RQDropAction !DropAction + | RQCreateActionPermission !CreateActionPermission + | RQDropActionPermission !DropActionPermission + | RQDumpInternalState !DumpInternalState + | RQSetCustomTypes !CustomTypes deriving (Show, Eq, Lift) data RQLQueryV2 @@ -273,7 +281,13 @@ queryNeedsReload (RQV1 qi) = case qi of RQClearMetadata _ -> True RQReloadMetadata _ -> True + RQCreateAction _ -> True + RQDropAction _ -> True + RQCreateActionPermission _ -> True + RQDropActionPermission _ -> True + RQDumpInternalState _ -> False + RQSetCustomTypes _ -> True RQBulk qs -> any queryNeedsReload qs queryNeedsReload (RQV2 qi) = case qi of @@ -352,10 +366,17 @@ runQueryM rq = RQExportMetadata q -> runExportMetadata q RQReloadMetadata q -> runReloadMetadata q + RQCreateAction q -> runCreateAction q + RQDropAction q -> runDropAction q + RQCreateActionPermission q -> runCreateActionPermission q + RQDropActionPermission q -> runDropActionPermission q + RQDumpInternalState q -> runDumpInternalState q RQRunSql q -> runRunSQL q + RQSetCustomTypes q -> runSetCustomTypes q + RQBulk qs -> encJFromList <$> indexedMapM runQueryM qs runQueryV2M = \case diff --git a/server/src-rsr/catalog_metadata.sql b/server/src-rsr/catalog_metadata.sql index 52a38c50c77cd..e35eef826333a 100644 --- a/server/src-rsr/catalog_metadata.sql +++ b/server/src-rsr/catalog_metadata.sql @@ -7,7 +7,10 @@ select 'remote_schemas', remote_schemas.items, 'functions', functions.items, 'foreign_keys', foreign_keys.items, - 'allowlist_collections', allowlist.item + 'allowlist_collections', allowlist.item, + 'custom_types', coalesce((select custom_types from hdb_catalog.hdb_custom_graphql_types), '{}'), + 'actions', actions.items, + 'action_permissions', action_permissions.items ) from ( @@ -175,4 +178,39 @@ from left outer join hdb_catalog.hdb_query_collection hqc on (hqc.collection_name = ha.collection_name) - ) as allowlist + + ) as allowlist, + ( + select + coalesce( + json_agg( + json_build_object( + 'name', + action_name, + 'definition', action_defn :: json, + 'comment', comment + ) + ), + '[]' + ) as items + from + hdb_catalog.hdb_action + ) as actions, + ( + select + coalesce( + json_agg( + json_build_object( + 'name', + action_name, + 'role', + role_name, + 'definition', definition :: json, + 'comment', comment + ) + ), + '[]' + ) as items + from + hdb_catalog.hdb_action_permission + ) as action_permissions diff --git a/server/src-rsr/initialise.sql b/server/src-rsr/initialise.sql index e0a5faafa665c..d93f89f1874ae 100644 --- a/server/src-rsr/initialise.sql +++ b/server/src-rsr/initialise.sql @@ -630,3 +630,35 @@ CREATE TABLE hdb_catalog.hdb_allowlist collection_name TEXT UNIQUE REFERENCES hdb_catalog.hdb_query_collection(collection_name) ); + +CREATE TABLE hdb_catalog.hdb_action +( + action_name TEXT PRIMARY KEY, + action_defn JSONB NOT NULL, + comment TEXT NULL, + is_system_defined boolean default false +); + +CREATE TABLE hdb_catalog.hdb_action_permission +( + action_name TEXT NOT NULL, + role_name TEXT NOT NULL, + definition JSONB NOT NULL, + comment TEXT NULL, + + PRIMARY KEY (action_name, role_name), + FOREIGN KEY (action_name) REFERENCES hdb_catalog.hdb_action(action_name) ON UPDATE CASCADE +); + +CREATE TABLE hdb_catalog.hdb_action_log +( + id UUID PRIMARY KEY DEFAULT gen_random_uuid(), + action_name TEXT, + input_payload JSONB NOT NULL, + response_payload JSONB NULL, + + created_at timestamptz NOT NULL, + response_received_at timestamptz NULL, + status text NOT NULL, + CHECK (status IN ('created', 'processing', 'completed', 'error')) +); diff --git a/server/src-rsr/migrations/25_to_26.sql b/server/src-rsr/migrations/25_to_26.sql new file mode 100644 index 0000000000000..81511b93f2291 --- /dev/null +++ b/server/src-rsr/migrations/25_to_26.sql @@ -0,0 +1,40 @@ +CREATE TABLE hdb_catalog.hdb_action +( + action_name TEXT PRIMARY KEY, + action_defn JSONB NOT NULL, + comment TEXT NULL, + is_system_defined boolean default false +); + +CREATE TABLE hdb_catalog.hdb_action_permission +( + action_name TEXT NOT NULL, + role_name TEXT NOT NULL, + definition JSONB NOT NULL, + comment TEXT NULL, + + PRIMARY KEY (action_name, role_name), + FOREIGN KEY (action_name) REFERENCES hdb_catalog.hdb_action(action_name) ON UPDATE CASCADE +); + +CREATE TABLE hdb_catalog.hdb_action_log +( + id UUID PRIMARY KEY DEFAULT gen_random_uuid(), + -- we deliberately do not reference the action name + -- because sometimes we may want to retain history + -- when after dropping the action + action_name TEXT, + input_payload JSONB NOT NULL, + session_variables JSONB NOT NULL, + response_payload JSONB NULL, + + created_at timestamptz NOT NULL default now(), + response_received_at timestamptz NULL, + status text NOT NULL, + CHECK (status IN ('created', 'processing', 'completed', 'error')) +); + +CREATE TABLE hdb_catalog.hdb_custom_graphql_types +( + custom_types jsonb NOT NULL +); diff --git a/server/stack.yaml b/server/stack.yaml index 4411b07169a4f..504f045096cd6 100644 --- a/server/stack.yaml +++ b/server/stack.yaml @@ -2,11 +2,11 @@ # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) # resolver: lts-10.8 -resolver: lts-13.20 +resolver: lts-14.8 # Local packages, usually specified by relative directory name packages: - '.' -# - '../../../graphql-parser-hs' +- '../../graphql-parser-hs' # - extra-libs/aeson # - extra-libs/logger/wai-logger @@ -18,14 +18,11 @@ extra-deps: # use https URLs so that build systems can clone these repos - git: https://github.com/hasura/pg-client-hs.git commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 -- git: https://github.com/hasura/graphql-parser-hs.git - commit: f3d9b645efd9adb143e2ad4c6b73bded1578a4e9 +# - git: https://github.com/hasura/graphql-parser-hs.git +# commit: f3d9b645efd9adb143e2ad4c6b73bded1578a4e9 - git: https://github.com/hasura/ci-info-hs.git commit: ad6df731584dc89b72a6e131687d37ef01714fe8 -# extra dep for pg-client-hs -- select-0.4.0.1 - - primitive-extras-0.7.1 - stm-hamt-1.2.0.2 - stm-containers-1.1.0.4 @@ -35,8 +32,6 @@ extra-deps: # needed for Text.Shakespeare.Text.stextFile; can be removed once the newer version is in stackage - shakespeare-2.0.22 -- brotli-0.0.0.0 - # Override default flag values for local packages and extra-deps flags: {} diff --git a/server/stack.yaml.lock b/server/stack.yaml.lock index 9a58603f7176b..17a6830c75ef6 100644 --- a/server/stack.yaml.lock +++ b/server/stack.yaml.lock @@ -18,20 +18,6 @@ packages: original: git: https://github.com/hasura/pg-client-hs.git commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 -- completed: - cabal-file: - size: 3364 - sha256: 09bad175e8ccb1fec5ddbc94d95d18b4206ac4481cf3749e42ffbaac90bc4a37 - name: graphql-parser - version: 0.1.0.0 - git: https://github.com/hasura/graphql-parser-hs.git - pantry-tree: - size: 1826 - sha256: 4ac0632e9f0e2c386b056ac078cf04fd4c211f683c0fee51e767da913d7d4764 - commit: f3d9b645efd9adb143e2ad4c6b73bded1578a4e9 - original: - git: https://github.com/hasura/graphql-parser-hs.git - commit: f3d9b645efd9adb143e2ad4c6b73bded1578a4e9 - completed: cabal-file: size: 1253 @@ -46,13 +32,6 @@ packages: original: git: https://github.com/hasura/ci-info-hs.git commit: ad6df731584dc89b72a6e131687d37ef01714fe8 -- completed: - hackage: select-0.4.0.1@sha256:d409315752a069693bdd4169fa9a8ea7777d814da77cd8604f367cf0741de295,2492 - pantry-tree: - size: 1256 - sha256: b6ae36ccba2a7cdd1ad130575931364002682e532d7043da62771e58294ddb7a - original: - hackage: select-0.4.0.1 - completed: hackage: primitive-extras-0.7.1@sha256:23905c57089418b1a2d324cfee3e81bbd5a344a0fa56a827867b2dce275fdb5e,2945 pantry-tree: @@ -102,16 +81,9 @@ packages: sha256: 3561f4c3121d05e5390c2b32f9e0a58b6408ecb5cfb74f234f3b8ca37b467a5e original: hackage: shakespeare-2.0.22 -- completed: - hackage: brotli-0.0.0.0@sha256:0a8232f028dbc6a1f9db291ef996a5abe74aa00c7c3dc00a741c41f3da75a4dc,2873 - pantry-tree: - size: 407 - sha256: f4c2e742f10ca010554aeb0037294f118be4f35228acca98c0df97e1093bca33 - original: - hackage: brotli-0.0.0.0 snapshots: - completed: - size: 498167 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/20.yaml - sha256: cda928d57b257a5f17bcad796843c9daa674fef47d600dbea3aa7b0e49d64a11 - original: lts-13.20 + size: 524789 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/8.yaml + sha256: 8af5eb80734f02621d37e82cc0cde614af2ddc9c320610acb0b1b6d9ac162930 + original: lts-14.8 From 61072b1c06738d910de903f527c8ec4d5a901c5a Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Tue, 15 Oct 2019 20:50:44 +0530 Subject: [PATCH 04/62] switch to graphql-parser-hs on github --- server/stack.yaml | 6 +++--- server/stack.yaml.lock | 14 ++++++++++++++ 2 files changed, 17 insertions(+), 3 deletions(-) diff --git a/server/stack.yaml b/server/stack.yaml index 504f045096cd6..de34787117df0 100644 --- a/server/stack.yaml +++ b/server/stack.yaml @@ -6,7 +6,7 @@ resolver: lts-14.8 # Local packages, usually specified by relative directory name packages: - '.' -- '../../graphql-parser-hs' +# - '../../graphql-parser-hs' # - extra-libs/aeson # - extra-libs/logger/wai-logger @@ -18,8 +18,8 @@ extra-deps: # use https URLs so that build systems can clone these repos - git: https://github.com/hasura/pg-client-hs.git commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 -# - git: https://github.com/hasura/graphql-parser-hs.git -# commit: f3d9b645efd9adb143e2ad4c6b73bded1578a4e9 +- git: https://github.com/0x777/graphql-parser-hs.git + commit: bf9781312d49af6168d97d5374bc4df72f72c1d5 - git: https://github.com/hasura/ci-info-hs.git commit: ad6df731584dc89b72a6e131687d37ef01714fe8 diff --git a/server/stack.yaml.lock b/server/stack.yaml.lock index 17a6830c75ef6..b66c226c7a6e8 100644 --- a/server/stack.yaml.lock +++ b/server/stack.yaml.lock @@ -18,6 +18,20 @@ packages: original: git: https://github.com/hasura/pg-client-hs.git commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 +- completed: + cabal-file: + size: 3364 + sha256: 09bad175e8ccb1fec5ddbc94d95d18b4206ac4481cf3749e42ffbaac90bc4a37 + name: graphql-parser + version: 0.1.0.0 + git: https://github.com/0x777/graphql-parser-hs.git + pantry-tree: + size: 1826 + sha256: 819c622940b2d66331116fea4ea013edf039bbd88c482676a6da1244e46b3fc0 + commit: bf9781312d49af6168d97d5374bc4df72f72c1d5 + original: + git: https://github.com/0x777/graphql-parser-hs.git + commit: bf9781312d49af6168d97d5374bc4df72f72c1d5 - completed: cabal-file: size: 1253 From 04b863ca13b8b264277dfdb5d6ecfc1bc03e8247 Mon Sep 17 00:00:00 2001 From: Tirumarai Selvan A Date: Wed, 16 Oct 2019 11:22:29 +0530 Subject: [PATCH 05/62] update docs --- docs/graphql/manual/actions/async-actions.rst | 5 ++--- .../manual/actions/getting-started.rst | 12 +++++------ docs/graphql/manual/actions/index.rst | 10 +++++----- .../graphql/manual/actions/response-types.rst | 20 +++++++++++++++++-- 4 files changed, 31 insertions(+), 16 deletions(-) diff --git a/docs/graphql/manual/actions/async-actions.rst b/docs/graphql/manual/actions/async-actions.rst index 857c28b6fcd44..5467cad39c951 100644 --- a/docs/graphql/manual/actions/async-actions.rst +++ b/docs/graphql/manual/actions/async-actions.rst @@ -9,9 +9,9 @@ Async Actions WORK IN PROGRESS -Sometimes you may not want to wait for an action to complete (say if the business logic takes a long time). In such cases you can create an "asynchronous" action, which returns an ``action_id`` immediately to the client before contacting the webhook. +Sometimes you may not want to wait for an action to complete (say if the business logic takes a long time). In such cases you can create an **asynchronous** action, which returns an ``action_id`` immediately to the client before contacting the webhook. -If you mark an action as "asynchronous", graphql-engine also generates a query and a subscription field for the action so that you can query/subscribe to its status. In the above example, let's say ``place_order`` is an asnychronous action, your client code looks something like this: +If you mark an action as **asynchronous**, graphql-engine also generates a query and a subscription field for the action so that you can query/subscribe to its status. In the above example, let's say ``place_order`` is an asnychronous action, your client code looks something like this: .. code-block:: graphql @@ -33,4 +33,3 @@ If you mark an action as "asynchronous", graphql-engine also generates a query a } } } - diff --git a/docs/graphql/manual/actions/getting-started.rst b/docs/graphql/manual/actions/getting-started.rst index 5d79d2c429d53..6702dcaad7d1a 100644 --- a/docs/graphql/manual/actions/getting-started.rst +++ b/docs/graphql/manual/actions/getting-started.rst @@ -9,14 +9,14 @@ Getting Started with Actions WORK IN PROGRESS -Here is a typical way to use an action. +Let's say you are building an ecommerce application where you need to provide a mutation for placing an 'order', ``place_order``. Example ------- WORK IN PROGRESS -Let's say you are building an ecommerce application where you need to provide a mutation for placing an 'order', ``place_order``, you will need to first define the input types for this mutation: +First, you will need to first define the input types for this mutation in the console: .. code-block:: graphql @@ -43,22 +43,20 @@ Let's say you are building an ecommerce application where you need to provide a You will then define an action called ``place_order`` with ``place_order_input`` as the **input** type, ``place_order_response`` as the **output** type. -Once you have the action setup, you'll have to define the permissions for the role for which you want to allow this action. For all such roles, this action will be exposed as a mutation. The client would then execute this mutation as follows: +Once you have the action setup, you'll have to define the permissions for the role for which you want to allow this action. For all such roles, this action will be exposed as a mutation. The client can then execute this mutation as follows: .. code-block:: graphql mutation place_order($order_input: place_order_input!) { place_order(input: $order_input) { - action_id response { order_id } } } -Where ``action_id`` is a unique id generated for every action that has been performed. The response from the webhook can be accessed through the ``response`` field. -An action can be linked to different types of handlers. In this example, let's use a HTTP handler which will be invoked when this action is called by the client. The logic of this handler could look something like this: +But how is this action executed? An action can be linked to different types of handlers (see: :doc:`Action handlers `) . In this example, let's use a HTTP handler which will be invoked when this action is called by the client. The logic of this handler could look something like this: .. code-block:: python @@ -67,3 +65,5 @@ An action can be linked to different types of handlers. In this example, let's u session_variables = payload['session_variables'] order_id = validate_and_insert_order(input_args, session_variables) # some business logic code return {"order_id": order_id} + +And that's it. You have created your first action! diff --git a/docs/graphql/manual/actions/index.rst b/docs/graphql/manual/actions/index.rst index dabe94f420505..ba819dcddae83 100644 --- a/docs/graphql/manual/actions/index.rst +++ b/docs/graphql/manual/actions/index.rst @@ -9,15 +9,15 @@ Actions WORK IN PROGRESS -Actions are user defined mutations with custom business logic. Actions can be added to Hasura to handle various use cases such as validation, data enrichment and other complex business logic. +Actions are user defined mutations with custom business logic. Actions can be added to Hasura to handle various use cases such as data validation, data enrichment and other complex business logic. -When the permissions system isn't enough to specify the required constraints, you would typically add such mutation through a remote schema, however actions can handle these use cases better because of the following reasons: +When the permissions system isn't enough to specify the required constraints, you would typically add such mutation through a remote schema. However actions can handle these use cases better because of the following reasons: -1. No need to write a graphql server. +1. No need to write a remote schema. Actions can be executed in ordinary webhooks or postgres itself. -2. Return graphql-engine's types without writing any extra code +2. Return graphql-engine's types without writing any extra code. You might want to return the new "state" after a mutation. -3. Gives a powerful model for mutations which should enable building event-driven apps easily +3. Can be executed asynchronously for building powerful event-driven apps. Architecture Diagram -------------------- diff --git a/docs/graphql/manual/actions/response-types.rst b/docs/graphql/manual/actions/response-types.rst index bd75a6374ae9d..e06c8eef7c037 100644 --- a/docs/graphql/manual/actions/response-types.rst +++ b/docs/graphql/manual/actions/response-types.rst @@ -22,7 +22,9 @@ WORK IN PROGRESS mutation place_order($order_input: place_order_input!) { place_order(input: $order_input) { - action_id + response { + order_id + } } } @@ -35,7 +37,6 @@ WORK IN PROGRESS mutation place_order($order_input: place_order_input!) { place_order(input: $order_input) { - action_id response { order { id @@ -49,3 +50,18 @@ WORK IN PROGRESS You can fetch relationships of the ``order`` like you would when you query the ``order`` table. Thus with actions you can write the minimum needed code that is needed to validate the mutation and still not lose out on the powerful query fields that graphql-engine generates. +Async response +-------------- + +WORK IN PROGRESS + +.. code-block:: graphql + + mutation place_order($order_input: place_order_input!) { + place_order(input: $order_input) { + action_id + } + } + +Where ``action_id`` is a unique id generated for every async action that has been performed. + From afb4ac9d678e909ac572e79a65a45672eb7a3e43 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Wed, 16 Oct 2019 21:00:31 +0530 Subject: [PATCH 06/62] metadata import/export --- server/src-lib/Hasura/RQL/DDL/Action.hs | 103 +++++++++----- server/src-lib/Hasura/RQL/DDL/CustomTypes.hs | 32 +++-- server/src-lib/Hasura/RQL/DDL/Metadata.hs | 137 +++++++++++++++++-- server/src-lib/Hasura/RQL/Types/Metadata.hs | 3 + 4 files changed, 213 insertions(+), 62 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 2c077f5dc619c..677447e841ded 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -2,18 +2,22 @@ module Hasura.RQL.DDL.Action ( CreateAction , validateAndCacheAction , runCreateAction + , runCreateAction_ , DropAction , runDropAction + , deleteActionFromCatalog , fetchActions , CreateActionPermission , validateAndCacheActionPermission , runCreateActionPermission + , runCreateActionPermission_ , DropActionPermission , runDropActionPermission + , deleteActionPermissionFromCatalog ) where import Hasura.EncJSON @@ -62,11 +66,17 @@ runCreateAction , CacheRWM m, MonadTx m ) => CreateAction -> m EncJSON -runCreateAction q@(CreateAction actionName actionDefinition comment) = do +runCreateAction q = do adminOnly + runCreateAction_ q + return successMsg + +runCreateAction_ + :: (QErrM m , CacheRWM m, MonadTx m) + => CreateAction -> m () +runCreateAction_ q@(CreateAction actionName actionDefinition comment) = do validateAndCacheAction q persistCreateAction - return successMsg where persistCreateAction :: (MonadTx m) => m () persistCreateAction = do @@ -127,10 +137,20 @@ buildActionInfo q = do G.TypeList _ _ -> True G.TypeNamed _ _ -> False +newtype ClearActionData + = ClearActionData { unClearActionData :: Bool } + deriving (Show, Eq, Lift, J.FromJSON, J.ToJSON) + +shouldClearActionData :: ClearActionData -> Bool +shouldClearActionData = unClearActionData + +defaultClearActionData :: ClearActionData +defaultClearActionData = ClearActionData True + data DropAction = DropAction { _daName :: !ActionName - , _daClearData :: !(Maybe Bool) + , _daClearData :: !(Maybe ClearActionData) } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''DropAction) @@ -141,28 +161,31 @@ runDropAction (DropAction actionName clearDataM)= do adminOnly void $ getActionInfo actionName delActionFromCache actionName - liftTx $ do - deleteActionFromCatalog - when clearData clearActionData + liftTx $ deleteActionFromCatalog actionName clearDataM return successMsg + +deleteActionFromCatalog + :: ActionName + -> Maybe ClearActionData + -> Q.TxE QErr () +deleteActionFromCatalog actionName clearDataM = do + Q.unitQE defaultTxErrorHandler [Q.sql| + DELETE FROM hdb_catalog.hdb_action + WHERE action_name = $1 + |] (Identity actionName) True + when (shouldClearActionData clearData) $ + clearActionDataFromCatalog actionName where -- When clearData is not present we assume that -- the data needs to be retained - clearData = fromMaybe False clearDataM - - deleteActionFromCatalog :: Q.TxE QErr () - deleteActionFromCatalog = - Q.unitQE defaultTxErrorHandler [Q.sql| - DELETE FROM hdb_catalog.hdb_action - WHERE action_name = $1 - |] (Identity actionName) True - - clearActionData :: Q.TxE QErr () - clearActionData = - Q.unitQE defaultTxErrorHandler [Q.sql| - DELETE FROM hdb_catalog.hdb_action_log - WHERE action_name = $1 - |] (Identity actionName) True + clearData = fromMaybe defaultClearActionData clearDataM + +clearActionDataFromCatalog :: ActionName -> Q.TxE QErr () +clearActionDataFromCatalog actionName = + Q.unitQE defaultTxErrorHandler [Q.sql| + DELETE FROM hdb_catalog.hdb_action_log + WHERE action_name = $1 + |] (Identity actionName) True fetchActions :: Q.TxE QErr [CreateAction] fetchActions = @@ -202,16 +225,12 @@ validateAndCacheActionPermission createActionPermission = do -> m AnnBoolExpPartialSQL buildActionFilter permission = undefined -runCreateActionPermission - :: ( QErrM m, UserInfoM m - , CacheRWM m, MonadTx m - ) - => CreateActionPermission -> m EncJSON -runCreateActionPermission createActionPermission = do - adminOnly +runCreateActionPermission_ + :: ( QErrM m , CacheRWM m, MonadTx m) + => CreateActionPermission -> m () +runCreateActionPermission_ createActionPermission = do validateAndCacheActionPermission createActionPermission persistCreateActionPermission - return successMsg where actionName = _capAction createActionPermission role = _capRole createActionPermission @@ -226,6 +245,16 @@ runCreateActionPermission createActionPermission = do VALUES ($1, $2, $3) |] (actionName, role, Q.AltJ permissionDefinition, comment) True +runCreateActionPermission + :: ( QErrM m, UserInfoM m + , CacheRWM m, MonadTx m + ) + => CreateActionPermission -> m EncJSON +runCreateActionPermission createActionPermission = do + adminOnly + runCreateActionPermission_ createActionPermission + return successMsg + data DropActionPermission = DropActionPermission { _dapAction :: !ActionName @@ -246,16 +275,16 @@ runDropActionPermission dropActionPermission = do throw400 NotExists $ "permission for role: " <> role <<> " is not defined on " <>> actionName delActionPermissionFromCache actionName role - liftTx deleteActionPermissionFromCatalog + liftTx $ deleteActionPermissionFromCatalog actionName role return successMsg where actionName = _dapAction dropActionPermission role = _dapRole dropActionPermission - deleteActionPermissionFromCatalog :: Q.TxE QErr () - deleteActionPermissionFromCatalog = - Q.unitQE defaultTxErrorHandler [Q.sql| - DELETE FROM hdb_catalog.hdb_action_permission - WHERE action_name = $1 - AND role_name = $2 - |] (actionName, role) True +deleteActionPermissionFromCatalog :: ActionName -> RoleName -> Q.TxE QErr () +deleteActionPermissionFromCatalog actionName role = + Q.unitQE defaultTxErrorHandler [Q.sql| + DELETE FROM hdb_catalog.hdb_action_permission + WHERE action_name = $1 + AND role_name = $2 + |] (actionName, role) True diff --git a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs index 5be0ef68279a3..e5d7e7605e847 100644 --- a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs @@ -1,5 +1,6 @@ module Hasura.RQL.DDL.CustomTypes ( runSetCustomTypes + , runSetCustomTypes_ , clearCustomTypes , validateCustomTypesAndAddToCache ) where @@ -155,18 +156,27 @@ runSetCustomTypes => CustomTypes -> m EncJSON runSetCustomTypes customTypes = do adminOnly - validateCustomTypesAndAddToCache customTypes - persistCustomTypes + runSetCustomTypes_ customTypes return successMsg - where - persistCustomTypes :: (MonadTx m) => m () - persistCustomTypes = liftTx $ do - clearCustomTypes - Q.unitQE defaultTxErrorHandler [Q.sql| - INSERT into hdb_catalog.hdb_custom_graphql_types - (custom_types) - VALUES ($1) - |] (Identity $ Q.AltJ customTypes) False + +runSetCustomTypes_ + :: ( MonadError QErr m + , CacheRWM m + , MonadTx m + ) + => CustomTypes -> m () +runSetCustomTypes_ customTypes = do + validateCustomTypesAndAddToCache customTypes + liftTx $ persistCustomTypes customTypes + +persistCustomTypes :: CustomTypes -> Q.TxE QErr () +persistCustomTypes customTypes = do + clearCustomTypes + Q.unitQE defaultTxErrorHandler [Q.sql| + INSERT into hdb_catalog.hdb_custom_graphql_types + (custom_types) + VALUES ($1) + |] (Identity $ Q.AltJ customTypes) False clearCustomTypes :: Q.TxE QErr () clearCustomTypes = do diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index 3f8b990333c8a..764c6ca025eea 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -41,6 +41,7 @@ import Hasura.RQL.Types import Hasura.SQL.Types import qualified Database.PG.Query as Q +import qualified Hasura.RQL.DDL.Action as DA import qualified Hasura.RQL.DDL.CustomTypes as DC import qualified Hasura.RQL.DDL.EventTrigger as DE import qualified Hasura.RQL.DDL.Permission as DP @@ -134,6 +135,9 @@ clearMetadata = Q.catchE defaultTxErrorHandler $ do Q.unitQ "DELETE FROM hdb_catalog.remote_schemas" () False Q.unitQ "DELETE FROM hdb_catalog.hdb_allowlist" () False Q.unitQ "DELETE FROM hdb_catalog.hdb_query_collection WHERE is_system_defined <> 'true'" () False + Q.unitQ "DELETE FROM hdb_catalog.hdb_custom_graphql_types" () False + Q.unitQ "DELETE FROM hdb_catalog.hdb_action_permission" () False + Q.unitQ "DELETE FROM hdb_catalog.hdb_action WHERE is_system_defined <> 'true'" () False runClearMetadata :: ( QErrM m, UserInfoM m, CacheRWM m, MonadTx m, MonadIO m @@ -146,6 +150,31 @@ runClearMetadata _ = do DS.buildSchemaCacheStrict return successMsg +-- representation of action permission metadata +data ActionPermissionMetadata + = ActionPermissionMetadata + { _apmRole :: !RoleName + , _apmComment :: !(Maybe Text) + , _apmDefinition :: !ActionPermissionDefinition + } deriving (Show, Eq, Lift) + +$(deriveJSON + (aesonDrop 4 snakeCase){omitNothingFields=True} + ''ActionPermissionMetadata) + +-- representation of action metadata +data ActionMetadata + = ActionMetadata + { _amName :: !ActionName + , _amComment :: !(Maybe Text) + , _amDefinition :: !ActionDefinitionInput + , _amPermissions :: ![ActionPermissionMetadata] + } deriving (Show, Eq, Lift) + +$(deriveJSON + (aesonDrop 3 snakeCase){omitNothingFields=True} + ''ActionMetadata) + data ReplaceMetadata = ReplaceMetadata { aqTables :: ![TableMeta] @@ -153,6 +182,8 @@ data ReplaceMetadata , aqRemoteSchemas :: !(Maybe [TRS.AddRemoteSchemaQuery]) , aqQueryCollections :: !(Maybe [DQC.CreateCollection]) , aqAllowlist :: !(Maybe [DQC.CollectionReq]) + , aqCustomTypes :: !(Maybe CustomTypes) + , aqActions :: !(Maybe [ActionMetadata]) } deriving (Show, Eq, Lift) $(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''ReplaceMetadata) @@ -160,7 +191,8 @@ $(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''ReplaceMetadata) applyQP1 :: (QErrM m, UserInfoM m) => ReplaceMetadata -> m () -applyQP1 (ReplaceMetadata tables mFunctions mSchemas mCollections mAllowlist) = do +applyQP1 (ReplaceMetadata tables mFunctions mSchemas + mCollections mAllowlist _ mActions) = do adminOnly @@ -189,18 +221,22 @@ applyQP1 (ReplaceMetadata tables mFunctions mSchemas mCollections mAllowlist) = withPathK "functions" $ checkMultipleDecls "functions" functions - onJust mSchemas $ \schemas -> + for_ mSchemas $ \schemas -> withPathK "remote_schemas" $ checkMultipleDecls "remote schemas" $ map TRS._arsqName schemas - onJust mCollections $ \collections -> + for_ mCollections $ \collections -> withPathK "query_collections" $ checkMultipleDecls "query collections" $ map DQC._ccName collections - onJust mAllowlist $ \allowlist -> + for_ mAllowlist $ \allowlist -> withPathK "allowlist" $ checkMultipleDecls "allow list" $ map DQC._crCollection allowlist + withPathK "actions" $ + for_ mActions $ \actions -> + checkMultipleDecls "actions" $ map _amName actions + where withTableName qt = withPathK (qualObjectToText qt) functions = fromMaybe [] mFunctions @@ -225,7 +261,8 @@ applyQP2 ) => ReplaceMetadata -> m EncJSON -applyQP2 (ReplaceMetadata tables mFunctions mSchemas mCollections mAllowlist) = do +applyQP2 (ReplaceMetadata tables mFunctions + mSchemas mCollections mAllowlist mCustomTypes mActions) = do liftTx clearMetadata DS.buildSchemaCacheStrict @@ -289,6 +326,20 @@ applyQP2 (ReplaceMetadata tables mFunctions mSchemas mCollections mAllowlist) = -- build GraphQL Context with Remote schemas DS.buildGCtxMap + traverse_ DC.runSetCustomTypes_ mCustomTypes + for_ mActions $ \actions -> for_ actions $ \action -> do + let createAction = + CreateAction (_amName action) (_amDefinition action) (_amComment action) + DA.runCreateAction_ createAction + for_ (_amPermissions action) $ \permission -> do + let createActionPermission = CreateActionPermission (_amName action) + (_apmRole permission) (_apmDefinition permission) + (_apmComment permission) + DA.runCreateActionPermission_ createActionPermission + + -- build the gctx map again after adding custom types and + DS.buildGCtxMap + return successMsg where @@ -369,8 +420,16 @@ fetchMetadata = do -- fetch allow list allowlist <- map DQC.CollectionReq <$> DQC.fetchAllowlist - return $ ReplaceMetadata (M.elems postRelMap) (Just functions) - (Just schemas) (Just collections) (Just allowlist) + mCustomTypes <- fetchCustomTypes + + -- fetch actions + actions <- fetchActions + + return $ ReplaceMetadata + (M.elems postRelMap) (Just functions) + (Just schemas) (Just collections) (Just allowlist) + mCustomTypes + (if null actions then Nothing else actions) where @@ -429,6 +488,54 @@ fetchMetadata = do WHERE is_system_defined = 'false' |] () False + fetchCustomTypes :: Q.TxE QErr (Maybe CustomTypes) + fetchCustomTypes = + fmap (Q.getAltJ . runIdentity) <$> + Q.rawQE defaultTxErrorHandler [Q.sql| + select custom_types::json from hdb_catalog.hdb_custom_graphql_types + |] [] False + fetchActions = + Q.getAltJ . runIdentity . Q.getRow <$> Q.rawQE defaultTxErrorHandler [Q.sql| + select + coalesce( + json_agg( + json_build_object( + 'name', + a.action_name, + 'definition', + a.action_defn, + 'comment', + a.comment, + 'permissions', + ap.permissions + ) + ), + '[]' + ) + from + hdb_catalog.hdb_action as a + left outer join lateral ( + select + coalesce( + json_agg( + json_build_object( + 'role', + ap.role_name, + 'definition', + ap.definition, + 'comment', + ap.comment + ) + ), + '[]' + ) as permissions + from + hdb_catalog.hdb_action_permission ap + where + ap.action_name = a.action_name + ) ap on true; + |] [] False + runExportMetadata :: (QErrM m, UserInfoM m, MonadTx m) => ExportMetadata -> m EncJSON @@ -514,10 +621,12 @@ runDropInconsistentMetadata _ = do purgeMetadataObj :: MonadTx m => MetadataObjId -> m () purgeMetadataObj = liftTx . \case - (MOTable qt) -> DS.deleteTableFromCatalog qt - (MOFunction qf) -> DS.delFunctionFromCatalog qf - (MORemoteSchema rsn) -> DRS.removeRemoteSchemaFromCatalog rsn - (MOCustomTypes) -> DC.clearCustomTypes - (MOTableObj qt (MTORel rn _)) -> DR.delRelFromCatalog qt rn - (MOTableObj qt (MTOPerm rn pt)) -> DP.dropPermFromCatalog qt rn pt - (MOTableObj _ (MTOTrigger trn)) -> DE.delEventTriggerFromCatalog trn + (MOTable qt) -> DS.deleteTableFromCatalog qt + (MOFunction qf) -> DS.delFunctionFromCatalog qf + (MORemoteSchema rsn) -> DRS.removeRemoteSchemaFromCatalog rsn + (MOCustomTypes) -> DC.clearCustomTypes + (MOTableObj qt (MTORel rn _)) -> DR.delRelFromCatalog qt rn + (MOTableObj qt (MTOPerm rn pt)) -> DP.dropPermFromCatalog qt rn pt + (MOTableObj _ (MTOTrigger trn)) -> DE.delEventTriggerFromCatalog trn + (MOAction action) -> DA.deleteActionFromCatalog action Nothing + (MOActionPermission action role) -> DA.deleteActionPermissionFromCatalog action role diff --git a/server/src-lib/Hasura/RQL/Types/Metadata.hs b/server/src-lib/Hasura/RQL/Types/Metadata.hs index 0e0cccbac2eae..ff05af5fdc07c 100644 --- a/server/src-lib/Hasura/RQL/Types/Metadata.hs +++ b/server/src-lib/Hasura/RQL/Types/Metadata.hs @@ -5,6 +5,7 @@ import Hasura.Prelude import qualified Data.Text as T +import Hasura.RQL.Types.Action import Hasura.RQL.Types.Common import Hasura.RQL.Types.EventTrigger import Hasura.RQL.Types.Permission @@ -47,6 +48,8 @@ data MetadataObjId | MORemoteSchema !RemoteSchemaName | MOTableObj !QualifiedTable !TableMetadataObjId | MOCustomTypes + | MOAction !ActionName + | MOActionPermission !ActionName !RoleName deriving (Show, Eq, Generic) instance Hashable MetadataObjId From a7d72ac8c38b649181478d6564b41d8538c09ddc Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Wed, 16 Oct 2019 22:38:20 +0530 Subject: [PATCH 07/62] webhook calls are now supported --- server/src-lib/Hasura/GraphQL/Execute.hs | 26 +++- server/src-lib/Hasura/GraphQL/Resolve.hs | 14 +- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 132 +++++++++++++++--- .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 77 +++++----- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 6 +- server/src-lib/Hasura/GraphQL/Schema.hs | 2 +- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 20 ++- .../src-lib/Hasura/GraphQL/Transport/HTTP.hs | 4 +- .../Hasura/GraphQL/Transport/WebSocket.hs | 2 +- server/src-lib/Hasura/RQL/DDL/Action.hs | 11 +- server/src-lib/Hasura/RQL/DML/Mutation.hs | 6 +- server/src-lib/Hasura/RQL/DML/Returning.hs | 9 +- server/src-lib/Hasura/RQL/DML/Select.hs | 22 +-- .../src-lib/Hasura/RQL/DML/Select/Internal.hs | 94 ++++++------- server/src-lib/Hasura/RQL/DML/Select/Types.hs | 87 +++++------- server/src-lib/Hasura/RQL/Types/Action.hs | 29 +++- server/src-lib/Hasura/SQL/DML.hs | 38 ++++- server/src-lib/Hasura/SQL/Rewrite.hs | 6 +- 18 files changed, 367 insertions(+), 218 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Execute.hs b/server/src-lib/Hasura/GraphQL/Execute.hs index d2404c508c85f..c6d41b32eb930 100644 --- a/server/src-lib/Hasura/GraphQL/Execute.hs +++ b/server/src-lib/Hasura/GraphQL/Execute.hs @@ -183,10 +183,11 @@ getResolvedExecPlan -> Bool -> SchemaCache -> SchemaCacheVer + -> HTTP.Manager -> GQLReqUnparsed -> m ExecPlanResolved getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx - enableAL sc scVer reqUnparsed = do + enableAL sc scVer httpManager reqUnparsed = do planM <- liftIO $ EP.getPlan scVer (userRole userInfo) opNameM queryStr planCache let usrVars = userVars userInfo @@ -210,7 +211,7 @@ getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx forM partialExecPlan $ \(gCtx, rootSelSet) -> case rootSelSet of VQ.RMutation selSet -> - ExOpMutation <$> getMutOp gCtx sqlGenCtx userInfo selSet + ExOpMutation <$> getMutOp gCtx sqlGenCtx userInfo httpManager selSet VQ.RQuery selSet -> do (queryTx, plan, genSql) <- getQueryOp gCtx sqlGenCtx userInfo selSet traverse_ (addPlanToCache . EP.RPQuery) plan @@ -273,6 +274,7 @@ resolveMutSelSet , Has OrdByCtx r , Has SQLGenCtx r , Has InsCtxMap r + , Has HTTP.Manager r ) => VQ.SelSet -> m LazyRespTx @@ -300,10 +302,26 @@ getMutOp => GCtx -> SQLGenCtx -> UserInfo + -> HTTP.Manager -> VQ.SelSet -> m LazyRespTx -getMutOp ctx sqlGenCtx userInfo selSet = - runE ctx sqlGenCtx userInfo $ resolveMutSelSet selSet +getMutOp ctx sqlGenCtx userInfo manager selSet = + runE_ $ resolveMutSelSet selSet + where + runE_ action = do + res <- runExceptT $ runReaderT action + ( userInfo, queryCtxMap, mutationCtxMap + , typeMap, fldMap, ordByCtx, insCtxMap, sqlGenCtx + , manager + ) + either throwError return res + where + queryCtxMap = _gQueryCtxMap ctx + mutationCtxMap = _gMutationCtxMap ctx + typeMap = _gTypes ctx + fldMap = _gFields ctx + ordByCtx = _gOrdByCtx ctx + insCtxMap = _gInsCtxMap ctx getSubsOpM :: ( MonadError QErr m diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 8653a6edd41d7..d61661708043a 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -22,6 +22,7 @@ import Data.Has import qualified Data.HashMap.Strict as Map import qualified Database.PG.Query as Q import qualified Language.GraphQL.Draft.Syntax as G +import qualified Network.HTTP.Client as HTTP import Hasura.GraphQL.Resolve.Context import Hasura.Prelude @@ -41,8 +42,8 @@ data QueryRootFldAST v = QRFPk !(DS.AnnSimpleSelG v) | QRFSimple !(DS.AnnSimpleSelG v) | QRFAgg !(DS.AnnAggSelG v) - | QRFFnSimple !(DS.AnnFnSelSimpleG v) - | QRFFnAgg !(DS.AnnFnSelAggG v) + | QRFFnSimple !(DS.AnnSimpleSelG v) + | QRFFnAgg !(DS.AnnAggSelG v) | QRFActionSelect !(RA.ActionSelect v) deriving (Show, Eq) @@ -58,8 +59,8 @@ traverseQueryRootFldAST f = \case QRFPk s -> QRFPk <$> DS.traverseAnnSimpleSel f s QRFSimple s -> QRFSimple <$> DS.traverseAnnSimpleSel f s QRFAgg s -> QRFAgg <$> DS.traverseAnnAggSel f s - QRFFnSimple s -> QRFFnSimple <$> DS.traverseAnnFnSimple f s - QRFFnAgg s -> QRFFnAgg <$> DS.traverseAnnFnAgg f s + QRFFnSimple s -> QRFFnSimple <$> DS.traverseAnnSimpleSel f s + QRFFnAgg s -> QRFFnAgg <$> DS.traverseAnnAggSel f s QRFActionSelect s -> QRFActionSelect <$> RA.traverseActionSelect f s toPGQuery :: QueryRootFldResolved -> Q.Query @@ -67,8 +68,8 @@ toPGQuery = \case QRFPk s -> DS.selectQuerySQL True s QRFSimple s -> DS.selectQuerySQL False s QRFAgg s -> DS.selectAggQuerySQL s - QRFFnSimple s -> DS.mkFuncSelectSimple s - QRFFnAgg s -> DS.mkFuncSelectAgg s + QRFFnSimple s -> DS.selectQuerySQL False s + QRFFnAgg s -> DS.selectAggQuerySQL s QRFActionSelect s -> RA.actionSelectToSql s validateHdrs @@ -117,6 +118,7 @@ mutFldToTx , Has OrdByCtx r , Has SQLGenCtx r , Has InsCtxMap r + , Has HTTP.Manager r ) => V.Field -> m RespTx diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index d681bbb23132a..2aef1e9aca677 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -8,27 +8,39 @@ module Hasura.GraphQL.Resolve.Action , actionSelectToSql ) where -import Data.Has import Hasura.Prelude +import Control.Exception (try) +import Control.Lens +import Data.Has + import qualified Data.Aeson as J +import qualified Data.Aeson.Casing as J +import qualified Data.Aeson.TH as J +import qualified Data.HashMap.Strict as Map +import qualified Data.Text as T import qualified Data.UUID as UUID import qualified Database.PG.Query as Q import qualified Language.GraphQL.Draft.Syntax as G +import qualified Network.HTTP.Client as HTTP +import qualified Network.Wreq as Wreq +import qualified Hasura.RQL.DML.Select as RS import qualified Hasura.SQL.DML as S -import Hasura.RQL.DML.Internal (dmlTxErrorHandler) - -import Hasura.RQL.DML.Select (asSingleRowJsonResp) - +import Hasura.EncJSON import Hasura.GraphQL.Resolve.Context import Hasura.GraphQL.Resolve.InputValue import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types +import Hasura.HTTP +import Hasura.RQL.DML.Internal (dmlTxErrorHandler) +import Hasura.RQL.DML.Select (asSingleRowJsonResp) import Hasura.RQL.Types import Hasura.SQL.Types -import Hasura.SQL.Value (pgScalarValueToJson) +import Hasura.SQL.Value (PGScalarValue (..), + pgScalarValueToJson, + toTxtValue) data InputFieldResolved = InputFieldSimple !Text @@ -51,10 +63,11 @@ resolveOutputSelectionSet :: ( MonadError QErr m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => G.NamedType + => ObjTyInfo + -> G.NamedType -> SelSet -> m [(Text, OutputFieldResolved)] -resolveOutputSelectionSet ty selSet = +resolveOutputSelectionSet objTyInfo ty selSet = withSelSet selSet $ \fld -> case _fName fld of "__typename" -> return $ OutputFieldTypename ty G.Name t -> return $ OutputFieldSimple t @@ -72,14 +85,14 @@ resolveResponseSelectionSet ty selSet = "output" -> ResponseFieldOutput <$> - resolveOutputSelectionSet (_fType fld) (_fSelSet fld) + resolveOutputSelectionSet undefined (_fType fld) (_fSelSet fld) -- the metadata columns "id" -> return $ mkMetadataField "id" "created_at" -> return $ mkMetadataField "created_at" "status" -> return $ mkMetadataField "status" - G.Name t -> throw500 $ "unexpected field in actions' response : " <> t + G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t where mkMetadataField = ResponseFieldMetadata . PGCol @@ -103,7 +116,7 @@ type ActionSelectResolved = ActionSelect S.SQLExp type ActionSelectUnresolved = ActionSelect UnresolvedVal actionSelectToSql :: ActionSelectResolved -> Q.Query -actionSelectToSql (ActionSelect actionIdExp selection filter) = +actionSelectToSql (ActionSelect actionIdExp selection actionFilter) = Q.fromBuilder $ toSQL selectAST where selectAST = @@ -172,21 +185,104 @@ actionSelectToTx :: ActionSelectResolved -> RespTx actionSelectToTx actionSelect = asSingleRowJsonResp (actionSelectToSql actionSelect) [] + +data ActionWebhookPayload + = ActionWebhookPayload + { _awpSessionVariables :: !UserVars + , _awpInput :: !J.Value + } deriving (Show, Eq) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookPayload) + +data ActionWebhookResponse + = ActionWebhookResponse + { _awrData :: !(Maybe J.Value) + , _awrErrors :: !(Maybe J.Value) + } deriving (Show, Eq) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookResponse) + +data ResolvePlan + = ResolveReturn + | ResolvePostgres [(PGCol, PGScalarType)] ![(Text, OutputFieldResolved)] + deriving (Show, Eq) + resolveActionInsertSync :: ( MonadError QErr m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r + , Has HTTP.Manager r ) => Field - -> Text - -- We need the sesion variables for column presets + -> ResolvedWebhook + -> ActionOutputTypeInfo -> UserVars -> m RespTx -resolveActionInsertSync field executionContext sessionVariables = - throw500 "sync actions not yet implemented" +resolveActionInsertSync field resolvedWebhook outputTypeInfo sessionVariables = do + inputArgs <- withArg (_fArguments field) "input" (return . annInpValueToJson) + resolvePlan <- case outputTypeInfo of + ActionOutputScalar _ -> return ResolveReturn + ActionOutputEnum _ -> return ResolveReturn + ActionOutputObject objTyInfo -> do + let definitionList = + flip zip (repeat PGJSON) $ + map (PGCol . G.unName . _fiName) $ Map.elems $ _otiFields objTyInfo + ResolvePostgres definitionList <$> + resolveOutputSelectionSet objTyInfo (_fType field) (_fSelSet field) + manager <- asks getter + stringifyNumerics <- stringifyNum <$> asks getter + return $ do + webhookRes <- callWebhook manager inputArgs + returnResponse stringifyNumerics webhookRes resolvePlan + where + returnResponse stringifyNumerics webhookData = \case + ResolveReturn -> return $ encJFromJValue webhookData + ResolvePostgres definitionList selSet -> do + let functionName = QualifiedObject (SchemaName "pg_catalog") $ + FunctionName "json_to_record" + functionArgs = RS.FunctionArgsExp + (pure $ toTxtValue $ WithScalarType PGJSON $ + PGValJSON $ Q.JSON webhookData) + mempty + fromExpression = + RS.FromExpressionFunction functionName functionArgs + (Just definitionList) + annFields = flip map selSet $ \(alias, outputField) -> + (FieldName alias,) $ case outputField of + OutputFieldSimple fieldName -> + -- TODO: + RS.FCol ( PGCol fieldName + , PGColumnScalar PGJSON + ) Nothing + OutputFieldTypename typeName -> + RS.FExp $ G.unName $ G.unNamedType typeName + OutputFieldRelationship -> undefined + let selectAst = RS.AnnSelG annFields fromExpression + RS.noTablePermissions RS.noTableArgs stringifyNumerics + asSingleRowJsonResp (RS.selectQuerySQL True selectAst) [] + + callWebhook manager actionInput = do + let options = wreqOptions manager [contentType] + contentType = ("Content-Type", "application/json") + postPayload = J.toJSON $ ActionWebhookPayload + sessionVariables actionInput + url = (T.unpack $ unResolvedWebhook resolvedWebhook) + httpResponse <- liftIO $ try $ + Wreq.asJSON =<< Wreq.postWith options url postPayload + case (^. Wreq.responseBody) <$> httpResponse of + Left e -> + throw500WithDetail "http exception when calling webhook" $ + J.toJSON $ HttpException e + Right response -> case (_awrData response, _awrErrors response) of + (Nothing, Nothing) -> + throw500WithDetail "internal error" $ + J.String "webhook response has neither 'data' nor 'errors'" + (Just _, Just _) -> + throw500WithDetail "internal error" $ + J.String "webhook response cannot have both 'data' and 'errors'" + (Just d, Nothing) -> return d + (Nothing, Just e) -> throwVE $ T.pack $ show e resolveActionInsert :: ( MonadError QErr m, MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r + , Has OrdByCtx r, Has SQLGenCtx r, Has HTTP.Manager r ) => Field -> ActionExecutionContext @@ -195,8 +291,8 @@ resolveActionInsert -> m RespTx resolveActionInsert field executionContext sessionVariables = case executionContext of - ActionExecutionSyncWebhook webhook -> - resolveActionInsertSync field webhook sessionVariables + ActionExecutionSyncWebhook webhook outputTypeInfo -> + resolveActionInsertSync field webhook outputTypeInfo sessionVariables ActionExecutionAsync actionFilter -> resolveActionInsertAsync field actionFilter sessionVariables diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 93af27a84b8e9..7832bdcae7e74 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -40,7 +40,6 @@ jsonPathToColExp t = case parseJSONPath t of elToColExp (Key k) = S.SELit k elToColExp (Index i) = S.SELit $ T.pack (show i) - argsToColOp :: (MonadResolve m) => ArgsMap -> m (Maybe RS.ColOp) argsToColOp args = maybe (return Nothing) toOp $ Map.lookup "path" args where @@ -64,16 +63,20 @@ processTableSelectionSet fldTy flds = fldInfo <- getFldInfo fldTy fldName case fldInfo of Left colInfo -> - RS.FCol colInfo <$> argsToColOp (_fArguments fld) + RS.FCol (pgiColumn colInfo, pgiType colInfo) <$> + argsToColOp (_fArguments fld) Right (RelationshipField relInfo isAgg colGNameMap tableFilter tableLimit) -> do - let relTN = riRTable relInfo + let relationshipTableFromExp = + RS.FromExpressionTable $ riRTable relInfo colMapping = riMapping relInfo rn = riName relInfo if isAgg then do - aggSel <- fromAggField relTN colGNameMap tableFilter tableLimit fld + aggSel <- fromAggField relationshipTableFromExp + colGNameMap tableFilter tableLimit fld return $ RS.FArr $ RS.ASAgg $ RS.AnnRelG rn colMapping aggSel else do - annSel <- fromField relTN colGNameMap tableFilter tableLimit fld + annSel <- fromField relationshipTableFromExp + colGNameMap tableFilter tableLimit fld let annRel = RS.AnnRelG rn colMapping annSel return $ case riType relInfo of ObjRel -> RS.FObj annRel @@ -120,8 +123,8 @@ parseTableArgs colGNameMap args = do initOrdBys = take colsLen $ toList ordBys initOrdByCols = flip mapMaybe initOrdBys $ \ob -> case obiColumn ob of - RS.AOCPG ci -> Just $ pgiColumn ci - _ -> Nothing + RS.AOCPG pgCol -> Just pgCol + _ -> Nothing isValid = (colsLen == length initOrdByCols) && all (`elem` initOrdByCols) (toList cols) @@ -129,24 +132,24 @@ parseTableArgs colGNameMap args = do "\"distinct_on\" columns must match initial \"order_by\" columns" type AnnSimpleSelect = RS.AnnSimpleSelG UnresolvedVal +type FromExpressionUnresolved = RS.FromExpression UnresolvedVal fromField :: ( MonadResolve m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => QualifiedTable + => FromExpressionUnresolved -> PGColGNameMap -> AnnBoolExpPartialSQL -> Maybe Int -> Field -> m AnnSimpleSelect -fromField tn colGNameMap permFilter permLimitM fld = fieldAsPath fld $ do +fromField fromExp colGNameMap permFilter permLimitM fld = fieldAsPath fld $ do tableArgs <- parseTableArgs colGNameMap args annFlds <- processTableSelectionSet (_fType fld) $ _fSelSet fld let unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter - let tabFrom = RS.TableFrom tn Nothing - tabPerm = RS.TablePerm unresolvedPermFltr permLimitM + let tabPerm = RS.TablePerm unresolvedPermFltr permLimitM strfyNum <- stringifyNum <$> asks getter - return $ RS.AnnSelG annFlds tabFrom tabPerm tableArgs strfyNum + return $ RS.AnnSelG annFlds fromExp tabPerm tableArgs strfyNum where args = _fArguments fld @@ -188,7 +191,7 @@ getAnnObItems f nt obj = do <> showNamedTy nt <> " map" case ordByItem of OBIPGCol ci -> do - let aobCol = f $ RS.AOCPG ci + let aobCol = f $ RS.AOCPG $ pgiColumn ci (_, enumValM) <- asEnumValM v ordByItemM <- forM enumValM $ \enumVal -> do (ordTy, nullsOrd) <- parseOrderByEnum enumVal @@ -290,7 +293,7 @@ fromFieldByPKey fromFieldByPKey tn colArgMap permFilter fld = fieldAsPath fld $ do boolExp <- pgColValToBoolExp colArgMap $ _fArguments fld annFlds <- processTableSelectionSet fldTy $ _fSelSet fld - let tabFrom = RS.TableFrom tn Nothing + let tabFrom = RS.FromExpressionTable tn unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter tabPerm = RS.TablePerm unresolvedPermFltr Nothing @@ -307,7 +310,7 @@ convertSelect => SelOpCtx -> Field -> m (RS.AnnSimpleSelG UnresolvedVal) convertSelect opCtx fld = withPathK "selectionSet" $ - fromField qt colGNameMap permFilter permLimit fld + fromField (RS.FromExpressionTable qt) colGNameMap permFilter permLimit fld where SelOpCtx qt _ colGNameMap permFilter permLimit = opCtx @@ -382,20 +385,19 @@ fromAggField :: ( MonadResolve m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => QualifiedTable + => FromExpressionUnresolved -> PGColGNameMap -> AnnBoolExpPartialSQL -> Maybe Int -> Field -> m AnnAggSel -fromAggField tn colGNameMap permFilter permLimit fld = fieldAsPath fld $ do +fromAggField fromExpression colGNameMap permFilter permLimit fld = fieldAsPath fld $ do tableArgs <- parseTableArgs colGNameMap args aggSelFlds <- fromAggSelSet colGNameMap (_fType fld) (_fSelSet fld) let unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter - let tabFrom = RS.TableFrom tn Nothing - tabPerm = RS.TablePerm unresolvedPermFltr permLimit + let tabPerm = RS.TablePerm unresolvedPermFltr permLimit strfyNum <- stringifyNum <$> asks getter - return $ RS.AnnSelG aggSelFlds tabFrom tabPerm tableArgs strfyNum + return $ RS.AnnSelG aggSelFlds fromExpression tabPerm tableArgs strfyNum where args = _fArguments fld @@ -406,7 +408,7 @@ convertAggSelect => SelOpCtx -> Field -> m (RS.AnnAggSelG UnresolvedVal) convertAggSelect opCtx fld = withPathK "selectionSet" $ - fromAggField qt colGNameMap permFilter permLimit fld + fromAggField (RS.FromExpressionTable qt) colGNameMap permFilter permLimit fld where SelOpCtx qt _ colGNameMap permFilter permLimit = opCtx @@ -435,16 +437,17 @@ parseFunctionArgs argSeq val = flip withObject val $ \_ obj -> do throw400 NotSupported "Non default arguments cannot be omitted" else pure Nothing -fromFuncQueryField +getFunctionFromExpression :: (MonadResolve m) - => (Field -> m s) - -> QualifiedFunction -> FuncArgSeq + => QualifiedFunction + -> FuncArgSeq -> Field - -> m (RS.AnnFnSelG s UnresolvedVal) -fromFuncQueryField fn qf argSeq fld = fieldAsPath fld $ do + -> m FromExpressionUnresolved +getFunctionFromExpression qf argSeq fld = fieldAsPath fld $ do funcArgsM <- withArgM (_fArguments fld) "args" $ parseFunctionArgs argSeq - let funcArgs = fromMaybe RS.emptyFunctionArgsExp funcArgsM - RS.AnnFnSel qf funcArgs <$> fn fld + return $ RS.FromExpressionFunction qf + (fromMaybe RS.emptyFunctionArgsExp funcArgsM) + Nothing -- no definition list convertFuncQuerySimple :: ( MonadResolve m @@ -453,12 +456,13 @@ convertFuncQuerySimple , Has OrdByCtx r , Has SQLGenCtx r ) - => FuncQOpCtx -> Field -> m (RS.AnnFnSelSimpleG UnresolvedVal) + => FuncQOpCtx -> Field -> m AnnSimpleSelect convertFuncQuerySimple funcOpCtx fld = - withPathK "selectionSet" $ - fromFuncQueryField (fromField qt colGNameMap permFilter permLimit) qf argSeq fld + withPathK "selectionSet" $ do + fromExpression <- getFunctionFromExpression qf argSeq fld + fromField fromExpression colGNameMap permFilter permLimit fld where - FuncQOpCtx qt _ colGNameMap permFilter permLimit qf argSeq = funcOpCtx + FuncQOpCtx _ colGNameMap permFilter permLimit qf argSeq = funcOpCtx convertFuncQueryAgg :: ( MonadResolve m @@ -467,9 +471,10 @@ convertFuncQueryAgg , Has OrdByCtx r , Has SQLGenCtx r ) - => FuncQOpCtx -> Field -> m (RS.AnnFnSelAggG UnresolvedVal) + => FuncQOpCtx -> Field -> m AnnAggSel convertFuncQueryAgg funcOpCtx fld = - withPathK "selectionSet" $ - fromFuncQueryField (fromAggField qt colGNameMap permFilter permLimit) qf argSeq fld + withPathK "selectionSet" $ do + fromExpression <- getFunctionFromExpression qf argSeq fld + fromAggField fromExpression colGNameMap permFilter permLimit fld where - FuncQOpCtx qt _ colGNameMap permFilter permLimit qf argSeq = funcOpCtx + FuncQOpCtx _ colGNameMap permFilter permLimit qf argSeq = funcOpCtx diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index e29459b6a05d4..275ae693d57e1 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -10,6 +10,7 @@ import qualified Data.Text as T import qualified Language.GraphQL.Draft.Syntax as G import Hasura.GraphQL.Validate.Types +import Hasura.RQL.Types.Action import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.Column import Hasura.RQL.Types.Common @@ -65,8 +66,7 @@ data SelPkOpCtx data FuncQOpCtx = FuncQOpCtx - { _fqocTable :: !QualifiedTable - , _fqocHeaders :: ![T.Text] + { _fqocHeaders :: ![T.Text] , _fqocAllCols :: !PGColGNameMap , _fqocFilter :: !AnnBoolExpPartialSQL , _fqocLimit :: !(Maybe Int) @@ -92,7 +92,7 @@ data DelOpCtx } deriving (Show, Eq) data ActionExecutionContext - = ActionExecutionSyncWebhook !Text + = ActionExecutionSyncWebhook !ResolvedWebhook !ActionOutputTypeInfo | ActionExecutionAsync !AnnBoolExpPartialSQL deriving (Show, Eq) diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 1bd15f09a3b04..81dd3180f5981 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -396,7 +396,7 @@ getRootFldsRole' tn primCols constraints fields funcs insM funcFldHelper f g pFltr pLimit hdrs = flip map funcs $ \fi -> - ( f . FuncQOpCtx tn hdrs colGNameMap pFltr pLimit (fiName fi) $ mkFuncArgItemSeq fi + ( f . FuncQOpCtx hdrs colGNameMap pFltr pLimit (fiName fi) $ mkFuncArgItemSeq fi , g fi $ fiDescription fi ) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 62a788b8746a9..66b275f7ed108 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -150,17 +150,21 @@ mkActionResponseTypeInfo actionName outputType = mkMutationField :: ActionName - -> ResolvedActionDefinition + -> ActionInfo -> ActionPermissionInfo -> (ActionExecutionContext, ObjFldInfo) -mkMutationField actionName definition permission = +mkMutationField actionName actionInfo permission = ( actionExecutionContext , fieldInfo ) where + definition = _aiDefintion actionInfo actionExecutionContext = case getActionKind definition of - ActionSynchronous -> ActionExecutionSyncWebhook $ _adWebhook definition + ActionSynchronous -> + ActionExecutionSyncWebhook + (_adWebhook definition) + (_aiOutputTypeInfo actionInfo) ActionAsynchronous -> ActionExecutionAsync $ _apiFilter permission -- TODO: we need to capture the comment from action definition @@ -221,16 +225,18 @@ mkQueryField actionName definition permission = mkActionFieldsAndTypes :: ActionName - -> ResolvedActionDefinition + -> ActionInfo -> ActionPermissionInfo -> ( Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) -- context, field, response type info , (ActionExecutionContext, ObjFldInfo) -- mutation field ) -mkActionFieldsAndTypes actionName definition permission = +mkActionFieldsAndTypes actionName actionInfo permission = ( mkQueryField actionName definition permission - , mkMutationField actionName definition permission + , mkMutationField actionName actionInfo permission ) + where + definition = _aiDefintion actionInfo mkActionSchemaOne :: ActionInfo @@ -240,7 +246,7 @@ mkActionSchemaOne ) mkActionSchemaOne actionInfo = flip fmap permissions $ \permission -> - mkActionFieldsAndTypes (_aiName actionInfo) (_aiDefintion actionInfo) permission + mkActionFieldsAndTypes (_aiName actionInfo) actionInfo permission where adminPermission = ActionPermissionInfo adminRole annBoolExpTrue permissions = Map.insert adminRole adminPermission $ _aiPermissions actionInfo diff --git a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs index 9b21407e44936..100a45ed819b5 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs @@ -25,9 +25,9 @@ runGQ -> GQLReqUnparsed -> m (HttpResponse EncJSON) runGQ reqId userInfo reqHdrs req = do - E.ExecutionCtx _ sqlGenCtx pgExecCtx planCache sc scVer _ enableAL <- ask + E.ExecutionCtx _ sqlGenCtx pgExecCtx planCache sc scVer httpManager enableAL <- ask execPlan <- E.getResolvedExecPlan pgExecCtx planCache - userInfo sqlGenCtx enableAL sc scVer req + userInfo sqlGenCtx enableAL sc scVer httpManager req case execPlan of E.GExPHasura resolvedOp -> flip HttpResponse Nothing <$> runHasuraGQ reqId req userInfo resolvedOp diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs index a27de37d53012..8595883c5adce 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs @@ -277,7 +277,7 @@ onStart serverEnv wsConn (StartMsg opId q) = catchAndIgnore $ do requestId <- getRequestId reqHdrs (sc, scVer) <- liftIO $ IORef.readIORef gCtxMapRef execPlanE <- runExceptT $ E.getResolvedExecPlan pgExecCtx - planCache userInfo sqlGenCtx enableAL sc scVer q + planCache userInfo sqlGenCtx enableAL sc scVer httpMgr q execPlan <- either (withComplete . preExecErr requestId) return execPlanE let execCtx = E.ExecutionCtx logger sqlGenCtx pgExecCtx planCache sc scVer httpMgr enableAL diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 677447e841ded..59d63522687d6 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -117,14 +117,15 @@ buildActionInfo q = do when (hasList responseType) $ throw400 InvalidParams $ "the output type: " <> G.showGT responseType <> " cannot be a list" responseTypeInfo <- getCustomTypeInfo responseBaseType - case responseTypeInfo of - VT.TIScalar _ -> return () - VT.TIEnum _ -> return () - VT.TIObj _ -> return () + outputTypeInfo <- case responseTypeInfo of + VT.TIScalar typeInfo -> return $ ActionOutputScalar typeInfo + VT.TIEnum typeInfo -> return $ ActionOutputEnum typeInfo + VT.TIObj typeInfo -> return $ ActionOutputObject typeInfo _ -> throw400 InvalidParams $ "the output type: " <> showNamedTy responseBaseType <> " should be a scalar/enum/object" - return $ ActionInfo actionName actionDefinition mempty + return $ ActionInfo actionName + (fmap ResolvedWebhook actionDefinition) outputTypeInfo mempty where getCustomTypeInfo typeName = do customTypes <- scCustomTypes <$> askSchemaCache diff --git a/server/src-lib/Hasura/RQL/DML/Mutation.hs b/server/src-lib/Hasura/RQL/DML/Mutation.hs index 025545f19b1a0..7ea1ef86260b6 100644 --- a/server/src-lib/Hasura/RQL/DML/Mutation.hs +++ b/server/src-lib/Hasura/RQL/DML/Mutation.hs @@ -67,10 +67,12 @@ mutateAndFetchCols qt cols (cte, p) strfyNum = <$> Q.rawQE dmlTxErrorHandler (Q.fromBuilder sql) (toList p) True where aliasIden = Iden $ qualObjectToText qt <> "__mutation_result" - tabFrom = TableFrom qt $ Just aliasIden + tabFrom = FromExpressionIdentifier aliasIden tabPerm = TablePerm annBoolExpTrue Nothing selFlds = flip map cols $ - \ci -> (fromPGCol $ pgiColumn ci, FCol ci Nothing) + \ci -> ( fromPGCol $ pgiColumn ci + , FCol (pgiColumn ci, pgiType ci) Nothing + ) sql = toSQL selectWith selectWith = S.SelectWith [(S.Alias aliasIden, cte)] select diff --git a/server/src-lib/Hasura/RQL/DML/Returning.hs b/server/src-lib/Hasura/RQL/DML/Returning.hs index 902f4ee94e0a0..1ff0d94b1209d 100644 --- a/server/src-lib/Hasura/RQL/DML/Returning.hs +++ b/server/src-lib/Hasura/RQL/DML/Returning.hs @@ -56,8 +56,8 @@ pgColsFromMutFld = \case MExp _ -> [] MRet selFlds -> flip mapMaybe selFlds $ \(_, annFld) -> case annFld of - FCol (PGColumnInfo col _ colTy _ _) _ -> Just (col, colTy) - _ -> Nothing + FCol (col, colTy) _ -> Just (col, colTy) + _ -> Nothing pgColsFromMutFlds :: MutFlds -> [(PGCol, PGColumnType)] pgColsFromMutFlds = concatMap (pgColsFromMutFld . snd) @@ -65,7 +65,8 @@ pgColsFromMutFlds = concatMap (pgColsFromMutFld . snd) pgColsToSelFlds :: [PGColumnInfo] -> [(FieldName, AnnFld)] pgColsToSelFlds cols = flip map cols $ - \pgColInfo -> (fromPGCol $ pgiColumn pgColInfo, FCol pgColInfo Nothing) + \pgColInfo -> ( fromPGCol $ pgiColumn pgColInfo + , FCol (pgiColumn pgColInfo, pgiType pgColInfo) Nothing) mkDefaultMutFlds :: Maybe [PGColumnInfo] -> MutFlds mkDefaultMutFlds = \case @@ -88,7 +89,7 @@ mkMutFldExp qt singleObj strfyNum = \case MExp t -> S.SELit t MRet selFlds -> -- let tabFrom = TableFrom qt $ Just frmItem - let tabFrom = TableFrom qt $ Just $ qualTableToAliasIden qt + let tabFrom = FromExpressionIdentifier $ qualTableToAliasIden qt tabPerm = TablePerm annBoolExpTrue Nothing in S.SESelect $ mkSQLSelect singleObj $ AnnSelG selFlds tabFrom tabPerm noTableArgs strfyNum diff --git a/server/src-lib/Hasura/RQL/DML/Select.hs b/server/src-lib/Hasura/RQL/DML/Select.hs index cffdb8fb1c7a5..4301dddd463b7 100644 --- a/server/src-lib/Hasura/RQL/DML/Select.hs +++ b/server/src-lib/Hasura/RQL/DML/Select.hs @@ -2,8 +2,6 @@ module Hasura.RQL.DML.Select ( selectP2 , selectQuerySQL , selectAggQuerySQL - , mkFuncSelectSimple - , mkFuncSelectAgg , convSelectQuery , asSingleRowJsonResp , module Hasura.RQL.DML.Select.Internal @@ -120,7 +118,7 @@ convOrderByElem sessVarBldr (flds, spi) = \case [ fldName <<> " has type 'geometry'" , " and cannot be used in order_by" ] - else return $ AOCPG colInfo + else return $ AOCPG $ pgiColumn colInfo FIRelationship _ -> throw400 UnexpectedPayload $ mconcat [ fldName <<> " is a" , " relationship and should be expanded" @@ -157,7 +155,7 @@ convSelectQ fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do indexedForM (sqColumns selQ) $ \case (ECSimple pgCol) -> do colInfo <- convExtSimple fieldInfoMap selPermInfo pgCol - return (fromPGCol pgCol, FCol colInfo Nothing) + return (fromPGCol pgCol, FCol (pgiColumn colInfo, pgiType colInfo) Nothing) (ECRel relName mAlias relSelQ) -> do annRel <- convExtRel fieldInfoMap relName mAlias relSelQ sessVarBldr prepValBldr @@ -185,7 +183,7 @@ convSelectQ fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do resolvedSelFltr <- convAnnBoolExpPartialSQL sessVarBldr $ spiFilter selPermInfo - let tabFrom = TableFrom (spiTable selPermInfo) Nothing + let tabFrom = FromExpressionTable (spiTable selPermInfo) tabPerm = TablePerm resolvedSelFltr mPermLimit tabArgs = TableArgs wClause annOrdByM mQueryLimit (S.intToSQLExp <$> mQueryOffset) Nothing @@ -261,20 +259,6 @@ convSelectQuery sessVarBldr prepArgBuilder (DMLQuery qt selQ) = do convSelectQ (_tiFieldInfoMap tabInfo) selPermInfo extSelQ sessVarBldr prepArgBuilder -mkFuncSelectSimple - :: AnnFnSelSimple - -> Q.Query -mkFuncSelectSimple annFnSel = - Q.fromBuilder $ toSQL $ - mkFuncSelectWith (mkSQLSelect False) annFnSel - -mkFuncSelectAgg - :: AnnFnSelAgg - -> Q.Query -mkFuncSelectAgg annFnSel = - Q.fromBuilder $ toSQL $ - mkFuncSelectWith mkAggSelect annFnSel - selectP2 :: Bool -> (AnnSimpleSel, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON selectP2 asSingleObject (sel, p) = encJFromBS . runIdentity . Q.getRow diff --git a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs index 7705824fdeea5..070478b00698e 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs @@ -1,7 +1,6 @@ module Hasura.RQL.DML.Select.Internal ( mkSQLSelect , mkAggSelect - , mkFuncSelectWith , module Hasura.RQL.DML.Select.Types ) where @@ -28,15 +27,35 @@ import qualified Hasura.SQL.DML as S -- Stage 1 : Convert input query into an annotated AST -- Stage 2 : Convert annotated AST to SQL Select -tableFromToFromItem :: TableFrom -> S.FromItem +tableFromToFromItem :: FromExpression S.SQLExp -> S.FromItem tableFromToFromItem = \case - TableFrom tn Nothing -> S.FISimple tn Nothing - TableFrom _ (Just i) -> S.FIIden i + FromExpressionTable tn -> S.FISimple tn Nothing + FromExpressionIdentifier i -> S.FIIden i + FromExpressionFunction functionName functionArgs definitionListM -> + S.mkFuncFromItem functionName + (mkSQLFunctionArgs functionArgs) $ + S.mkFunctionAlias (mkFunctionAlias functionName) definitionListM + where + mkSQLFunctionArgs (FunctionArgsExp positional named) = + S.FunctionArgs positional named -tableFromToQual :: TableFrom -> S.Qual +-- This function shouldn't be present ideally +-- You should be able to retrieve this information +-- from the FromItem generated with tableFromToFromItem +-- however given from S.FromItem is modelled, it is not +-- possible currently +tableFromToQual :: FromExpression S.SQLExp -> S.Qual tableFromToQual = \case - TableFrom tn Nothing -> S.QualTable tn - TableFrom _ (Just i) -> S.QualIden i + FromExpressionTable tn -> S.QualTable tn + FromExpressionIdentifier i -> S.QualIden i + FromExpressionFunction functionName _ _ -> + S.QualIden $ mkFunctionAlias functionName + +mkFunctionAlias :: QualifiedFunction -> Iden +mkFunctionAlias functionName = + Iden $ getSchemaTxt sn <> "_" <> getFunctionTxt fn <> "__result" + where + QualifiedObject sn fn = functionName aggFldToExp :: AggFlds -> S.SQLExp aggFldToExp aggFlds = jsonRow @@ -162,8 +181,8 @@ mkBaseTableAls pfx = pfx <> Iden ".base" mkBaseTableColAls :: Iden -> PGCol -> Iden -mkBaseTableColAls pfx pgCol = - pfx <> Iden ".pg." <> toIden pgCol +mkBaseTableColAls pfx pgColumn = + pfx <> Iden ".pg." <> toIden pgColumn mkOrderByFieldName :: RelName -> FieldName mkOrderByFieldName relName = @@ -193,7 +212,7 @@ buildJsonObject pfx parAls arrRelCtx strfyNum flds = toSQLFld :: (FieldName -> S.SQLExp -> f) -> (FieldName, AnnFld) -> f toSQLFld f (fldAls, fld) = f fldAls $ case fld of - FCol col args -> toSQLCol col args + FCol (pgColumn, pgColumnType) args -> toSQLCol pgColumn pgColumnType args FExp e -> S.SELit e FObj objSel -> let qual = mkObjRelTableAls pfx $ aarName objSel @@ -203,13 +222,13 @@ buildJsonObject pfx parAls arrRelCtx strfyNum flds = ANIField (fldAls, arrSel) in S.mkQIdenExp arrPfx fldAls - toSQLCol :: PGColumnInfo -> Maybe ColOp -> S.SQLExp - toSQLCol col colOpM = - toJSONableExp strfyNum (pgiType col) $ case colOpM of + toSQLCol :: PGCol -> PGColumnType -> Maybe ColOp -> S.SQLExp + toSQLCol pgColumn pgColType colOpM = + toJSONableExp strfyNum pgColType $ case colOpM of Nothing -> colNameExp Just (ColOp op cExp) -> S.mkSQLOpExp op colNameExp cExp where - colNameExp = S.mkQIdenExp (mkBaseTableAls pfx) $ pgiColumn col + colNameExp = S.mkQIdenExp (mkBaseTableAls pfx) pgColumn -- uses row_to_json to build a json object withRowToJSON @@ -238,9 +257,9 @@ mkAggObExtrAndFlds annAggOb = case annAggOb of ( S.Extractor S.countStar als , [(FieldName "count", AFCount S.CTStar)] ) - AAOOp op pgCol -> - ( S.Extractor (S.SEFnApp op [S.SEIden $ toIden pgCol] Nothing) als - , [(FieldName op, AFOp $ AggOp op [(fromPGCol pgCol, PCFCol pgCol)])] + AAOOp op pgColumn -> + ( S.Extractor (S.SEFnApp op [S.SEIden $ toIden pgColumn] Nothing) als + , [(FieldName op, AFOp $ AggOp op [(fromPGCol pgColumn, PCFCol pgColumn)])] ) where als = Just $ S.toAlias $ mkAggObFld annAggOb @@ -284,10 +303,10 @@ processAnnOrderByCol , OrderByNode ) processAnnOrderByCol pfx parAls arrRelCtx strfyNum = \case - AOCPG colInfo -> + AOCPG pgColumn -> let - qualCol = S.mkQIdenExp (mkBaseTableAls pfx) (toIden $ pgiColumn colInfo) - obColAls = mkBaseTableColAls pfx $ pgiColumn colInfo + qualCol = S.mkQIdenExp (mkBaseTableAls pfx) (toIden pgColumn) + obColAls = mkBaseTableColAls pfx pgColumn in ( (S.Alias obColAls, qualCol) , OBNNothing ) @@ -318,7 +337,7 @@ processAnnOrderByCol pfx parAls arrRelCtx strfyNum = \case mkArrNodeInfo pfx parAls arrRelCtx $ ANIAggOrdBy rn fldName = mkAggObFld annAggOb qOrdBy = S.mkQIdenExp arrPfx $ toIden fldName - tabFrom = TableFrom relTab Nothing + tabFrom = FromExpressionTable relTab tabPerm = TablePerm relFltr Nothing (extr, arrFlds) = mkAggObExtrAndFlds annAggOb selFld = TAFAgg arrFlds @@ -347,7 +366,7 @@ processDistinctOnCol pfx neCols = (distOnExp, colExtrs) colExtrs = flip map cols $ mkQColAls &&& mkQCol -mkEmptyBaseNode :: Iden -> TableFrom -> BaseNode +mkEmptyBaseNode :: Iden -> FromExpression S.SQLExp -> BaseNode mkEmptyBaseNode pfx tableFrom = BaseNode pfx Nothing fromItem (S.BELit True) Nothing Nothing Nothing selOne HM.empty HM.empty @@ -488,7 +507,7 @@ mkBaseNode -> Iden -> FieldName -> TableAggFld - -> TableFrom + -> FromExpression S.SQLExp -> TablePerm -> TableArgs -> Bool @@ -583,7 +602,7 @@ mkBaseNode subQueryReq pfx fldAls annSelFlds tableFrom distItemsM = processDistinctOnCol pfx <$> distM distExprM = fst <$> distItemsM - distExtrs = fromMaybe [] (snd <$> distItemsM) + distExtrs = maybe [] snd distItemsM -- process an object relationship mkObjItem (fld, objSel) = @@ -704,30 +723,3 @@ mkSQLSelect isSingleObject annSel = baseNode = annSelToBaseNode False (toIden rootFldName) rootFldName annSel rootFldName = FieldName "root" rootFldAls = S.Alias $ toIden rootFldName - -mkFuncSelectWith - :: (AnnSelG a S.SQLExp -> S.Select) - -> AnnFnSelG (AnnSelG a S.SQLExp) S.SQLExp - -> S.SelectWith -mkFuncSelectWith f annFn = - S.SelectWith [(funcAls, S.CTESelect funcSel)] $ - -- we'll need to modify the table from of the underlying - -- select to the alias of the select from function - f annSel { _asnFrom = newTabFrom } - where - AnnFnSel qf fnArgs annSel = annFn - - -- SELECT * FROM function_name(args) - funcSel = S.mkSelect { S.selFrom = Just $ S.FromExp [frmItem] - , S.selExtr = [S.Extractor S.SEStar Nothing] - } - frmItem = S.mkFuncFromItem qf $ mkSQLFunctionArgs fnArgs - - mkSQLFunctionArgs (FunctionArgsExp positional named) = - S.FunctionArgs positional named - - newTabFrom = (_asnFrom annSel) {_tfIden = Just $ toIden funcAls} - - QualifiedObject sn fn = qf - funcAls = S.Alias $ Iden $ - getSchemaTxt sn <> "_" <> getFunctionTxt fn <> "__result" diff --git a/server/src-lib/Hasura/RQL/DML/Select/Types.hs b/server/src-lib/Hasura/RQL/DML/Select/Types.hs index 56985e244cf4d..4754558d391cb 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Types.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Types.hs @@ -49,7 +49,7 @@ data AnnAggOrdBy deriving (Show, Eq) data AnnObColG v - = AOCPG !PGColumnInfo + = AOCPG !PGCol | AOCObj !RelInfo !(AnnBoolExp v) !(AnnObColG v) | AOCAgg !RelInfo !(AnnBoolExp v) !AnnAggOrdBy deriving (Show, Eq) @@ -121,7 +121,7 @@ data ColOp } deriving (Show, Eq) data AnnFldG v - = FCol !PGColumnInfo !(Maybe ColOp) + = FCol !(PGCol, PGColumnType) !(Maybe ColOp) | FObj !(ObjSelG v) | FArr !(ArrSelG v) | FExp !T.Text @@ -207,17 +207,15 @@ type TableAggFld = TableAggFldG S.SQLExp type TableAggFldsG v = Fields (TableAggFldG v) type TableAggFlds = TableAggFldsG S.SQLExp -data TableFrom - = TableFrom - { _tfTable :: !QualifiedTable - , _tfIden :: !(Maybe Iden) - } deriving (Show, Eq) - -data TablePermG v - = TablePerm - { _tpFilter :: !(AnnBoolExp v) - , _tpLimit :: !(Maybe Int) - } deriving (Eq, Show) +data FromExpression v + = FromExpressionTable !QualifiedTable + | FromExpressionIdentifier !Iden + | FromExpressionFunction + !QualifiedFunction + !(FunctionArgsExpG v) + -- definition list of this function + (Maybe [(PGCol, PGScalarType)]) + deriving (Show, Eq) traverseTablePerm :: (Applicative f) @@ -229,12 +227,37 @@ traverseTablePerm f (TablePerm boolExp limit) = <$> traverseAnnBoolExp f boolExp <*> pure limit +data TablePermG v + = TablePerm + { _tpFilter :: !(AnnBoolExp v) + , _tpLimit :: !(Maybe Int) + } deriving (Eq, Show) + +noTablePermissions :: TablePermG v +noTablePermissions = + TablePerm annBoolExpTrue Nothing + +traverseTableFrom + :: (Applicative f) + => (a -> f b) + -> FromExpression a + -> f (FromExpression b) +traverseTableFrom f = \case + FromExpressionTable tn -> + pure $ FromExpressionTable tn + FromExpressionIdentifier identifier -> + pure $ FromExpressionIdentifier identifier + FromExpressionFunction functionName functionArgs definitionListM -> + FromExpressionFunction functionName <$> + traverse f functionArgs <*> + pure definitionListM + type TablePerm = TablePermG S.SQLExp data AnnSelG a v = AnnSelG { _asnFields :: !a - , _asnFrom :: !TableFrom + , _asnFrom :: !(FromExpression v) , _asnPerm :: !(TablePermG v) , _asnArgs :: !(TableArgsG v) , _asnStrfyNum :: !Bool @@ -264,7 +287,7 @@ traverseAnnSel traverseAnnSel f1 f2 (AnnSelG flds tabFrom perm args strfyNum) = AnnSelG <$> f1 flds - <*> pure tabFrom + <*> traverseTableFrom f2 tabFrom <*> traverseTablePerm f2 perm <*> traverseTableArgs f2 args <*> pure strfyNum @@ -286,40 +309,6 @@ emptyFunctionArgsExp = FunctionArgsExp [] HM.empty type FunctionArgExp = FunctionArgsExpG S.SQLExp -data AnnFnSelG s v - = AnnFnSel - { _afFn :: !QualifiedFunction - , _afFnArgs :: !(FunctionArgsExpG v) - , _afSelect :: !s - } deriving (Show, Eq) - -traverseAnnFnSel - :: (Applicative f) - => (a -> f b) -> (v -> f w) - -> AnnFnSelG a v -> f (AnnFnSelG b w) -traverseAnnFnSel fs fv (AnnFnSel fn fnArgs s) = - AnnFnSel fn <$> traverse fv fnArgs <*> fs s - -type AnnFnSelSimpleG v = AnnFnSelG (AnnSimpleSelG v) v -type AnnFnSelSimple = AnnFnSelSimpleG S.SQLExp - -traverseAnnFnSimple - :: (Applicative f) - => (a -> f b) - -> AnnFnSelSimpleG a -> f (AnnFnSelSimpleG b) -traverseAnnFnSimple f = - traverseAnnFnSel (traverseAnnSimpleSel f) f - -type AnnFnSelAggG v = AnnFnSelG (AnnAggSelG v) v -type AnnFnSelAgg = AnnFnSelAggG S.SQLExp - -traverseAnnFnAgg - :: (Applicative f) - => (a -> f b) - -> AnnFnSelAggG a -> f (AnnFnSelAggG b) -traverseAnnFnAgg f = - traverseAnnFnSel (traverseAnnAggSel f) f - data BaseNode = BaseNode { _bnPrefix :: !Iden diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index 4e40b893d3615..27cb9dcf9e4ef 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -1,5 +1,6 @@ module Hasura.RQL.Types.Action - ( ActionInfo(..) + ( ActionOutputTypeInfo(..) + , ActionInfo(..) , ActionName(..) , ActionKind(..) @@ -8,6 +9,7 @@ module Hasura.RQL.Types.Action , CreateAction(..) , ActionDefinitionInput + , ResolvedWebhook(..) , ResolvedActionDefinition , ActionPermissionInfo(..) @@ -28,6 +30,8 @@ import Hasura.RQL.Types.Permission import Hasura.SQL.Types import Language.Haskell.TH.Syntax (Lift) +import qualified Hasura.GraphQL.Validate.Types as VT + import qualified Data.Aeson as J import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J @@ -46,7 +50,9 @@ instance Q.FromCol ActionName where instance Q.ToPrepArg ActionName where toPrepVal = Q.toPrepVal . G.unName . unActionName -type ResolvedWebhook = Text +newtype ResolvedWebhook + = ResolvedWebhook { unResolvedWebhook :: Text} + deriving ( Show, Eq, J.FromJSON, J.ToJSON, Hashable, DQuote, Lift) data ActionKind = ActionSynchronous @@ -62,7 +68,7 @@ data ActionDefinition a , _adOutputType :: !GraphQLType , _adKind :: !(Maybe ActionKind) , _adWebhook :: !a - } deriving (Show, Eq, Lift) + } deriving (Show, Eq, Lift, Functor) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ActionDefinition) getActionKind :: ActionDefinition a -> ActionKind @@ -86,11 +92,22 @@ data ActionMetadataField | ActionMetadataFieldStatus deriving (Show, Eq) +data ActionOutputTypeInfo + = ActionOutputScalar !VT.ScalarTyInfo + | ActionOutputEnum !VT.EnumTyInfo + | ActionOutputObject !VT.ObjTyInfo + deriving (Show, Eq) + +-- TODO: this is terrible +instance J.ToJSON ActionOutputTypeInfo where + toJSON = J.toJSON . show + data ActionInfo = ActionInfo - { _aiName :: !ActionName - , _aiDefintion :: !ResolvedActionDefinition - , _aiPermissions :: !ActionPermissionMap + { _aiName :: !ActionName + , _aiDefintion :: !ResolvedActionDefinition + , _aiOutputTypeInfo :: !ActionOutputTypeInfo + , _aiPermissions :: !ActionPermissionMap } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionInfo) diff --git a/server/src-lib/Hasura/SQL/DML.hs b/server/src-lib/Hasura/SQL/DML.hs index d09bc29bdbc28..372a303d4d765 100644 --- a/server/src-lib/Hasura/SQL/DML.hs +++ b/server/src-lib/Hasura/SQL/DML.hs @@ -120,8 +120,9 @@ mkSelFromExp isLateral sel tn = where alias = Alias $ toIden tn -mkFuncFromItem :: QualifiedFunction -> FunctionArgs -> FromItem -mkFuncFromItem qf args = FIFunc qf args Nothing +mkFuncFromItem :: QualifiedFunction -> FunctionArgs -> FunctionAlias -> FromItem +mkFuncFromItem qf args alias = + FIFunc qf args $ Just alias mkRowExp :: [Extractor] -> SQLExp mkRowExp extrs = let @@ -418,10 +419,41 @@ instance ToSQL FunctionArgs where \(argName, argVal) -> SENamedArg (Iden argName) argVal in paren $ ", " <+> (positionalArgs <> namedArgs) +data DefinitionListItem + = DefinitionListItem + { _dliColumn :: !PGCol + , _dliType :: !PGScalarType + } deriving (Show, Eq, Data) + +instance ToSQL DefinitionListItem where + toSQL (DefinitionListItem column columnType) = + toSQL column <-> toSQL columnType + +data FunctionAlias + = FunctionAlias + { _faIden :: !Alias + , _faDefinitionList :: !(Maybe [DefinitionListItem]) + } deriving (Show, Eq, Data) + +mkSimpleFunctionAlias :: Iden -> FunctionAlias +mkSimpleFunctionAlias identifier = + FunctionAlias (toAlias identifier) Nothing + +mkFunctionAlias :: Iden -> Maybe [(PGCol, PGScalarType)] -> FunctionAlias +mkFunctionAlias identifier listM = + FunctionAlias (toAlias identifier) $ + fmap (map (uncurry DefinitionListItem)) listM + +instance ToSQL FunctionAlias where + toSQL (FunctionAlias iden (Just definitionList)) = + toSQL iden <> paren ( ", " <+> definitionList) + toSQL (FunctionAlias iden Nothing) = + toSQL iden + data FromItem = FISimple !QualifiedTable !(Maybe Alias) | FIIden !Iden - | FIFunc !QualifiedFunction !FunctionArgs !(Maybe Alias) + | FIFunc !QualifiedFunction !FunctionArgs !(Maybe FunctionAlias) | FIUnnest ![SQLExp] !Alias ![SQLExp] | FISelect !Lateral !Select !Alias | FIValues !ValuesExp !Alias !(Maybe [PGCol]) diff --git a/server/src-lib/Hasura/SQL/Rewrite.hs b/server/src-lib/Hasura/SQL/Rewrite.hs index 4822d1c9a8fda..260b782d14e12 100644 --- a/server/src-lib/Hasura/SQL/Rewrite.hs +++ b/server/src-lib/Hasura/SQL/Rewrite.hs @@ -81,6 +81,10 @@ uFromExp :: S.FromExp -> Uniq S.FromExp uFromExp (S.FromExp fromItems) = S.FromExp <$> mapM uFromItem fromItems +uFunctionAlias :: S.FunctionAlias -> Uniq S.FunctionAlias +uFunctionAlias (S.FunctionAlias alias definitionList) = + S.FunctionAlias <$> addAlias alias <*> pure definitionList + uFromItem :: S.FromItem -> Uniq S.FromItem uFromItem fromItem = case fromItem of S.FISimple t alM -> @@ -88,7 +92,7 @@ uFromItem fromItem = case fromItem of S.FIIden iden -> S.FIIden <$> return iden S.FIFunc f args alM -> - S.FIFunc f args <$> mapM addAlias alM + S.FIFunc f args <$> mapM uFunctionAlias alM S.FIUnnest args als cols -> S.FIUnnest <$> mapM uSqlExp args <*> addAlias als <*> mapM uSqlExp cols S.FISelect isLateral sel al -> do From ca4fd666190db53c2af73e6e245cc9ca29e64a10 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Sun, 20 Oct 2019 19:12:16 +0530 Subject: [PATCH 08/62] relationships in sync actions --- server/graphql-engine.cabal | 2 + server/src-lib/Hasura/GraphQL/Context.hs | 25 -- server/src-lib/Hasura/GraphQL/Execute.hs | 9 +- server/src-lib/Hasura/GraphQL/Resolve.hs | 2 +- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 105 ++--- .../src-lib/Hasura/GraphQL/Resolve/Context.hs | 9 - .../Hasura/GraphQL/Resolve/Mutation.hs | 9 + .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 1 + .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 15 +- server/src-lib/Hasura/GraphQL/Schema.hs | 10 +- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 247 ++++++------ .../src-lib/Hasura/GraphQL/Schema/Builder.hs | 6 + .../Hasura/GraphQL/Schema/CustomTypes.hs | 162 ++++++++ .../src-lib/Hasura/GraphQL/Validate/Types.hs | 21 +- server/src-lib/Hasura/RQL/DDL/Action.hs | 33 +- server/src-lib/Hasura/RQL/DDL/CustomTypes.hs | 175 +++++---- server/src-lib/Hasura/RQL/DDL/Metadata.hs | 2 +- server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs | 21 +- server/src-lib/Hasura/RQL/DDL/Schema/Table.hs | 10 +- server/src-lib/Hasura/RQL/Types/Action.hs | 31 +- server/src-lib/Hasura/RQL/Types/Common.hs | 4 + .../src-lib/Hasura/RQL/Types/CustomTypes.hs | 91 ++++- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 222 ++--------- server/src-lib/Hasura/RQL/Types/Table.hs | 364 ++++++++++++++++++ server/src-lib/Hasura/Server/App.hs | 2 +- server/stack.yaml | 6 +- server/stack.yaml.lock | 14 - 27 files changed, 1023 insertions(+), 575 deletions(-) create mode 100644 server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs create mode 100644 server/src-lib/Hasura/RQL/Types/Table.hs diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index c3fc53fca44cd..0e5ffecdb60c8 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -175,6 +175,7 @@ library , Hasura.RQL.Types , Hasura.RQL.Instances , Hasura.RQL.Types.SchemaCache + , Hasura.RQL.Types.Table , Hasura.RQL.Types.SchemaCacheTypes , Hasura.RQL.Types.BoolExp , Hasura.RQL.Types.Catalog @@ -231,6 +232,7 @@ library , Hasura.GraphQL.Transport.WebSocket , Hasura.GraphQL.Schema.BoolExp , Hasura.GraphQL.Schema.Common + , Hasura.GraphQL.Schema.CustomTypes , Hasura.GraphQL.Schema.Builder , Hasura.GraphQL.Schema.Action , Hasura.GraphQL.Schema.Function diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index c29a1e89fce45..cbe51e5dc6f5c 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -3,10 +3,7 @@ module Hasura.GraphQL.Context where import Hasura.Prelude import Data.Aeson -import Data.Aeson.Casing -import Data.Aeson.TH import Data.Has -import Language.Haskell.TH.Syntax (Lift) import qualified Data.HashMap.Strict as Map import qualified Data.HashSet as Set @@ -85,25 +82,3 @@ emptyGCtx = allTys = mkTyInfoMap $ TIObj queryRoot:defaultTypes -- for now subscription root is query root in GCtx allTys mempty queryRoot Nothing Nothing mempty mempty mempty mempty - -data TableCustomRootFields - = TableCustomRootFields - { _tcrfSelect :: !(Maybe G.Name) - , _tcrfSelectByPk :: !(Maybe G.Name) - , _tcrfSelectAggregate :: !(Maybe G.Name) - , _tcrfInsert :: !(Maybe G.Name) - , _tcrfUpdate :: !(Maybe G.Name) - , _tcrfDelete :: !(Maybe G.Name) - } deriving (Show, Eq, Lift) -$(deriveJSON (aesonDrop 5 snakeCase) ''TableCustomRootFields) - -emptyCustomRootFields :: TableCustomRootFields -emptyCustomRootFields = - TableCustomRootFields - { _tcrfSelect = Nothing - , _tcrfSelectByPk = Nothing - , _tcrfSelectAggregate = Nothing - , _tcrfInsert = Nothing - , _tcrfUpdate = Nothing - , _tcrfDelete = Nothing - } diff --git a/server/src-lib/Hasura/GraphQL/Execute.hs b/server/src-lib/Hasura/GraphQL/Execute.hs index c6d41b32eb930..9efcddb589f27 100644 --- a/server/src-lib/Hasura/GraphQL/Execute.hs +++ b/server/src-lib/Hasura/GraphQL/Execute.hs @@ -275,6 +275,7 @@ resolveMutSelSet , Has SQLGenCtx r , Has InsCtxMap r , Has HTTP.Manager r + , MonadIO m ) => VQ.SelSet -> m LazyRespTx @@ -282,23 +283,23 @@ resolveMutSelSet fields = do aliasedTxs <- forM (toList fields) $ \fld -> do fldRespTx <- case VQ._fName fld of "__typename" -> return $ return $ encJFromJValue mutationRootName - _ -> fmap liftTx . evalResolveT $ GR.mutFldToTx fld + _ -> evalResolveT $ GR.mutFldToTx fld return (G.unName $ G.unAlias $ VQ._fAlias fld, fldRespTx) -- combines all transactions into a single transaction - return $ toSingleTx aliasedTxs + return $ liftTx $ toSingleTx aliasedTxs where -- A list of aliased transactions for eg -- [("f1", Tx r1), ("f2", Tx r2)] -- are converted into a single transaction as follows -- Tx {"f1": r1, "f2": r2} - toSingleTx :: [(Text, LazyRespTx)] -> LazyRespTx + -- toSingleTx :: [(Text, LazyRespTx)] -> LazyRespTx toSingleTx aliasedTxs = fmap encJFromAssocList $ forM aliasedTxs $ \(al, tx) -> (,) al <$> tx getMutOp - :: (MonadError QErr m) + :: (MonadError QErr m, MonadIO m) => GCtx -> SQLGenCtx -> UserInfo diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index d61661708043a..6f73ff3a94ccc 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -12,7 +12,6 @@ module Hasura.GraphQL.Resolve , QueryRootFldResolved , toPGQuery - , resolveValPrep , RIntro.schemaR , RIntro.typeR ) where @@ -119,6 +118,7 @@ mutFldToTx , Has SQLGenCtx r , Has InsCtxMap r , Has HTTP.Manager r + , MonadIO m ) => V.Field -> m RespTx diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 2aef1e9aca677..c3dde1682c636 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -26,11 +26,13 @@ import qualified Network.HTTP.Client as HTTP import qualified Network.Wreq as Wreq import qualified Hasura.RQL.DML.Select as RS +import qualified Hasura.GraphQL.Resolve.Select as GRS import qualified Hasura.SQL.DML as S import Hasura.EncJSON import Hasura.GraphQL.Resolve.Context import Hasura.GraphQL.Resolve.InputValue +import Hasura.GraphQL.Resolve.Select (processTableSelectionSet) import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types import Hasura.HTTP @@ -178,14 +180,11 @@ resolveActionSelect selectContext field = do _asocFilter selectContext parseActionId annInpValue = do mkParameterizablePGValue <$> asPGColumnValue annInpValue - -- onNothing (UUID.fromText idText) $ - -- throwVE $ "invalid value for uuid: " <> idText actionSelectToTx :: ActionSelectResolved -> RespTx actionSelectToTx actionSelect = asSingleRowJsonResp (actionSelectToSql actionSelect) [] - data ActionWebhookPayload = ActionWebhookPayload { _awpSessionVariables :: !UserVars @@ -205,58 +204,58 @@ data ResolvePlan | ResolvePostgres [(PGCol, PGScalarType)] ![(Text, OutputFieldResolved)] deriving (Show, Eq) +processOutputSelectionSet + :: ( MonadResolve m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => RS.FromExpression UnresolvedVal + -> G.NamedType -> SelSet -> m GRS.AnnSimpleSelect +processOutputSelectionSet fromExpression fldTy flds = do + stringifyNumerics <- stringifyNum <$> asks getter + annotatedFields <- processTableSelectionSet fldTy flds + let selectAst = RS.AnnSelG annotatedFields fromExpression + RS.noTablePermissions RS.noTableArgs stringifyNumerics + return selectAst + resolveActionInsertSync :: ( MonadError QErr m, MonadReader r m, Has FieldMap r + , MonadResolve m , Has OrdByCtx r, Has SQLGenCtx r , Has HTTP.Manager r + , MonadIO m ) => Field - -> ResolvedWebhook - -> ActionOutputTypeInfo + -> SyncActionExecutionContext -> UserVars -> m RespTx -resolveActionInsertSync field resolvedWebhook outputTypeInfo sessionVariables = do +resolveActionInsertSync field executionContext sessionVariables = do inputArgs <- withArg (_fArguments field) "input" (return . annInpValueToJson) - resolvePlan <- case outputTypeInfo of - ActionOutputScalar _ -> return ResolveReturn - ActionOutputEnum _ -> return ResolveReturn - ActionOutputObject objTyInfo -> do - let definitionList = - flip zip (repeat PGJSON) $ - map (PGCol . G.unName . _fiName) $ Map.elems $ _otiFields objTyInfo - ResolvePostgres definitionList <$> - resolveOutputSelectionSet objTyInfo (_fType field) (_fSelSet field) manager <- asks getter - stringifyNumerics <- stringifyNum <$> asks getter - return $ do - webhookRes <- callWebhook manager inputArgs - returnResponse stringifyNumerics webhookRes resolvePlan + webhookRes <- callWebhook manager inputArgs + case returnStrategy of + ReturnJson -> return $ return $ encJFromJValue webhookRes + ExecOnPostgres definitionList -> do + selectAstUnresolved <- + processOutputSelectionSet + (mkSyncFromExpression definitionList webhookRes) + (_fType field) $ _fSelSet field + astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved + return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] + where - returnResponse stringifyNumerics webhookData = \case - ResolveReturn -> return $ encJFromJValue webhookData - ResolvePostgres definitionList selSet -> do - let functionName = QualifiedObject (SchemaName "pg_catalog") $ - FunctionName "json_to_record" - functionArgs = RS.FunctionArgsExp - (pure $ toTxtValue $ WithScalarType PGJSON $ - PGValJSON $ Q.JSON webhookData) - mempty - fromExpression = - RS.FromExpressionFunction functionName functionArgs - (Just definitionList) - annFields = flip map selSet $ \(alias, outputField) -> - (FieldName alias,) $ case outputField of - OutputFieldSimple fieldName -> - -- TODO: - RS.FCol ( PGCol fieldName - , PGColumnScalar PGJSON - ) Nothing - OutputFieldTypename typeName -> - RS.FExp $ G.unName $ G.unNamedType typeName - OutputFieldRelationship -> undefined - let selectAst = RS.AnnSelG annFields fromExpression - RS.noTablePermissions RS.noTableArgs stringifyNumerics - asSingleRowJsonResp (RS.selectQuerySQL True selectAst) [] + + mkSyncFromExpression definitionList webhookData = + let functionName = QualifiedObject (SchemaName "pg_catalog") $ + FunctionName "json_to_record" + functionArgs = RS.FunctionArgsExp + (pure $ UVSQL $ toTxtValue $ WithScalarType PGJSON $ + PGValJSON $ Q.JSON webhookData) + mempty + in RS.FromExpressionFunction functionName functionArgs + (Just definitionList) + + resolvedWebhook = _saecWebhook executionContext + returnStrategy = _saecStrategy executionContext callWebhook manager actionInput = do let options = wreqOptions manager [contentType] @@ -264,13 +263,19 @@ resolveActionInsertSync field resolvedWebhook outputTypeInfo sessionVariables = postPayload = J.toJSON $ ActionWebhookPayload sessionVariables actionInput url = (T.unpack $ unResolvedWebhook resolvedWebhook) - httpResponse <- liftIO $ try $ + httpResponse <- liftIO $ try $ try $ Wreq.asJSON =<< Wreq.postWith options url postPayload - case (^. Wreq.responseBody) <$> httpResponse of + -- case (^. Wreq.responseBody) <$> httpResponse of + case httpResponse of Left e -> throw500WithDetail "http exception when calling webhook" $ J.toJSON $ HttpException e - Right response -> case (_awrData response, _awrErrors response) of + Right (Left (Wreq.JSONError e)) -> + throw500WithDetail "not a valid json response from webhook" $ + J.toJSON e + Right (Right responseWreq) -> + let response = responseWreq ^. Wreq.responseBody + in case (_awrData response, _awrErrors response) of (Nothing, Nothing) -> throw500WithDetail "internal error" $ J.String "webhook response has neither 'data' nor 'errors'" @@ -283,6 +288,8 @@ resolveActionInsertSync field resolvedWebhook outputTypeInfo sessionVariables = resolveActionInsert :: ( MonadError QErr m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r, Has HTTP.Manager r + , MonadIO m + , MonadResolve m ) => Field -> ActionExecutionContext @@ -291,8 +298,8 @@ resolveActionInsert -> m RespTx resolveActionInsert field executionContext sessionVariables = case executionContext of - ActionExecutionSyncWebhook webhook outputTypeInfo -> - resolveActionInsertSync field webhook outputTypeInfo sessionVariables + ActionExecutionSyncWebhook executionContextSync -> + resolveActionInsertSync field executionContextSync sessionVariables ActionExecutionAsync actionFilter -> resolveActionInsertAsync field actionFilter sessionVariables diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs index 30db52be82f9d..5fb51c599eb60 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Context.hs @@ -7,7 +7,6 @@ module Hasura.GraphQL.Resolve.Context , LazyRespTx , AnnPGVal(..) , UnresolvedVal(..) - , resolveValPrep , resolveValTxt , InsertTxConflictCtx(..) , getFldInfo @@ -116,14 +115,6 @@ type PrepArgs = Seq.Seq Q.PrepArg prepare :: (MonadState PrepArgs m) => AnnPGVal -> m S.SQLExp prepare (AnnPGVal _ _ scalarValue) = prepareColVal scalarValue -resolveValPrep - :: (MonadState PrepArgs m) - => UnresolvedVal -> m S.SQLExp -resolveValPrep = \case - UVPG annPGVal -> prepare annPGVal - UVSessVar colTy sessVar -> sessVarFromCurrentSetting colTy sessVar - UVSQL sqlExp -> return sqlExp - resolveValTxt :: (Applicative f) => UnresolvedVal -> f S.SQLExp resolveValTxt = \case UVPG annPGVal -> txtConverter annPGVal diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index f14ce6ad54b7c..5c8aaed8330e0 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -27,6 +27,7 @@ import Hasura.GraphQL.Resolve.InputValue import Hasura.GraphQL.Resolve.Select (processTableSelectionSet) import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types +import Hasura.RQL.DML.Internal (sessVarFromCurrentSetting) import Hasura.RQL.Types import Hasura.SQL.Types import Hasura.SQL.Value @@ -215,3 +216,11 @@ buildEmptyMutResp = mkTx RR.MCount -> J.toJSON (0 :: Int) RR.MExp e -> J.toJSON e RR.MRet _ -> J.toJSON ([] :: [J.Value]) + +resolveValPrep + :: (MonadState PrepArgs m) + => UnresolvedVal -> m S.SQLExp +resolveValPrep = \case + UVPG annPGVal -> prepare annPGVal + UVSessVar colTy sessVar -> sessVarFromCurrentSetting colTy sessVar + UVSQL sqlExp -> return sqlExp diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 7832bdcae7e74..ed1d6614f25b0 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -6,6 +6,7 @@ module Hasura.GraphQL.Resolve.Select , convertFuncQueryAgg , parseColumns , processTableSelectionSet + , AnnSimpleSelect ) where import Data.Has diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 275ae693d57e1..7ec63468b721d 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -91,8 +91,19 @@ data DelOpCtx , _docAllCols :: ![PGColumnInfo] } deriving (Show, Eq) +data SyncReturnStrategy + = ReturnJson + | ExecOnPostgres [(PGCol, PGScalarType)] + deriving (Show, Eq) + +data SyncActionExecutionContext + = SyncActionExecutionContext + { _saecStrategy :: !SyncReturnStrategy + , _saecWebhook :: !ResolvedWebhook + } deriving (Show, Eq) + data ActionExecutionContext - = ActionExecutionSyncWebhook !ResolvedWebhook !ActionOutputTypeInfo + = ActionExecutionSyncWebhook !SyncActionExecutionContext | ActionExecutionAsync !AnnBoolExpPartialSQL deriving (Show, Eq) @@ -221,7 +232,7 @@ class (MonadError QErr m) => MonadResolve m where markNotReusable :: m () newtype ResolveT m a = ResolveT { unResolveT :: StateT QueryReusability m a } - deriving (Functor, Applicative, Monad, MonadError e, MonadReader r) + deriving (Functor, Applicative, Monad, MonadError e, MonadReader r, MonadIO) instance (MonadError QErr m) => MonadResolve (ResolveT m) where recordVariableUse varName varType = ResolveT $ diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 81dd3180f5981..64d96243a25a0 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -32,6 +32,7 @@ import Hasura.GraphQL.Validate.Types import Hasura.Prelude import Hasura.RQL.DML.Internal (mkAdminRolePermInfo) import Hasura.RQL.Types +import Hasura.RQL.Types.Table import Hasura.Server.Utils (duplicates) import Hasura.SQL.Types @@ -629,8 +630,8 @@ noFilter = annBoolExpTrue mkGCtxMap :: (MonadError QErr m) - => TableCache PGColumnInfo -> FunctionCache -> ActionCache -> m GCtxMap -mkGCtxMap tableCache functionCache actionCache = do + => AnnotatedObjects -> TableCache PGColumnInfo -> FunctionCache -> ActionCache -> m GCtxMap +mkGCtxMap annotatedObjects tableCache functionCache actionCache = do typesMapL <- mapM (mkGCtxMapTable tableCache functionCache) $ filter tableFltr $ Map.elems tableCache -- since root field names are customisable, we need to check for @@ -640,7 +641,7 @@ mkGCtxMap tableCache functionCache actionCache = do throw400 Unexpected $ "following root fields are duplicated: " <> showNames duplicateRootFlds - let actionsSchema = mkActionsSchema actionCache + actionsSchema <- mkActionsSchema annotatedObjects actionCache -- TODO: clean this up let typesMap = foldr (Map.unionWith mappend) (fmap (\(rootFields, tyAgg) -> (tyAgg, rootFields, mempty)) @@ -663,7 +664,8 @@ buildGCtxMapPG => m () buildGCtxMapPG = do sc <- askSchemaCache - gCtxMap <- mkGCtxMap (scTables sc) (scFunctions sc) (scActions sc) + let annotatedObjects = snd $ scCustomTypes sc + gCtxMap <- mkGCtxMap annotatedObjects (scTables sc) (scFunctions sc) (scActions sc) writeSchemaCache sc {scGCtxMap = gCtxMap} getGCtx :: (CacheRM m) => RoleName -> GCtxMap -> m GCtx diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 66b275f7ed108..a89fdc9776771 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -2,84 +2,20 @@ module Hasura.GraphQL.Schema.Action ( mkActionsSchema ) where -import qualified Data.HashMap.Strict as Map -import qualified Language.GraphQL.Draft.Syntax as G +import qualified Data.HashMap.Strict as Map +import qualified Language.GraphQL.Draft.Syntax as G + +import Data.Coerce (coerce) import Hasura.GraphQL.Schema.Builder --- import qualified Data.HashSet as Set import Hasura.GraphQL.Resolve.Types +import Hasura.GraphQL.Schema.CustomTypes import Hasura.GraphQL.Validate.Types import Hasura.Prelude import Hasura.RQL.Types import Hasura.SQL.Types --- mkOutputSelectionTypeName :: ActionName -> G.Name --- mkOutputSelectionTypeName actionName = --- unActionName actionName <> "_output_selection" - --- mkOutputSelectionType :: ActionName -> G.NamedType --- mkOutputSelectionType = --- G.NamedType . mkOutputSelectionTypeName - --- mkOutputSelectionTypeInfo --- :: ActionName --- -- Name of the action --- -> ActionOutputFieldTypes --- -- allowed response columns --- -> ObjTyInfo --- mkOutputSelectionTypeInfo actionName allowedOutputFields = --- mkHsraObjTyInfo --- (Just description) --- (mkOutputSelectionType actionName) -- "(action_name)_output" --- mempty -- no arguments --- (mapFromL _fiName outputFieldDefinitions) --- where --- description = G.Description $ "output fields of action: " <>> actionName --- outputFieldDefinitions = --- map (uncurry outputFieldToGqlField) $ Map.toList allowedOutputFields - - -- outputFieldToGqlField :: ActionOutputField -> PGColType -> ObjFldInfo - -- outputFieldToGqlField fieldName fieldType = - -- mkHsraObjFldInfo - -- Nothing - -- (unActionOutputField fieldName) - -- mempty - -- (G.toGT $ mkScalarTy fieldType) - --- mkInputSelectionTypeName :: ActionName -> G.Name --- mkInputSelectionTypeName actionName = --- unActionName actionName <> "_input_selection" - --- mkInputSelectionType :: ActionName -> G.NamedType --- mkInputSelectionType = --- G.NamedType . mkInputSelectionTypeName - --- mkInputSelectionTypeInfo --- :: ActionName --- -- Name of the action --- -> ActionInputFieldTypes --- -- input columns that are allowed to be read --- -> ObjTyInfo --- mkInputSelectionTypeInfo actionName allowedInputFields = --- mkHsraObjTyInfo --- (Just description) --- (mkInputSelectionType actionName) -- "(action_name)_input" --- mempty -- no arguments --- (mapFromL _fiName inputFieldDefinitions) --- where --- description = G.Description $ "input fields of action: " <>> actionName --- inputFieldDefinitions = --- map (uncurry inputFieldToGqlField) $ Map.toList allowedInputFields - --- inputFieldToGqlField :: ActionInputField -> PGColType -> ObjFldInfo --- inputFieldToGqlField fieldName fieldType = --- mkHsraObjFldInfo --- Nothing --- (unActionInputField fieldName) --- mempty --- (G.toGT $ mkScalarTy fieldType) - mkActionSelectionType :: ActionName -> G.NamedType mkActionSelectionType = G.NamedType . unActionName @@ -117,43 +53,13 @@ mkActionResponseTypeInfo actionName outputType = , unGraphQLType outputType) ] --- mkActionInputType :: ActionName -> G.NamedType --- mkActionInputType actionName = --- G.NamedType $ unActionName actionName <> "_input" - --- makes the input type for the allowed fields --- mkInputTypeInfo --- :: ActionName --- -- Name of the action --- -> ActionInputFieldTypes --- -> InpObjTyInfo --- mkInputTypeInfo actionName allowedInputFields = --- mkHsraInpTyInfo --- (Just description) --- (mkActionInputType actionName) --- inputFields --- where --- description = --- G.Description $ "input arguments for action: " <>> actionName - --- inputFields = --- mapFromL _iviName $ --- map (uncurry mkInputField) $ Map.toList allowedInputFields - --- mkInputField :: ActionInputField -> PGColType -> InpValInfo --- mkInputField inputField ty = --- InpValInfo --- Nothing --- (unActionInputField inputField) --- Nothing -- no default value --- (G.toGT $ mkScalarTy ty) - mkMutationField :: ActionName -> ActionInfo -> ActionPermissionInfo + -> [(PGCol, PGScalarType)] -> (ActionExecutionContext, ObjFldInfo) -mkMutationField actionName actionInfo permission = +mkMutationField actionName actionInfo permission definitionList = ( actionExecutionContext , fieldInfo ) @@ -162,9 +68,10 @@ mkMutationField actionName actionInfo permission = actionExecutionContext = case getActionKind definition of ActionSynchronous -> - ActionExecutionSyncWebhook + ActionExecutionSyncWebhook $ SyncActionExecutionContext + -- TODO: only covers object types + (ExecOnPostgres definitionList) (_adWebhook definition) - (_aiOutputTypeInfo actionInfo) ActionAsynchronous -> ActionExecutionAsync $ _apiFilter permission -- TODO: we need to capture the comment from action definition @@ -224,45 +131,132 @@ mkQueryField actionName definition permission = (actionFieldResponseType actionName definition) mkActionFieldsAndTypes - :: ActionName - -> ActionInfo + :: (QErrM m) + => ActionInfo + -> AnnotatedObjectType -> ActionPermissionInfo - -> ( Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) + -> m ( Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) -- context, field, response type info , (ActionExecutionContext, ObjFldInfo) -- mutation field + , FieldMap ) -mkActionFieldsAndTypes actionName actionInfo permission = - ( mkQueryField actionName definition permission - , mkMutationField actionName actionInfo permission - ) +mkActionFieldsAndTypes actionInfo annotatedOutputType permission = + return ( mkQueryField actionName definition permission + , mkMutationField actionName actionInfo permission definitionList + -- , maybe mempty mkFieldMap annotatedOutputTypeM + , fieldMap + ) where + actionName = _aiName actionInfo definition = _aiDefintion actionInfo + roleName = _apiRole permission + mkPGFieldType (fieldType, fieldTypeInfo) = + case (G.isListType fieldType, fieldTypeInfo) of + -- for scalar lists, we treat them as json columns + (True, _) -> PGJSON + -- enums the same + (False, OutputFieldEnum _) -> PGJSON + -- specific scalars + (False, OutputFieldScalar scalarTypeInfo) -> + namedTypeToPGScalar $ G.NamedType $ _stiName scalarTypeInfo + definitionList = + [ (coerce k, mkPGFieldType v) + | (k, v) <- Map.toList $ _aotAnnotatedFields annotatedOutputType + ] + -- mkFieldMap annotatedOutputType = + fieldMap = + Map.fromList $ fields <> catMaybes relationships + where + fields = + flip map (Map.toList $ _aotAnnotatedFields annotatedOutputType) $ + \(fieldName, (fieldType, fieldTypeInfo)) -> + ( (actionOutputBaseType, unObjectFieldName fieldName) + , Left $ PGColumnInfo + (PGCol $ coerce fieldName) + (coerce fieldName) + (PGColumnScalar $ mkPGFieldType (fieldType, fieldTypeInfo)) + (G.isNullable fieldType) + Nothing + ) + relationships = + flip map (Map.toList $ _aotRelationships annotatedOutputType) $ + \(relationshipName, relationship) -> + let remoteTableInfo = _arRemoteTableInfo relationship + remoteTable = _tiName remoteTableInfo + filterAndLimitM = getFilterAndLimit remoteTableInfo + columnMapping = + [ (PGCol $ coerce k, v) + | (k, v) <- Map.toList $ + _ordFieldMapping $ _arDefinition relationship + ] + in case filterAndLimitM of + Just (tableFilter, tableLimit) -> + Just ( ( actionOutputBaseType + , unObjectRelationshipName relationshipName + ) + , Right $ RelationshipField + (RelInfo + (RelName $ mkNonEmptyTextUnsafe $ coerce relationshipName) + ObjRel + columnMapping remoteTable True) + False mempty + tableFilter + tableLimit + ) + Nothing -> Nothing + getFilterAndLimit remoteTableInfo = + if roleName == adminRole + then Just (annBoolExpTrue, Nothing) + else do + selectPermisisonInfo <- + getSelectPermissionInfoM remoteTableInfo roleName + return (spiFilter selectPermisisonInfo, spiLimit selectPermisisonInfo) + actionOutputBaseType = + G.getBaseType $ unGraphQLType $ _adOutputType $ _aiDefintion actionInfo mkActionSchemaOne - :: ActionInfo - -> Map.HashMap RoleName - ( Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) - , (ActionExecutionContext, ObjFldInfo) - ) -mkActionSchemaOne actionInfo = - flip fmap permissions $ \permission -> - mkActionFieldsAndTypes (_aiName actionInfo) actionInfo permission + :: (QErrM m) + => AnnotatedObjects + -> ActionInfo + -> m (Map.HashMap RoleName + ( Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) + , (ActionExecutionContext, ObjFldInfo) + , FieldMap + ) + ) +mkActionSchemaOne annotatedObjects actionInfo = do + -- annotatedOutputTypeM <- case _aiOutputTypeInfo actionInfo of + -- ActionOutputObject _ -> + -- annotatedOutputTypeM <- fmap Just $ onNothing + annotatedOutputType <- onNothing + (Map.lookup (ObjectTypeName actionOutputBaseType) annotatedObjects) $ + throw500 $ "missing annotated type for: " <> showNamedTy actionOutputBaseType + -- _ -> return Nothing + forM permissions $ \permission -> + mkActionFieldsAndTypes actionInfo annotatedOutputType permission where adminPermission = ActionPermissionInfo adminRole annBoolExpTrue permissions = Map.insert adminRole adminPermission $ _aiPermissions actionInfo + actionOutputBaseType = + G.getBaseType $ unGraphQLType $ _adOutputType $ _aiDefintion actionInfo mkActionsSchema - :: ActionCache - -> Map.HashMap RoleName (RootFields, TyAgg) -mkActionsSchema = - foldr (\actionInfo aggregate -> - Map.foldrWithKey f aggregate $ mkActionSchemaOne actionInfo) + :: (QErrM m) + => AnnotatedObjects + -> ActionCache + -> m (Map.HashMap RoleName (RootFields, TyAgg)) +mkActionsSchema annotatedObjects = + foldM + (\aggregate actionInfo -> + Map.foldrWithKey f aggregate <$> + mkActionSchemaOne annotatedObjects actionInfo + ) mempty where -- we'll need to add uuid and timestamptz for actions newRoleState = (mempty, addScalarToTyAgg PGTimeStampTZ $ addScalarToTyAgg PGUUID mempty) - f roleName (queryFieldM, mutationField) = + f roleName (queryFieldM, mutationField, fields) = Map.alter (Just . addToState . fromMaybe newRoleState) roleName where addToState = case queryFieldM of @@ -271,12 +265,13 @@ mkActionsSchema = Nothing -> addToStateSync addToStateSync (rootFields, tyAgg) = ( addMutationField (first MCAction mutationField) rootFields - , tyAgg + , addFieldsToTyAgg fields tyAgg ) addToStateAsync queryField responseTypeInfo (rootFields, tyAgg) = ( addMutationField (first MCAction mutationField) $ addQueryField (first QCActionFetch queryField) rootFields - , addTypeInfoToTyAgg responseTypeInfo tyAgg + , addTypeInfoToTyAgg responseTypeInfo $ + addFieldsToTyAgg fields tyAgg ) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Builder.hs b/server/src-lib/Hasura/GraphQL/Schema/Builder.hs index 0a69680ad4a27..af486bab86b55 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Builder.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Builder.hs @@ -1,9 +1,11 @@ module Hasura.GraphQL.Schema.Builder ( TyAgg(..) + , FieldMap , taTypes , taFields , taScalars , taOrdBy + , addFieldsToTyAgg , addTypeInfoToTyAgg , addScalarToTyAgg , RootFields(..) @@ -35,6 +37,10 @@ data TyAgg } deriving (Show, Eq) $(makeLenses ''TyAgg) +addFieldsToTyAgg :: FieldMap -> TyAgg -> TyAgg +addFieldsToTyAgg fields = + over taFields (Map.union fields) + addTypeInfoToTyAgg :: TypeInfo -> TyAgg -> TyAgg addTypeInfoToTyAgg typeInfo tyAgg = tyAgg & taTypes.at (getNamedTy typeInfo) ?~ typeInfo diff --git a/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs b/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs new file mode 100644 index 0000000000000..4ac62b7026f08 --- /dev/null +++ b/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs @@ -0,0 +1,162 @@ +module Hasura.GraphQL.Schema.CustomTypes + ( AnnotatedRelationship(..) + , buildCustomTypesSchemaPartial + , buildCustomTypesSchema + ) where + +import qualified Data.HashMap.Strict as Map +import qualified Language.GraphQL.Draft.Syntax as G + +import Hasura.GraphQL.Context (defaultTypes) +import Hasura.GraphQL.Schema.Common (mkTableTy) +import Hasura.Prelude +import Hasura.RQL.Types +import Hasura.SQL.Types + +import qualified Hasura.GraphQL.Validate.Types as VT + +buildObjectTypeInfo :: RoleName -> AnnotatedObjectType -> VT.ObjTyInfo +buildObjectTypeInfo roleName annotatedObjectType = + VT.ObjTyInfo + { VT._otiDesc = _otdDescription objectDefinition + , VT._otiName = unObjectTypeName $ _otdName objectDefinition + , VT._otiImplIFaces = mempty + , VT._otiFields = VT.mapFromL VT._fiName $ fields <> catMaybes relationships + } + where + objectDefinition = _aotDefinition annotatedObjectType + + relationships = + flip map (toList $ _aotRelationships annotatedObjectType) $ + \(AnnotatedRelationship definition remoteTableInfo) -> + if isJust (getSelectPermissionInfoM remoteTableInfo roleName) || + roleName == adminRole + then Just (relationshipToFieldInfo definition) + else Nothing + where + relationshipToFieldInfo relationship = + VT.ObjFldInfo + { VT._fiDesc = Nothing -- TODO + , VT._fiName = unObjectRelationshipName $ _ordName relationship + , VT._fiParams = mempty + , VT._fiTy = G.toGT $ mkTableTy $ _ordRemoteTable relationship + , VT._fiLoc = VT.TLCustom + } + + fields = + map convertObjectFieldDefinition $ + toList $ _otdFields objectDefinition + where + convertObjectFieldDefinition fieldDefinition = + VT.ObjFldInfo + { VT._fiDesc = _ofdDescription fieldDefinition + , VT._fiName = unObjectFieldName $ _ofdName fieldDefinition + , VT._fiParams = mempty + , VT._fiTy = unGraphQLType $ _ofdType fieldDefinition + , VT._fiLoc = VT.TLCustom + } + +buildCustomTypesSchema + :: NonObjectTypeMap -> AnnotatedObjects -> RoleName -> VT.TypeMap +buildCustomTypesSchema nonObjectTypeMap annotatedObjectTypes roleName = + unNonObjectTypeMap nonObjectTypeMap <> objectTypeInfos + where + objectTypeInfos = + VT.mapFromL VT.getNamedTy $ + map (VT.TIObj . buildObjectTypeInfo roleName) $ + Map.elems annotatedObjectTypes + +annotateObjectType + :: (CacheRM m, MonadError QErr m) + => NonObjectTypeMap -> ObjectTypeDefinition -> m AnnotatedObjectType +annotateObjectType nonObjectTypeMap objectDefinition = do + annotatedFields <- + fmap Map.fromList $ forM (toList $ _otdFields objectDefinition) $ + \objectField -> do + let fieldName = _ofdName objectField + fieldType = unGraphQLType $ _ofdType objectField + fieldBaseType = G.getBaseType fieldType + baseTypeInfo <- getFieldTypeInfo fieldBaseType + return (fieldName, (fieldType, baseTypeInfo)) + annotatedRelationships <- + fmap Map.fromList $ forM relationships $ + \relationship -> do + let relationshipName = _ordName relationship + remoteTable = _ordRemoteTable relationship + remoteTableInfoM <- askTabInfoM remoteTable + remoteTableInfo <- onNothing remoteTableInfoM $ + throw500 $ "missing table info for: " <>> remoteTable + return ( relationshipName + , AnnotatedRelationship relationship remoteTableInfo) + return $ AnnotatedObjectType objectDefinition + annotatedFields annotatedRelationships + where + relationships = fromMaybe [] $ _otdRelationships objectDefinition + getFieldTypeInfo typeName = do + let inputTypeInfos = unNonObjectTypeMap nonObjectTypeMap + <> VT.mapFromL VT.getNamedTy defaultTypes + typeInfo <- onNothing (Map.lookup typeName inputTypeInfos) $ + throw500 $ "the type: " <> VT.showNamedTy typeName <> + " is not found in non-object cutom types" + case typeInfo of + VT.TIScalar scalarTypeInfo -> return $ OutputFieldScalar scalarTypeInfo + VT.TIEnum enumTypeInfo -> return $ OutputFieldEnum enumTypeInfo + _ -> throw500 $ + "expecting only scalar/enum typeinfo for an object type's field: " <> + VT.showNamedTy typeName + +buildCustomTypesSchemaPartial + :: (CacheRM m, QErrM m) + => CustomTypes -> m (NonObjectTypeMap, AnnotatedObjects) +buildCustomTypesSchemaPartial customTypes = do + let typeInfos = + map (VT.TIEnum . convertEnumDefinition) enumDefinitions <> + -- map (VT.TIObj . convertObjectDefinition) objectDefinitions <> + map (VT.TIInpObj . convertInputObjectDefinition) inputObjectDefinitions <> + map (VT.TIScalar . convertScalarDefinition) scalarDefinitions + -- <> defaultTypes + nonObjectTypeMap = NonObjectTypeMap $ VT.mapFromL VT.getNamedTy typeInfos + + annotatedObjectTypes <- VT.mapFromL (_otdName . _aotDefinition) <$> + traverse (annotateObjectType nonObjectTypeMap) objectDefinitions + + return (nonObjectTypeMap, annotatedObjectTypes) + where + inputObjectDefinitions = fromMaybe [] $ _ctInputObjects customTypes + objectDefinitions = fromMaybe [] $ _ctObjects customTypes + scalarDefinitions = fromMaybe [] $ _ctScalars customTypes + enumDefinitions = fromMaybe [] $ _ctEnums customTypes + + convertScalarDefinition scalarDefinition = + flip VT.fromScalarTyDef VT.TLCustom $ G.ScalarTypeDefinition + (_stdDescription scalarDefinition) + (G.unNamedType $ _stdName scalarDefinition) mempty + + convertEnumDefinition enumDefinition = + VT.EnumTyInfo (_etdDescription enumDefinition) + (unEnumTypeName $ _etdName enumDefinition) + (VT.EnumValuesSynthetic $ VT.mapFromL VT._eviVal $ + map convertEnumValueDefinition $ toList $ _etdValues enumDefinition) + VT.TLCustom + where + convertEnumValueDefinition enumValueDefinition = + VT.EnumValInfo (_evdDescription enumValueDefinition) + (_evdValue enumValueDefinition) + (fromMaybe False $ _evdIsDeprecated enumValueDefinition) + + convertInputObjectDefinition inputObjectDefinition = + VT.InpObjTyInfo + { VT._iotiDesc = _iotdDescription inputObjectDefinition + , VT._iotiName = unInputObjectTypeName $ _iotdName inputObjectDefinition + , VT._iotiFields = VT.mapFromL VT._iviName $ map convertInputFieldDefinition $ + toList $ _iotdFields inputObjectDefinition + , VT._iotiLoc = VT.TLCustom + } + where + convertInputFieldDefinition fieldDefinition = + VT.InpValInfo + { VT._iviDesc = _iofdDescription fieldDefinition + , VT._iviName = unInputObjectFieldName $ _iofdName fieldDefinition + , VT._iviDefVal = Nothing + , VT._iviType = unGraphQLType $ _iofdType fieldDefinition + } diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index 6b7692a60f9c7..406bf6109e733 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -28,6 +28,7 @@ module Hasura.GraphQL.Validate.Types , InpObjTyInfo(..) , mkHsraInpTyInfo + , namedTypeToPGScalar , ScalarTyInfo(..) , fromScalarTyDef , mkHsraScalarTyInfo @@ -374,15 +375,17 @@ fromScalarTyDef -> TypeLoc -> ScalarTyInfo fromScalarTyDef (G.ScalarTypeDefinition descM n _) = - ScalarTyInfo descM n ty - where - ty = case n of - "Int" -> PGInteger - "Float" -> PGFloat - "String" -> PGText - "Boolean" -> PGBoolean - "ID" -> PGText - _ -> txtToPgColTy $ G.unName n + ScalarTyInfo descM n $ namedTypeToPGScalar $ G.NamedType n + +namedTypeToPGScalar :: G.NamedType -> PGScalarType +namedTypeToPGScalar namedType = + case G.unNamedType namedType of + "Int" -> PGInteger + "Float" -> PGFloat + "String" -> PGText + "Boolean" -> PGBoolean + "ID" -> PGText + n -> txtToPgColTy $ G.unName n data TypeInfo = TIScalar !ScalarTyInfo diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 59d63522687d6..ca19e8be37350 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -106,7 +106,7 @@ buildActionInfo q = do let inputBaseType = G.getBaseType $ unGraphQLType $ _adInputType actionDefinition responseType = unGraphQLType $ _adOutputType actionDefinition responseBaseType = G.getBaseType responseType - inputTypeInfo <- getCustomTypeInfo inputBaseType + inputTypeInfo <- getNonObjectTypeInfo inputBaseType case inputTypeInfo of VT.TIScalar _ -> return () VT.TIEnum _ -> return () @@ -116,22 +116,31 @@ buildActionInfo q = do " should be a scalar/enum/input_object" when (hasList responseType) $ throw400 InvalidParams $ "the output type: " <> G.showGT responseType <> " cannot be a list" - responseTypeInfo <- getCustomTypeInfo responseBaseType - outputTypeInfo <- case responseTypeInfo of - VT.TIScalar typeInfo -> return $ ActionOutputScalar typeInfo - VT.TIEnum typeInfo -> return $ ActionOutputEnum typeInfo - VT.TIObj typeInfo -> return $ ActionOutputObject typeInfo - _ -> throw400 InvalidParams $ "the output type: " <> - showNamedTy responseBaseType <> - " should be a scalar/enum/object" + + getObjectTypeInfo responseBaseType + -- TODO: validate the output type + -- responseTypeInfo <- getNonObjectTypeInfo responseBaseType + -- case responseTypeInfo of + -- VT.TIScalar typeInfo -> return $ ActionOutputScalar typeInfo + -- VT.TIEnum typeInfo -> return $ ActionOutputEnum typeInfo + -- VT.TIObj typeInfo -> return $ ActionOutputObject typeInfo + -- _ -> throw400 InvalidParams $ "the output type: " <> + -- showNamedTy responseBaseType <> + -- " should be a scalar/enum/object" return $ ActionInfo actionName - (fmap ResolvedWebhook actionDefinition) outputTypeInfo mempty + (fmap ResolvedWebhook actionDefinition) mempty where - getCustomTypeInfo typeName = do - customTypes <- scCustomTypes <$> askSchemaCache + getNonObjectTypeInfo typeName = do + customTypes <- (unNonObjectTypeMap . fst . scCustomTypes) <$> askSchemaCache onNothing (Map.lookup typeName customTypes) $ throw400 NotExists $ "the type: " <> showNamedTy typeName <> " is not defined in custom types" + getObjectTypeInfo typeName = do + customTypes <- (snd . scCustomTypes) <$> askSchemaCache + onNothing (Map.lookup (ObjectTypeName typeName) customTypes) $ + throw400 NotExists $ "the type: " + <> showNamedTy typeName <> + " is not an object type defined in custom types" CreateAction actionName actionDefinition _ = q hasList = \case diff --git a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs index e5d7e7605e847..f991912bdd06f 100644 --- a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs @@ -7,20 +7,22 @@ module Hasura.RQL.DDL.CustomTypes import Control.Monad.Validate -import qualified Data.HashSet as Set -import qualified Data.List.Extended as L -import qualified Data.Text as T -import qualified Database.PG.Query as Q -import qualified Language.GraphQL.Draft.Syntax as G +import qualified Data.HashMap.Strict as Map +import qualified Data.HashSet as Set +import qualified Data.List.Extended as L +import qualified Data.Text as T +import qualified Database.PG.Query as Q +import qualified Language.GraphQL.Draft.Syntax as G import Hasura.EncJSON import Hasura.Prelude import Hasura.RQL.Types +import Hasura.SQL.Types -import qualified Hasura.GraphQL.Validate.Types as VT +import Hasura.GraphQL.Schema.CustomTypes (buildCustomTypesSchemaPartial) validateCustomTypeDefinitions - :: (MonadValidate [CustomTypeValidationError] m) + :: (MonadValidate [CustomTypeValidationError] m, CacheRM m) => CustomTypes -> m () validateCustomTypeDefinitions customTypes = do unless (null duplicateTypes) $ dispute $ pure $ DuplicateTypeNames duplicateTypes @@ -40,13 +42,13 @@ validateCustomTypeDefinitions customTypes = do map (unInputObjectTypeName . _iotdName) inputObjectDefinitions <> map (unObjectTypeName . _otdName) objectDefinitions - -- TODO: add default types - scalarAndEnumTypes = - Set.fromList $ - map _stdName scalarDefinitions <> defaultScalars <> - map (unEnumTypeName . _etdName) enumDefinitions + scalarTypes = + Set.fromList $ map _stdName scalarDefinitions <> defaultScalars - -- TODO + enumTypes = + Set.fromList $ map (unEnumTypeName . _etdName) enumDefinitions + + -- TODO, clean it up maybe? defaultScalars = map G.NamedType ["Int", "Float", "String", "Boolean"] validateEnum @@ -74,11 +76,15 @@ validateCustomTypeDefinitions customTypes = do dispute $ pure $ InputObjectDuplicateFields inputObjectTypeName duplicateFieldNames - let inputTypes = scalarAndEnumTypes `Set.union` Set.fromList - (map (unInputObjectTypeName . _iotdName) inputObjectDefinitions) + let inputObjectTypes = + Set.fromList $ map (unInputObjectTypeName . _iotdName) + inputObjectDefinitions + + let inputTypes = + scalarTypes `Set.union` enumTypes `Set.union` inputObjectTypes + -- check that fields reference input types - for_ (_iotdFields inputObjectDefinition) $ - \inputObjectField -> do + for_ (_iotdFields inputObjectDefinition) $ \inputObjectField -> do let fieldBaseType = G.getBaseType $ unGraphQLType $ _iofdType inputObjectField unless (Set.member fieldBaseType inputTypes) $ refute $ pure $ InputObjectFieldTypeDoesNotExist @@ -86,20 +92,25 @@ validateCustomTypeDefinitions customTypes = do (_iofdName inputObjectField) fieldBaseType validateObject - :: (MonadValidate [CustomTypeValidationError] m) + :: (MonadValidate [CustomTypeValidationError] m, CacheRM m) => ObjectTypeDefinition -> m () validateObject objectDefinition = do let objectTypeName = _otdName objectDefinition - duplicateFieldNames = - L.duplicates $ map _ofdName $ toList $ _otdFields objectDefinition + fieldNames = map (unObjectFieldName . _ofdName) $ + toList (_otdFields objectDefinition) + relationships = fromMaybe [] $ _otdRelationships objectDefinition + relNames = map (unObjectRelationshipName . _ordName) relationships + duplicateFieldNames = L.duplicates $ fieldNames <> relNames + fields = toList $ _otdFields objectDefinition -- check for duplicate field names unless (null duplicateFieldNames) $ dispute $ pure $ ObjectDuplicateFields objectTypeName duplicateFieldNames - for_ (_otdFields objectDefinition) $ - \objectField -> do - let fieldBaseType = G.getBaseType $ unGraphQLType $ _ofdType objectField + scalarFields <- fmap (Map.fromList . catMaybes) $ + for fields $ \objectField -> do + let fieldType = unGraphQLType $ _ofdType objectField + fieldBaseType = G.getBaseType fieldType fieldName = _ofdName objectField -- check that arguments are not defined @@ -109,9 +120,11 @@ validateCustomTypeDefinitions customTypes = do let objectTypes = Set.fromList $ map (unObjectTypeName . _otdName) objectDefinitions + -- check that the fields only reference scalars and enums -- and not other object types - if | Set.member fieldBaseType scalarAndEnumTypes -> return () + if | Set.member fieldBaseType scalarTypes -> return () + | Set.member fieldBaseType enumTypes -> return () | Set.member fieldBaseType objectTypes -> dispute $ pure $ ObjectFieldObjectBaseType objectTypeName fieldName fieldBaseType @@ -119,6 +132,41 @@ validateCustomTypeDefinitions customTypes = do dispute $ pure $ ObjectFieldTypeDoesNotExist objectTypeName fieldName fieldBaseType + -- collect all non list scalar types of this object + if (not (isListType fieldType) && Set.member fieldBaseType scalarTypes) + then pure $ Just (fieldName, fieldBaseType) + else pure Nothing + + for_ relationships $ \relationshipField -> do + let relationshipName = _ordName relationshipField + remoteTable = _ordRemoteTable relationshipField + fieldMapping = _ordFieldMapping relationshipField + + --check that the table exists + remoteTableInfoM <- askTabInfoM remoteTable + remoteTableInfo <- onNothing remoteTableInfoM $ + refute $ pure $ ObjectRelationshipTableDoesNotExist + objectTypeName relationshipName remoteTable + + -- check that the column mapping is sane + forM_ (Map.toList fieldMapping) $ \(fieldName, columnName) -> do + + -- the field should be a non-list type scalar + when (Map.lookup fieldName scalarFields == Nothing) $ + dispute $ pure $ ObjectRelationshipFieldDoesNotExist + objectTypeName relationshipName fieldName + + -- the column should be a column of the table + when (getPGColumnInfoM remoteTableInfo (fromPGCol columnName) == Nothing) $ + dispute $ pure $ ObjectRelationshipColumnDoesNotExist + objectTypeName relationshipName remoteTable columnName + return () + +isListType :: G.GType -> Bool +isListType = \case + G.TypeList _ _ -> True + G.TypeNamed _ _ -> False + data CustomTypeValidationError -- ^ type names have to be unique across all types = DuplicateTypeNames !(Set.HashSet G.NamedType) @@ -132,11 +180,20 @@ data CustomTypeValidationError | ObjectFieldTypeDoesNotExist !ObjectTypeName !ObjectFieldName !G.NamedType -- ^ duplicate field declaration in objects - | ObjectDuplicateFields !ObjectTypeName !(Set.HashSet ObjectFieldName) + | ObjectDuplicateFields !ObjectTypeName !(Set.HashSet G.Name) -- ^ object fields can't have arguments | ObjectFieldArgumentsNotAllowed !ObjectTypeName !ObjectFieldName -- ^ object fields can't have object types as base types | ObjectFieldObjectBaseType !ObjectTypeName !ObjectFieldName !G.NamedType + -- ^ The table specified in the relationship does not exist + | ObjectRelationshipTableDoesNotExist + !ObjectTypeName !ObjectRelationshipName !QualifiedTable + -- ^ The field specified in the relationship mapping does not exist + | ObjectRelationshipFieldDoesNotExist + !ObjectTypeName !ObjectRelationshipName !ObjectFieldName + -- ^ The column specified in the relationship mapping does not exist + | ObjectRelationshipColumnDoesNotExist + !ObjectTypeName !ObjectRelationshipName !QualifiedTable !PGCol -- ^ duplicate enum values | DuplicateEnumValues !EnumTypeName !(Set.HashSet G.EnumValue) deriving (Show, Eq) @@ -190,20 +247,12 @@ validateCustomTypesAndAddToCache ) => CustomTypes -> m () validateCustomTypesAndAddToCache customTypes = do + schemaCache <- askSchemaCache either (throw400 ConstraintViolation . showErrors) pure - =<< runValidateT (validateCustomTypeDefinitions customTypes) - let typeInfos = - map (VT.TIEnum . convertEnumDefinition) enumDefinitions <> - map (VT.TIObj . convertObjectDefinition) objectDefinitions <> - map (VT.TIInpObj . convertInputObjectDefinition) inputObjectDefinitions <> - map (VT.TIScalar . convertScalarDefinition) scalarDefinitions - setCustomTypesInCache $ VT.mapFromL VT.getNamedTy typeInfos + =<< runValidateT ( flip runReaderT schemaCache $ + validateCustomTypeDefinitions customTypes) + buildCustomTypesSchemaPartial customTypes >>= setCustomTypesInCache where - inputObjectDefinitions = fromMaybe [] $ _ctInputObjects customTypes - objectDefinitions = fromMaybe [] $ _ctObjects customTypes - scalarDefinitions = fromMaybe [] $ _ctScalars customTypes - enumDefinitions = fromMaybe [] $ _ctEnums customTypes - showErrors :: [CustomTypeValidationError] -> T.Text showErrors allErrors = "validation for the given custom types failed " <> reasonsMessage @@ -212,55 +261,3 @@ validateCustomTypesAndAddToCache customTypes = do [singleError] -> "because " <> showCustomTypeValidationError singleError _ -> "for the following reasons:\n" <> T.unlines (map ((" • " <>) . showCustomTypeValidationError) allErrors) - - convertScalarDefinition scalarDefinition = - flip VT.fromScalarTyDef VT.TLCustom $ G.ScalarTypeDefinition - (_stdDescription scalarDefinition) - (G.unNamedType $ _stdName scalarDefinition) mempty - - convertEnumDefinition enumDefinition = - VT.EnumTyInfo (_etdDescription enumDefinition) - (unEnumTypeName $ _etdName enumDefinition) - (VT.EnumValuesSynthetic $ VT.mapFromL VT._eviVal $ - map convertEnumValueDefinition $ toList $ _etdValues enumDefinition) - VT.TLCustom - where - convertEnumValueDefinition enumValueDefinition = - VT.EnumValInfo (_evdDescription enumValueDefinition) - (_evdValue enumValueDefinition) - (fromMaybe False $ _evdIsDeprecated enumValueDefinition) - - convertObjectDefinition objectDefinition = - VT.ObjTyInfo - { VT._otiDesc = _otdDescription objectDefinition - , VT._otiName = unObjectTypeName $ _otdName objectDefinition - , VT._otiImplIFaces = mempty - , VT._otiFields = VT.mapFromL VT._fiName $ map convertObjectFieldDefinition $ - toList $ _otdFields objectDefinition - } - where - convertObjectFieldDefinition fieldDefinition = - VT.ObjFldInfo - { VT._fiDesc = _ofdDescription fieldDefinition - , VT._fiName = unObjectFieldName $ _ofdName fieldDefinition - , VT._fiParams = mempty - , VT._fiTy = unGraphQLType $ _ofdType fieldDefinition - , VT._fiLoc = VT.TLCustom - } - - convertInputObjectDefinition inputObjectDefinition = - VT.InpObjTyInfo - { VT._iotiDesc = _iotdDescription inputObjectDefinition - , VT._iotiName = unInputObjectTypeName $ _iotdName inputObjectDefinition - , VT._iotiFields = VT.mapFromL VT._iviName $ map convertInputFieldDefinition $ - toList $ _iotdFields inputObjectDefinition - , VT._iotiLoc = VT.TLCustom - } - where - convertInputFieldDefinition fieldDefinition = - VT.InpValInfo - { VT._iviDesc = _iofdDescription fieldDefinition - , VT._iviName = unInputObjectFieldName $ _iofdName fieldDefinition - , VT._iviDefVal = Nothing - , VT._iviType = unGraphQLType $ _iofdType fieldDefinition - } diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index 764c6ca025eea..beb21dfd64510 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -323,10 +323,10 @@ applyQP2 (ReplaceMetadata tables mFunctions withPathK "remote_schemas" $ indexedMapM_ (void . DRS.addRemoteSchemaP2) schemas + traverse_ DC.runSetCustomTypes_ mCustomTypes -- build GraphQL Context with Remote schemas DS.buildGCtxMap - traverse_ DC.runSetCustomTypes_ mCustomTypes for_ mActions $ \actions -> for_ actions $ \action -> do let createAction = CreateAction (_amName action) (_amDefinition action) (_amComment action) diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index 7fa3feef9bac0..a8abe826189ce 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -36,6 +36,7 @@ import qualified Language.GraphQL.Draft.Syntax as G import Hasura.Db import Hasura.GraphQL.RemoteServer +import Hasura.GraphQL.Schema.CustomTypes import Hasura.GraphQL.Utils (showNames) import Hasura.RQL.DDL.Action import Hasura.RQL.DDL.CustomTypes @@ -216,10 +217,13 @@ buildGCtxMap = do mergeCustomTypes :: MonadError QErr f - => M.HashMap RoleName GS.GCtx -> GS.GCtx -> VT.TypeMap + -- => M.HashMap RoleName GS.GCtx -> GS.GCtx -> VT.TypeMap + => M.HashMap RoleName GS.GCtx -> GS.GCtx -> (NonObjectTypeMap, AnnotatedObjects) -> f (GS.GCtxMap, GS.GCtx) -mergeCustomTypes gCtxMap remoteSchemaCtx customTypes = do - let commonTypes = M.intersectionWith (,) existingTypes customTypes +mergeCustomTypes gCtxMap remoteSchemaCtx customTypesState = do + let adminCustomTypes = buildCustomTypesSchema (fst customTypesState) + (snd customTypesState) adminRole + let commonTypes = M.intersectionWith (,) existingTypes adminCustomTypes conflictingCustomTypes = map (G.unNamedType . fst) $ M.toList $ flip M.filter commonTypes $ \case @@ -232,12 +236,17 @@ mergeCustomTypes gCtxMap remoteSchemaCtx customTypes = do "autogenerated hasura types or from remote schemas: " <> showNames conflictingCustomTypes + let gCtxMapWithCustomTypes = flip M.mapWithKey gCtxMap $ \roleName gCtx -> + let customTypes = buildCustomTypesSchema (fst customTypesState) + (snd customTypesState) roleName + in addCustomTypes gCtx customTypes + -- populate the gctx of each role with the custom types - return ( fmap addCustomTypes gCtxMap - , addCustomTypes remoteSchemaCtx + return ( gCtxMapWithCustomTypes + , addCustomTypes remoteSchemaCtx adminCustomTypes ) where - addCustomTypes gCtx = + addCustomTypes gCtx customTypes = gCtx { GS._gTypes = GS._gTypes gCtx <> customTypes} existingTypes = case (M.lookup adminRole gCtxMap) of diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs index f1869ba72c3ca..33474941153fb 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Table.hs @@ -33,11 +33,11 @@ import Hasura.RQL.DDL.Schema.Enum import Hasura.RQL.DDL.Schema.Rename import Hasura.RQL.Types import Hasura.RQL.Types.Catalog +import Hasura.RQL.Types.Table import Hasura.Server.Utils (duplicates) import Hasura.SQL.Types import qualified Database.PG.Query as Q -import qualified Hasura.GraphQL.Context as GC import qualified Hasura.GraphQL.Schema as GS import qualified Language.GraphQL.Draft.Syntax as G @@ -101,12 +101,12 @@ trackExistingTableOrViewP1 qt = do validateCustomRootFlds :: (MonadError QErr m) => GS.GCtx - -> GC.TableCustomRootFields + -> TableCustomRootFields -> m () validateCustomRootFlds defRemoteGCtx rootFlds = forM_ rootFldNames $ GS.checkConflictingNode defRemoteGCtx where - GC.TableCustomRootFields sel selByPk selAgg ins upd del = rootFlds + TableCustomRootFields sel selByPk selAgg ins upd del = rootFlds rootFldNames = catMaybes [sel, selByPk, selAgg, ins, upd, del] validateTableConfig @@ -165,7 +165,7 @@ runSetExistingTableIsEnumQ (SetTableIsEnum tableName isEnum) = do data SetTableCustomFields = SetTableCustomFields { _stcfTable :: !QualifiedTable - , _stcfCustomRootFields :: !GC.TableCustomRootFields + , _stcfCustomRootFields :: !TableCustomRootFields , _stcfCustomColumnNames :: !CustomColumnNames } deriving (Show, Eq, Lift) $(deriveToJSON (aesonDrop 5 snakeCase) ''SetTableCustomFields) @@ -174,7 +174,7 @@ instance FromJSON SetTableCustomFields where parseJSON = withObject "SetTableCustomFields" $ \o -> SetTableCustomFields <$> o .: "table" - <*> o .:? "custom_root_fields" .!= GC.emptyCustomRootFields + <*> o .:? "custom_root_fields" .!= emptyCustomRootFields <*> o .:? "custom_column_names" .!= M.empty runSetTableCustomFieldsQV2 :: (CacheBuildM m, UserInfoM m) => SetTableCustomFields -> m EncJSON diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index 27cb9dcf9e4ef..22419292df1b8 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -1,6 +1,5 @@ module Hasura.RQL.Types.Action - ( ActionOutputTypeInfo(..) - , ActionInfo(..) + ( ActionInfo(..) , ActionName(..) , ActionKind(..) @@ -19,6 +18,7 @@ module Hasura.RQL.Types.Action , ActionPermissionSelect(..) , ActionPermissionDefinition(..) , CreateActionPermission(..) + ) where @@ -30,8 +30,6 @@ import Hasura.RQL.Types.Permission import Hasura.SQL.Types import Language.Haskell.TH.Syntax (Lift) -import qualified Hasura.GraphQL.Validate.Types as VT - import qualified Data.Aeson as J import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J @@ -86,27 +84,26 @@ $(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ActionPermissionInfo) type ActionPermissionMap = Map.HashMap RoleName ActionPermissionInfo -data ActionMetadataField - = ActionMetadataFieldId - | ActionMetadataFieldCreatedAt - | ActionMetadataFieldStatus - deriving (Show, Eq) +-- data ActionMetadataField +-- = ActionMetadataFieldId +-- | ActionMetadataFieldCreatedAt +-- | ActionMetadataFieldStatus +-- deriving (Show, Eq) -data ActionOutputTypeInfo - = ActionOutputScalar !VT.ScalarTyInfo - | ActionOutputEnum !VT.EnumTyInfo - | ActionOutputObject !VT.ObjTyInfo - deriving (Show, Eq) +-- data ActionOutputTypeInfo +-- = ActionOutputScalar !VT.ScalarTyInfo +-- | ActionOutputEnum !VT.EnumTyInfo +-- | ActionOutputObject !VT.ObjTyInfo +-- deriving (Show, Eq) -- TODO: this is terrible -instance J.ToJSON ActionOutputTypeInfo where - toJSON = J.toJSON . show +-- instance J.ToJSON ActionOutputTypeInfo where +-- toJSON = J.toJSON . show data ActionInfo = ActionInfo { _aiName :: !ActionName , _aiDefintion :: !ResolvedActionDefinition - , _aiOutputTypeInfo :: !ActionOutputTypeInfo , _aiPermissions :: !ActionPermissionMap } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionInfo) diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index ef54835f64709..501e7efafe427 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -18,6 +18,7 @@ module Hasura.RQL.Types.Common , CustomColumnNames , NonEmptyText + , mkNonEmptyTextUnsafe , mkNonEmptyText , unNonEmptyText , adminText @@ -51,6 +52,9 @@ mkNonEmptyText :: T.Text -> Maybe NonEmptyText mkNonEmptyText "" = Nothing mkNonEmptyText text = Just $ NonEmptyText text +mkNonEmptyTextUnsafe :: T.Text -> NonEmptyText +mkNonEmptyTextUnsafe = NonEmptyText + parseNonEmptyText :: T.Text -> Parser NonEmptyText parseNonEmptyText text = case mkNonEmptyText text of Nothing -> fail "empty string not allowed" diff --git a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs index 666b8111b7429..986033884e319 100644 --- a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs @@ -11,8 +11,18 @@ module Hasura.RQL.Types.CustomTypes , InputObjectTypeDefinition(..) , ObjectFieldName(..) , ObjectFieldDefinition(..) + , ObjectRelationshipName(..) + , ObjectRelationshipDefinition(..) , ObjectTypeName(..) , ObjectTypeDefinition(..) + , CustomTypeName + , CustomTypeDefinition(..) + , CustomTypeDefinitionMap + , OutputFieldTypeInfo(..) + , AnnotatedObjectType(..) + , AnnotatedObjects + , AnnotatedRelationship(..) + , NonObjectTypeMap(..) ) where import Language.Haskell.TH.Syntax (Lift) @@ -22,13 +32,21 @@ import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J import qualified Data.Text as T +import qualified Data.HashMap.Strict as Map import qualified Data.List.NonEmpty as NEList +import Instances.TH.Lift () import qualified Language.GraphQL.Draft.Parser as GParse import qualified Language.GraphQL.Draft.Printer as GPrint import qualified Language.GraphQL.Draft.Printer.Text as GPrintText import qualified Language.GraphQL.Draft.Syntax as G +import qualified Hasura.GraphQL.Validate.Types as VT + import Hasura.Prelude +import Hasura.RQL.Instances () +import Hasura.RQL.Types.Column +import Hasura.RQL.Types.Table +import Hasura.SQL.Types newtype GraphQLType = GraphQLType { unGraphQLType :: G.GType } @@ -71,7 +89,8 @@ $(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''InputObjectTypeDefinition) newtype ObjectFieldName = ObjectFieldName { unObjectFieldName :: G.Name } - deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) + deriving ( Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON + , J.FromJSONKey, J.ToJSONKey, Lift) data ObjectFieldDefinition = ObjectFieldDefinition @@ -86,15 +105,29 @@ data ObjectFieldDefinition } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectFieldDefinition) +newtype ObjectRelationshipName + = ObjectRelationshipName { unObjectRelationshipName :: G.Name } + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) + +data ObjectRelationshipDefinition + = ObjectRelationshipDefinition + { _ordName :: !ObjectRelationshipName + , _ordRemoteTable :: !QualifiedTable + , _ordFieldMapping :: !(Map.HashMap ObjectFieldName PGCol) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectRelationshipDefinition) + newtype ObjectTypeName = ObjectTypeName { unObjectTypeName :: G.NamedType } - deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) + deriving ( Show, Eq, Ord, Hashable, J.FromJSON, J.FromJSONKey + , J.ToJSONKey, J.ToJSON, Lift) data ObjectTypeDefinition = ObjectTypeDefinition - { _otdName :: !ObjectTypeName - , _otdDescription :: !(Maybe G.Description) - , _otdFields :: !(NEList.NonEmpty ObjectFieldDefinition) + { _otdName :: !ObjectTypeName + , _otdDescription :: !(Maybe G.Description) + , _otdFields :: !(NEList.NonEmpty ObjectFieldDefinition) + , _otdRelationships :: !(Maybe [ObjectRelationshipDefinition]) } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectTypeDefinition) @@ -125,6 +158,19 @@ data EnumTypeDefinition } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''EnumTypeDefinition) +data CustomTypeDefinition + = CustomTypeScalar !ScalarTypeDefinition + | CustomTypeEnum !EnumTypeDefinition + | CustomTypeInputObject !InputObjectTypeDefinition + | CustomTypeObject !ObjectTypeDefinition + deriving (Show, Eq, Lift) +$(J.deriveJSON J.defaultOptions ''CustomTypeDefinition) + +type CustomTypeDefinitionMap = Map.HashMap G.NamedType CustomTypeDefinition +newtype CustomTypeName + = CustomTypeName { unCustomTypeName :: G.NamedType } + deriving (Show, Eq, Hashable, J.ToJSONKey, J.FromJSONKey) + data CustomTypes = CustomTypes { _ctInputObjects :: !(Maybe [InputObjectTypeDefinition]) @@ -133,3 +179,38 @@ data CustomTypes , _ctEnums :: !(Maybe [EnumTypeDefinition]) } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''CustomTypes) + +-- TODO: parameterise the ObjectRelationshipDefinition type +-- instead of doing this +data AnnotatedRelationship + = AnnotatedRelationship + { _arDefinition :: !ObjectRelationshipDefinition + , _arRemoteTableInfo :: !(TableInfo PGColumnInfo) + } deriving (Show, Eq) + +data OutputFieldTypeInfo + = OutputFieldScalar !VT.ScalarTyInfo + | OutputFieldEnum !VT.EnumTyInfo + deriving (Show, Eq) + +-- instance ToJSON OutputFieldTypeInfo where +-- toJSON = toJSON . show + +data AnnotatedObjectType + = AnnotatedObjectType + { _aotDefinition :: !ObjectTypeDefinition + , _aotAnnotatedFields :: !(Map.HashMap ObjectFieldName (G.GType, OutputFieldTypeInfo)) + , _aotRelationships :: !(Map.HashMap ObjectRelationshipName AnnotatedRelationship) + } deriving (Show, Eq) + +instance J.ToJSON AnnotatedObjectType where + toJSON = J.toJSON . show + +type AnnotatedObjects = Map.HashMap ObjectTypeName AnnotatedObjectType + +newtype NonObjectTypeMap + = NonObjectTypeMap { unNonObjectTypeMap :: VT.TypeMap } + deriving (Show, Eq, Semigroup, Monoid) + +instance J.ToJSON NonObjectTypeMap where + toJSON = J.toJSON . show diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index e63399c9fa158..1b4eab81a2ded 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -16,7 +16,13 @@ module Hasura.RQL.Types.SchemaCache , modTableInCache , delTableFromCache + , OutputFieldTypeInfo(..) + , AnnotatedObjectType(..) + , AnnotatedObjects + , AnnotatedRelationship(..) + , NonObjectTypeMap(..) , TableInfo(..) + , askTabInfoM , tiName , tiDescription , tiSystemDefined @@ -52,6 +58,8 @@ module Hasura.RQL.Types.SchemaCache , FieldInfo(..) , _FIColumn , _FIRelationship + , getFieldInfoM + , getPGColumnInfoM , fieldInfoToEither , partitionFieldInfos , partitionFieldInfosWith @@ -80,6 +88,7 @@ module Hasura.RQL.Types.SchemaCache , InsPermInfo(..) , SelPermInfo(..) + , getSelectPermissionInfoM , UpdPermInfo(..) , DelPermInfo(..) , addPermToCache @@ -126,16 +135,17 @@ module Hasura.RQL.Types.SchemaCache ) where import qualified Hasura.GraphQL.Context as GC -import qualified Hasura.GraphQL.Validate.Types as RT import Hasura.Prelude import Hasura.RQL.Types.Action import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.Column import Hasura.RQL.Types.Common +import Hasura.RQL.Types.CustomTypes import Hasura.RQL.Types.Error import Hasura.RQL.Types.EventTrigger import Hasura.RQL.Types.Metadata +import Hasura.RQL.Types.Table import Hasura.RQL.Types.Permission import Hasura.RQL.Types.QueryCollection import Hasura.RQL.Types.RemoteSchema @@ -146,7 +156,6 @@ import Control.Lens import Data.Aeson import Data.Aeson.Casing import Data.Aeson.TH -import Language.Haskell.TH.Syntax (Lift) import qualified Data.HashMap.Strict as M import qualified Data.HashSet as HS @@ -165,116 +174,6 @@ mkColDep reason tn col = type WithDeps a = (a, [SchemaDependency]) -data FieldInfo columnInfo - = FIColumn !columnInfo - | FIRelationship !RelInfo - deriving (Show, Eq) -$(deriveToJSON - defaultOptions { constructorTagModifier = snakeCase . drop 2 - , sumEncoding = TaggedObject "type" "detail" - } - ''FieldInfo) -$(makePrisms ''FieldInfo) - -fieldInfoToEither :: FieldInfo columnInfo -> Either columnInfo RelInfo -fieldInfoToEither (FIColumn l) = Left l -fieldInfoToEither (FIRelationship r) = Right r - -partitionFieldInfos :: [FieldInfo columnInfo] -> ([columnInfo], [RelInfo]) -partitionFieldInfos = partitionFieldInfosWith (id, id) - -partitionFieldInfosWith :: (columnInfo -> a, RelInfo -> b) - -> [FieldInfo columnInfo] -> ([a], [b]) -partitionFieldInfosWith fns = - partitionEithers . map (biMapEither fns . fieldInfoToEither) - where - biMapEither (f1, f2) = either (Left . f1) (Right . f2) - -type FieldInfoMap columnInfo = M.HashMap FieldName (FieldInfo columnInfo) - -getCols :: FieldInfoMap columnInfo -> [columnInfo] -getCols fim = lefts $ map fieldInfoToEither $ M.elems fim - -getRels :: FieldInfoMap columnInfo -> [RelInfo] -getRels fim = rights $ map fieldInfoToEither $ M.elems fim - -isPGColInfo :: FieldInfo columnInfo -> Bool -isPGColInfo (FIColumn _) = True -isPGColInfo _ = False - -data InsPermInfo - = InsPermInfo - { ipiCols :: !(HS.HashSet PGCol) - , ipiView :: !QualifiedTable - , ipiCheck :: !AnnBoolExpPartialSQL - , ipiSet :: !PreSetColsPartial - , ipiRequiredHeaders :: ![T.Text] - } deriving (Show, Eq) - -$(deriveToJSON (aesonDrop 3 snakeCase) ''InsPermInfo) - -data SelPermInfo - = SelPermInfo - { spiCols :: !(HS.HashSet PGCol) - , spiTable :: !QualifiedTable - , spiFilter :: !AnnBoolExpPartialSQL - , spiLimit :: !(Maybe Int) - , spiAllowAgg :: !Bool - , spiRequiredHeaders :: ![T.Text] - } deriving (Show, Eq) - -$(deriveToJSON (aesonDrop 3 snakeCase) ''SelPermInfo) - -data UpdPermInfo - = UpdPermInfo - { upiCols :: !(HS.HashSet PGCol) - , upiTable :: !QualifiedTable - , upiFilter :: !AnnBoolExpPartialSQL - , upiSet :: !PreSetColsPartial - , upiRequiredHeaders :: ![T.Text] - } deriving (Show, Eq) - -$(deriveToJSON (aesonDrop 3 snakeCase) ''UpdPermInfo) - -data DelPermInfo - = DelPermInfo - { dpiTable :: !QualifiedTable - , dpiFilter :: !AnnBoolExpPartialSQL - , dpiRequiredHeaders :: ![T.Text] - } deriving (Show, Eq) - -$(deriveToJSON (aesonDrop 3 snakeCase) ''DelPermInfo) - -mkRolePermInfo :: RolePermInfo -mkRolePermInfo = RolePermInfo Nothing Nothing Nothing Nothing - -data RolePermInfo - = RolePermInfo - { _permIns :: !(Maybe InsPermInfo) - , _permSel :: !(Maybe SelPermInfo) - , _permUpd :: !(Maybe UpdPermInfo) - , _permDel :: !(Maybe DelPermInfo) - } deriving (Show, Eq) - -$(deriveToJSON (aesonDrop 5 snakeCase) ''RolePermInfo) - -makeLenses ''RolePermInfo - -type RolePermInfoMap = M.HashMap RoleName RolePermInfo - -data EventTriggerInfo - = EventTriggerInfo - { etiName :: !TriggerName - , etiOpsDef :: !TriggerOpsDef - , etiRetryConf :: !RetryConf - , etiWebhookInfo :: !WebhookConfInfo - , etiHeaders :: ![EventHeaderInfo] - } deriving (Show, Eq) - -$(deriveToJSON (aesonDrop 3 snakeCase) ''EventTriggerInfo) - -type EventTriggerInfoMap = M.HashMap TriggerName EventTriggerInfo - data ConstraintType = CTCHECK | CTFOREIGNKEY @@ -322,60 +221,6 @@ data TableConstraint $(deriveJSON (aesonDrop 2 snakeCase) ''TableConstraint) -data ViewInfo - = ViewInfo - { viIsUpdatable :: !Bool - , viIsDeletable :: !Bool - , viIsInsertable :: !Bool - } deriving (Show, Eq) - -$(deriveJSON (aesonDrop 2 snakeCase) ''ViewInfo) - -isMutable :: (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool -isMutable _ Nothing = True -isMutable f (Just vi) = f vi - -mutableView :: (MonadError QErr m) => QualifiedTable - -> (ViewInfo -> Bool) -> Maybe ViewInfo - -> T.Text -> m () -mutableView qt f mVI operation = - unless (isMutable f mVI) $ throw400 NotSupported $ - "view " <> qt <<> " is not " <> operation - -data TableConfig - = TableConfig - { _tcCustomRootFields :: !GC.TableCustomRootFields - , _tcCustomColumnNames :: !CustomColumnNames - } deriving (Show, Eq, Lift) -$(deriveToJSON (aesonDrop 3 snakeCase) ''TableConfig) - -emptyTableConfig :: TableConfig -emptyTableConfig = - TableConfig GC.emptyCustomRootFields M.empty - -instance FromJSON TableConfig where - parseJSON = withObject "TableConfig" $ \obj -> - TableConfig - <$> obj .:? "custom_root_fields" .!= GC.emptyCustomRootFields - <*> obj .:? "custom_column_names" .!= M.empty - -data TableInfo columnInfo - = TableInfo - { _tiName :: !QualifiedTable - , _tiDescription :: !(Maybe PGDescription) - , _tiSystemDefined :: !SystemDefined - , _tiFieldInfoMap :: !(FieldInfoMap columnInfo) - , _tiRolePermInfoMap :: !RolePermInfoMap - , _tiUniqOrPrimConstraints :: ![ConstraintName] - , _tiPrimaryKeyCols :: ![PGCol] - , _tiViewInfo :: !(Maybe ViewInfo) - , _tiEventTriggerInfoMap :: !EventTriggerInfoMap - , _tiEnumValues :: !(Maybe EnumValues) - , _tiCustomConfig :: !TableConfig - } deriving (Show, Eq) -$(deriveToJSON (aesonDrop 2 snakeCase) ''TableInfo) -$(makeLenses ''TableInfo) - checkForFieldConflict :: (MonadError QErr m) => TableInfo a @@ -428,7 +273,6 @@ data FunctionInfo $(deriveToJSON (aesonDrop 2 snakeCase) ''FunctionInfo) -type TableCache columnInfo = M.HashMap QualifiedTable (TableInfo columnInfo) -- info of all tables type FunctionCache = M.HashMap QualifiedFunction FunctionInfo -- info of all functions data RemoteSchemaCtx @@ -464,6 +308,12 @@ incSchemaCacheVer :: SchemaCacheVer -> SchemaCacheVer incSchemaCacheVer (SchemaCacheVer prev) = SchemaCacheVer $ prev + 1 +-- data CustomTypesState +-- = CustomTypeState +-- { _ctsTypes :: !RT.TypeMap +-- , _ctsRelationships :: !(M.HashMap G.NamedType ) +-- } + type ActionCache = M.HashMap ActionName ActionInfo @@ -474,7 +324,7 @@ data SchemaCache , scFunctions :: !FunctionCache , scRemoteSchemas :: !RemoteSchemaMap , scAllowlist :: !(HS.HashSet GQLQuery) - , scCustomTypes :: !RT.TypeMap + , scCustomTypes :: !(NonObjectTypeMap, AnnotatedObjects) , scGCtxMap :: !GC.GCtxMap , scDefaultRemoteGCtx :: !GC.GCtx , scDepMap :: !DepMap @@ -489,6 +339,16 @@ class (Monad m) => CacheRM m where instance (Monad m) => CacheRM (StateT SchemaCache m) where askSchemaCache = get +instance (Monad m) => CacheRM (ReaderT SchemaCache m) where + askSchemaCache = ask + +askTabInfoM + :: (CacheRM m) + => QualifiedTable -> m (Maybe (TableInfo PGColumnInfo)) +askTabInfoM tabName = do + rawSchemaCache <- askSchemaCache + return $ M.lookup tabName $ scTables rawSchemaCache + class (CacheRM m) => CacheRWM m where writeSchemaCache :: SchemaCache -> m () @@ -598,7 +458,7 @@ delFldFromCache fn = setCustomTypesInCache :: (QErrM m, CacheRWM m) - => RT.TypeMap + => (NonObjectTypeMap, AnnotatedObjects) -> m () setCustomTypesInCache customTypes = do sc <- askSchemaCache @@ -642,30 +502,6 @@ updColInCache cn ci tn = do delColFromCache cn tn addColToCache cn ci tn -data PermAccessor a where - PAInsert :: PermAccessor InsPermInfo - PASelect :: PermAccessor SelPermInfo - PAUpdate :: PermAccessor UpdPermInfo - PADelete :: PermAccessor DelPermInfo - -permAccToLens :: PermAccessor a -> Lens' RolePermInfo (Maybe a) -permAccToLens PAInsert = permIns -permAccToLens PASelect = permSel -permAccToLens PAUpdate = permUpd -permAccToLens PADelete = permDel - -permAccToType :: PermAccessor a -> PermType -permAccToType PAInsert = PTInsert -permAccToType PASelect = PTSelect -permAccToType PAUpdate = PTUpdate -permAccToType PADelete = PTDelete - -withPermType :: PermType -> (forall a. PermAccessor a -> b) -> b -withPermType PTInsert f = f PAInsert -withPermType PTSelect f = f PASelect -withPermType PTUpdate f = f PAUpdate -withPermType PTDelete f = f PADelete - addPermToCache :: (QErrM m, CacheRWM m) => QualifiedTable diff --git a/server/src-lib/Hasura/RQL/Types/Table.hs b/server/src-lib/Hasura/RQL/Types/Table.hs new file mode 100644 index 0000000000000..952d5e5ef4cf9 --- /dev/null +++ b/server/src-lib/Hasura/RQL/Types/Table.hs @@ -0,0 +1,364 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE RankNTypes #-} + +module Hasura.RQL.Types.Table + ( TableConfig(..) + , emptyTableConfig + + , TableCache + + , TableInfo(..) + , tiName + , tiDescription + , tiSystemDefined + , tiFieldInfoMap + , tiRolePermInfoMap + , tiUniqOrPrimConstraints + , tiPrimaryKeyCols + , tiViewInfo + , tiEventTriggerInfoMap + , tiEnumValues + , tiCustomConfig + + -- , TableConstraint(..) + -- , ConstraintType(..) + , ViewInfo(..) + , isMutable + , mutableView + + , FieldInfoMap + , FieldInfo(..) + , _FIColumn + , _FIRelationship + , getFieldInfoM + , getPGColumnInfoM + , fieldInfoToEither + , partitionFieldInfos + , partitionFieldInfosWith + , getCols + , getRels + + , isPGColInfo + , RelInfo(..) + + , RolePermInfo(..) + , mkRolePermInfo + , permIns + , permSel + , permUpd + , permDel + , PermAccessor(..) + , permAccToLens + , permAccToType + , withPermType + , RolePermInfoMap + + , InsPermInfo(..) + , SelPermInfo(..) + , getSelectPermissionInfoM + , UpdPermInfo(..) + , DelPermInfo(..) + , PreSetColsPartial + + , EventTriggerInfo(..) + , EventTriggerInfoMap + , TableCustomRootFields(..) + , emptyCustomRootFields + + ) where + +-- import qualified Hasura.GraphQL.Context as GC + +import Hasura.Prelude +import Hasura.RQL.Types.BoolExp +import Hasura.RQL.Types.Column +import Hasura.RQL.Types.Common +import Hasura.RQL.Types.Error +import Hasura.RQL.Types.EventTrigger +import Hasura.RQL.Types.Permission +import Hasura.SQL.Types + +import Control.Lens +import Data.Aeson +import Data.Aeson.Casing +import Data.Aeson.TH +import Language.Haskell.TH.Syntax (Lift) + +import qualified Data.HashMap.Strict as M +import qualified Data.HashSet as HS +import qualified Data.Text as T +import qualified Language.GraphQL.Draft.Syntax as G + +data TableCustomRootFields + = TableCustomRootFields + { _tcrfSelect :: !(Maybe G.Name) + , _tcrfSelectByPk :: !(Maybe G.Name) + , _tcrfSelectAggregate :: !(Maybe G.Name) + , _tcrfInsert :: !(Maybe G.Name) + , _tcrfUpdate :: !(Maybe G.Name) + , _tcrfDelete :: !(Maybe G.Name) + } deriving (Show, Eq, Lift) +$(deriveJSON (aesonDrop 5 snakeCase) ''TableCustomRootFields) + +emptyCustomRootFields :: TableCustomRootFields +emptyCustomRootFields = + TableCustomRootFields + { _tcrfSelect = Nothing + , _tcrfSelectByPk = Nothing + , _tcrfSelectAggregate = Nothing + , _tcrfInsert = Nothing + , _tcrfUpdate = Nothing + , _tcrfDelete = Nothing + } + +data FieldInfo columnInfo + = FIColumn !columnInfo + | FIRelationship !RelInfo + deriving (Show, Eq) +$(deriveToJSON + defaultOptions { constructorTagModifier = snakeCase . drop 2 + , sumEncoding = TaggedObject "type" "detail" + } + ''FieldInfo) +$(makePrisms ''FieldInfo) + +fieldInfoToEither :: FieldInfo columnInfo -> Either columnInfo RelInfo +fieldInfoToEither (FIColumn l) = Left l +fieldInfoToEither (FIRelationship r) = Right r + +partitionFieldInfos :: [FieldInfo columnInfo] -> ([columnInfo], [RelInfo]) +partitionFieldInfos = partitionFieldInfosWith (id, id) + +partitionFieldInfosWith :: (columnInfo -> a, RelInfo -> b) + -> [FieldInfo columnInfo] -> ([a], [b]) +partitionFieldInfosWith fns = + partitionEithers . map (biMapEither fns . fieldInfoToEither) + where + biMapEither (f1, f2) = either (Left . f1) (Right . f2) + +type FieldInfoMap columnInfo = M.HashMap FieldName (FieldInfo columnInfo) + +getCols :: FieldInfoMap columnInfo -> [columnInfo] +getCols fim = lefts $ map fieldInfoToEither $ M.elems fim + +getRels :: FieldInfoMap columnInfo -> [RelInfo] +getRels fim = rights $ map fieldInfoToEither $ M.elems fim + +isPGColInfo :: FieldInfo columnInfo -> Bool +isPGColInfo (FIColumn _) = True +isPGColInfo _ = False + +data InsPermInfo + = InsPermInfo + { ipiCols :: !(HS.HashSet PGCol) + , ipiView :: !QualifiedTable + , ipiCheck :: !AnnBoolExpPartialSQL + , ipiSet :: !PreSetColsPartial + , ipiRequiredHeaders :: ![T.Text] + } deriving (Show, Eq) + +$(deriveToJSON (aesonDrop 3 snakeCase) ''InsPermInfo) + +data SelPermInfo + = SelPermInfo + { spiCols :: !(HS.HashSet PGCol) + , spiTable :: !QualifiedTable + , spiFilter :: !AnnBoolExpPartialSQL + , spiLimit :: !(Maybe Int) + , spiAllowAgg :: !Bool + , spiRequiredHeaders :: ![T.Text] + } deriving (Show, Eq) + +$(deriveToJSON (aesonDrop 3 snakeCase) ''SelPermInfo) + +data UpdPermInfo + = UpdPermInfo + { upiCols :: !(HS.HashSet PGCol) + , upiTable :: !QualifiedTable + , upiFilter :: !AnnBoolExpPartialSQL + , upiSet :: !PreSetColsPartial + , upiRequiredHeaders :: ![T.Text] + } deriving (Show, Eq) + +$(deriveToJSON (aesonDrop 3 snakeCase) ''UpdPermInfo) + +data DelPermInfo + = DelPermInfo + { dpiTable :: !QualifiedTable + , dpiFilter :: !AnnBoolExpPartialSQL + , dpiRequiredHeaders :: ![T.Text] + } deriving (Show, Eq) + +$(deriveToJSON (aesonDrop 3 snakeCase) ''DelPermInfo) + +mkRolePermInfo :: RolePermInfo +mkRolePermInfo = RolePermInfo Nothing Nothing Nothing Nothing + +data RolePermInfo + = RolePermInfo + { _permIns :: !(Maybe InsPermInfo) + , _permSel :: !(Maybe SelPermInfo) + , _permUpd :: !(Maybe UpdPermInfo) + , _permDel :: !(Maybe DelPermInfo) + } deriving (Show, Eq) + +$(deriveToJSON (aesonDrop 5 snakeCase) ''RolePermInfo) + +makeLenses ''RolePermInfo + +type RolePermInfoMap = M.HashMap RoleName RolePermInfo + +data EventTriggerInfo + = EventTriggerInfo + { etiName :: !TriggerName + , etiOpsDef :: !TriggerOpsDef + , etiRetryConf :: !RetryConf + , etiWebhookInfo :: !WebhookConfInfo + , etiHeaders :: ![EventHeaderInfo] + } deriving (Show, Eq) + +$(deriveToJSON (aesonDrop 3 snakeCase) ''EventTriggerInfo) + +type EventTriggerInfoMap = M.HashMap TriggerName EventTriggerInfo + +-- data ConstraintType +-- = CTCHECK +-- | CTFOREIGNKEY +-- | CTPRIMARYKEY +-- | CTUNIQUE +-- deriving Eq + +-- constraintTyToTxt :: ConstraintType -> T.Text +-- constraintTyToTxt ty = case ty of +-- CTCHECK -> "CHECK" +-- CTFOREIGNKEY -> "FOREIGN KEY" +-- CTPRIMARYKEY -> "PRIMARY KEY" +-- CTUNIQUE -> "UNIQUE" + +-- instance Show ConstraintType where +-- show = T.unpack . constraintTyToTxt + +-- instance FromJSON ConstraintType where +-- parseJSON = withText "ConstraintType" $ \case +-- "CHECK" -> return CTCHECK +-- "FOREIGN KEY" -> return CTFOREIGNKEY +-- "PRIMARY KEY" -> return CTPRIMARYKEY +-- "UNIQUE" -> return CTUNIQUE +-- c -> fail $ "unexpected ConstraintType: " <> T.unpack c + +-- instance ToJSON ConstraintType where +-- toJSON = String . constraintTyToTxt + +-- isUniqueOrPrimary :: ConstraintType -> Bool +-- isUniqueOrPrimary = \case +-- CTPRIMARYKEY -> True +-- CTUNIQUE -> True +-- _ -> False + +-- isForeignKey :: ConstraintType -> Bool +-- isForeignKey = \case +-- CTFOREIGNKEY -> True +-- _ -> False + +-- data TableConstraint +-- = TableConstraint +-- { tcType :: !ConstraintType +-- , tcName :: !ConstraintName +-- } deriving (Show, Eq) + +-- $(deriveJSON (aesonDrop 2 snakeCase) ''TableConstraint) + +data ViewInfo + = ViewInfo + { viIsUpdatable :: !Bool + , viIsDeletable :: !Bool + , viIsInsertable :: !Bool + } deriving (Show, Eq) + +$(deriveJSON (aesonDrop 2 snakeCase) ''ViewInfo) + +isMutable :: (ViewInfo -> Bool) -> Maybe ViewInfo -> Bool +isMutable _ Nothing = True +isMutable f (Just vi) = f vi + +mutableView :: (MonadError QErr m) => QualifiedTable + -> (ViewInfo -> Bool) -> Maybe ViewInfo + -> T.Text -> m () +mutableView qt f mVI operation = + unless (isMutable f mVI) $ throw400 NotSupported $ + "view " <> qt <<> " is not " <> operation + +data TableConfig + = TableConfig + { _tcCustomRootFields :: !TableCustomRootFields + , _tcCustomColumnNames :: !CustomColumnNames + } deriving (Show, Eq, Lift) +$(deriveToJSON (aesonDrop 3 snakeCase) ''TableConfig) + +emptyTableConfig :: TableConfig +emptyTableConfig = + TableConfig emptyCustomRootFields M.empty + +instance FromJSON TableConfig where + parseJSON = withObject "TableConfig" $ \obj -> + TableConfig + <$> obj .:? "custom_root_fields" .!= emptyCustomRootFields + <*> obj .:? "custom_column_names" .!= M.empty + +data TableInfo columnInfo + = TableInfo + { _tiName :: !QualifiedTable + , _tiDescription :: !(Maybe PGDescription) + , _tiSystemDefined :: !SystemDefined + , _tiFieldInfoMap :: !(FieldInfoMap columnInfo) + , _tiRolePermInfoMap :: !RolePermInfoMap + , _tiUniqOrPrimConstraints :: ![ConstraintName] + , _tiPrimaryKeyCols :: ![PGCol] + , _tiViewInfo :: !(Maybe ViewInfo) + , _tiEventTriggerInfoMap :: !EventTriggerInfoMap + , _tiEnumValues :: !(Maybe EnumValues) + , _tiCustomConfig :: !TableConfig + } deriving (Show, Eq) +$(deriveToJSON (aesonDrop 2 snakeCase) ''TableInfo) +$(makeLenses ''TableInfo) + +getFieldInfoM + :: TableInfo columnInfo -> FieldName -> Maybe (FieldInfo columnInfo) +getFieldInfoM tableInfo fieldName + = tableInfo ^. tiFieldInfoMap.at fieldName + +getPGColumnInfoM + :: TableInfo columnInfo -> FieldName -> Maybe columnInfo +getPGColumnInfoM tableInfo fieldName = + (^? _FIColumn) =<< getFieldInfoM tableInfo fieldName + +getSelectPermissionInfoM + :: TableInfo columnInfo -> RoleName -> Maybe SelPermInfo +getSelectPermissionInfoM tableInfo roleName = + join $ tableInfo ^? tiRolePermInfoMap.at roleName._Just.permSel + +type TableCache columnInfo = M.HashMap QualifiedTable (TableInfo columnInfo) -- info of all tables + +data PermAccessor a where + PAInsert :: PermAccessor InsPermInfo + PASelect :: PermAccessor SelPermInfo + PAUpdate :: PermAccessor UpdPermInfo + PADelete :: PermAccessor DelPermInfo + +permAccToLens :: PermAccessor a -> Lens' RolePermInfo (Maybe a) +permAccToLens PAInsert = permIns +permAccToLens PASelect = permSel +permAccToLens PAUpdate = permUpd +permAccToLens PADelete = permDel + +permAccToType :: PermAccessor a -> PermType +permAccToType PAInsert = PTInsert +permAccToType PASelect = PTSelect +permAccToType PAUpdate = PTUpdate +permAccToType PADelete = PTDelete + +withPermType :: PermType -> (forall a. PermAccessor a -> b) -> b +withPermType PTInsert f = f PAInsert +withPermType PTSelect f = f PASelect +withPermType PTUpdate f = f PAUpdate +withPermType PTDelete f = f PADelete diff --git a/server/src-lib/Hasura/Server/App.hs b/server/src-lib/Hasura/Server/App.hs index f8ec3d21a54f6..ed748f20de812 100644 --- a/server/src-lib/Hasura/Server/App.hs +++ b/server/src-lib/Hasura/Server/App.hs @@ -428,7 +428,7 @@ initErrExit :: QErr -> IO a initErrExit e = do putStrLn $ "failed to build schema-cache because of inconsistent metadata: " - <> T.unpack (qeError e) + <> (show e) exitFailure data HasuraApp diff --git a/server/stack.yaml b/server/stack.yaml index de34787117df0..7a4d9fc62ab52 100644 --- a/server/stack.yaml +++ b/server/stack.yaml @@ -6,7 +6,7 @@ resolver: lts-14.8 # Local packages, usually specified by relative directory name packages: - '.' -# - '../../graphql-parser-hs' +- '../../graphql-parser-hs' # - extra-libs/aeson # - extra-libs/logger/wai-logger @@ -18,8 +18,8 @@ extra-deps: # use https URLs so that build systems can clone these repos - git: https://github.com/hasura/pg-client-hs.git commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 -- git: https://github.com/0x777/graphql-parser-hs.git - commit: bf9781312d49af6168d97d5374bc4df72f72c1d5 +# - git: https://github.com/0x777/graphql-parser-hs.git +# commit: bf9781312d49af6168d97d5374bc4df72f72c1d5 - git: https://github.com/hasura/ci-info-hs.git commit: ad6df731584dc89b72a6e131687d37ef01714fe8 diff --git a/server/stack.yaml.lock b/server/stack.yaml.lock index b66c226c7a6e8..17a6830c75ef6 100644 --- a/server/stack.yaml.lock +++ b/server/stack.yaml.lock @@ -18,20 +18,6 @@ packages: original: git: https://github.com/hasura/pg-client-hs.git commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 -- completed: - cabal-file: - size: 3364 - sha256: 09bad175e8ccb1fec5ddbc94d95d18b4206ac4481cf3749e42ffbaac90bc4a37 - name: graphql-parser - version: 0.1.0.0 - git: https://github.com/0x777/graphql-parser-hs.git - pantry-tree: - size: 1826 - sha256: 819c622940b2d66331116fea4ea013edf039bbd88c482676a6da1244e46b3fc0 - commit: bf9781312d49af6168d97d5374bc4df72f72c1d5 - original: - git: https://github.com/0x777/graphql-parser-hs.git - commit: bf9781312d49af6168d97d5374bc4df72f72c1d5 - completed: cabal-file: size: 1253 From 44622848e4927243dcab02170374032c1aea0b51 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Mon, 21 Oct 2019 00:10:44 +0530 Subject: [PATCH 09/62] revert to lts-13 and bump graphql-parser-hs commit --- server/stack.yaml | 8 ++++---- server/stack.yaml.lock | 14 ++++++++++++++ 2 files changed, 18 insertions(+), 4 deletions(-) diff --git a/server/stack.yaml b/server/stack.yaml index 7a4d9fc62ab52..cd2cb0872bc9e 100644 --- a/server/stack.yaml +++ b/server/stack.yaml @@ -2,11 +2,11 @@ # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) # resolver: lts-10.8 -resolver: lts-14.8 +resolver: lts-13.29 # Local packages, usually specified by relative directory name packages: - '.' -- '../../graphql-parser-hs' +# - '../../graphql-parser-hs' # - extra-libs/aeson # - extra-libs/logger/wai-logger @@ -18,8 +18,8 @@ extra-deps: # use https URLs so that build systems can clone these repos - git: https://github.com/hasura/pg-client-hs.git commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 -# - git: https://github.com/0x777/graphql-parser-hs.git -# commit: bf9781312d49af6168d97d5374bc4df72f72c1d5 +- git: https://github.com/0x777/graphql-parser-hs.git + commit: 6eda2bf6bafe6d90bc4fe369f656a3cb979b041a - git: https://github.com/hasura/ci-info-hs.git commit: ad6df731584dc89b72a6e131687d37ef01714fe8 diff --git a/server/stack.yaml.lock b/server/stack.yaml.lock index 17a6830c75ef6..12f3304f89b74 100644 --- a/server/stack.yaml.lock +++ b/server/stack.yaml.lock @@ -18,6 +18,20 @@ packages: original: git: https://github.com/hasura/pg-client-hs.git commit: de5c023ed7d2f75a77972ff52b6e5ed19d010ca2 +- completed: + cabal-file: + size: 3364 + sha256: 09bad175e8ccb1fec5ddbc94d95d18b4206ac4481cf3749e42ffbaac90bc4a37 + name: graphql-parser + version: 0.1.0.0 + git: https://github.com/0x777/graphql-parser-hs.git + pantry-tree: + size: 1826 + sha256: 57f83a277efa6642085141ccd86bc71c95654f4083220e4a0137f59146f8c5bf + commit: 6eda2bf6bafe6d90bc4fe369f656a3cb979b041a + original: + git: https://github.com/0x777/graphql-parser-hs.git + commit: 6eda2bf6bafe6d90bc4fe369f656a3cb979b041a - completed: cabal-file: size: 1253 From e0570a5e72c9bc58be4cb840dbee9da482de4dca Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Mon, 21 Oct 2019 08:51:45 +0530 Subject: [PATCH 10/62] lower the lts version so that the Cabal version matches that of the builder image --- server/stack.yaml | 2 +- server/stack.yaml.lock | 8 ++++---- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/server/stack.yaml b/server/stack.yaml index cd2cb0872bc9e..675e3d69d79ff 100644 --- a/server/stack.yaml +++ b/server/stack.yaml @@ -2,7 +2,7 @@ # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2) # resolver: lts-10.8 -resolver: lts-13.29 +resolver: lts-13.27 # Local packages, usually specified by relative directory name packages: - '.' diff --git a/server/stack.yaml.lock b/server/stack.yaml.lock index 12f3304f89b74..370c2c25a7c2a 100644 --- a/server/stack.yaml.lock +++ b/server/stack.yaml.lock @@ -97,7 +97,7 @@ packages: hackage: shakespeare-2.0.22 snapshots: - completed: - size: 524789 - url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/14/8.yaml - sha256: 8af5eb80734f02621d37e82cc0cde614af2ddc9c320610acb0b1b6d9ac162930 - original: lts-14.8 + size: 500539 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/27.yaml + sha256: 690db832392afe55733b4c7023fd29b1b1c660ee42f1fb505b86b07394ca994e + original: lts-13.27 From 4bc81068ad445ec20f4e5974c362312436dc3d26 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Mon, 21 Oct 2019 09:24:38 +0530 Subject: [PATCH 11/62] disable -Werr on this branch --- server/Makefile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/server/Makefile b/server/Makefile index dbedfa13edd6f..c2ade12d2bbcf 100644 --- a/server/Makefile +++ b/server/Makefile @@ -54,7 +54,8 @@ release-image: $(project).cabal # assumes this is built in circleci ci-binary: mkdir -p packaging/build/rootfs - stack $(STACK_FLAGS) build --ghc-options=-Werror $(BUILD_FLAGS) + # stack $(STACK_FLAGS) build --ghc-options=-Werror $(BUILD_FLAGS) + stack $(STACK_FLAGS) build $(BUILD_FLAGS) mkdir -p $(build_output) cp $(build_dir)/$(project)/$(project) $(build_output) echo "$(VERSION)" > $(build_output)/version.txt From c86dcc4664e177d11622e93f70bd0b11d7bd60f2 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Mon, 21 Oct 2019 11:07:52 +0530 Subject: [PATCH 12/62] initialise.sql is now in sync with the migration file --- server/src-rsr/initialise.sql | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/server/src-rsr/initialise.sql b/server/src-rsr/initialise.sql index d93f89f1874ae..f569e012f9a69 100644 --- a/server/src-rsr/initialise.sql +++ b/server/src-rsr/initialise.sql @@ -653,12 +653,21 @@ CREATE TABLE hdb_catalog.hdb_action_permission CREATE TABLE hdb_catalog.hdb_action_log ( id UUID PRIMARY KEY DEFAULT gen_random_uuid(), + -- we deliberately do not reference the action name + -- because sometimes we may want to retain history + -- when after dropping the action action_name TEXT, input_payload JSONB NOT NULL, + session_variables JSONB NOT NULL, response_payload JSONB NULL, - created_at timestamptz NOT NULL, + created_at timestamptz NOT NULL default now(), response_received_at timestamptz NULL, status text NOT NULL, CHECK (status IN ('created', 'processing', 'completed', 'error')) ); + +CREATE TABLE hdb_catalog.hdb_custom_graphql_types +( + custom_types jsonb NOT NULL +); From cb05dd1f90dff79fcc1e04fb5edd2bf9a2a9c0f7 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Mon, 21 Oct 2019 16:02:03 +0530 Subject: [PATCH 13/62] fix metadata tests --- server/src-lib/Hasura/RQL/DDL/Metadata.hs | 2 +- server/tests-py/queries/v1/metadata/clear_metadata.yaml | 2 ++ server/tests-py/queries/v1/metadata/export_metadata.yaml | 4 +++- 3 files changed, 6 insertions(+), 2 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index beb21dfd64510..bd53ab688e9c6 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -186,7 +186,7 @@ data ReplaceMetadata , aqActions :: !(Maybe [ActionMetadata]) } deriving (Show, Eq, Lift) -$(deriveJSON (aesonDrop 2 snakeCase){omitNothingFields=True} ''ReplaceMetadata) +$(deriveJSON (aesonDrop 2 snakeCase) ''ReplaceMetadata) applyQP1 :: (QErrM m, UserInfoM m) diff --git a/server/tests-py/queries/v1/metadata/clear_metadata.yaml b/server/tests-py/queries/v1/metadata/clear_metadata.yaml index c073b585b6e90..93f550d0d3bce 100644 --- a/server/tests-py/queries/v1/metadata/clear_metadata.yaml +++ b/server/tests-py/queries/v1/metadata/clear_metadata.yaml @@ -16,6 +16,8 @@ query_collections: [] tables: [] remote_schemas: [] + actions: [] + custom_types: null query: type: export_metadata args: {} diff --git a/server/tests-py/queries/v1/metadata/export_metadata.yaml b/server/tests-py/queries/v1/metadata/export_metadata.yaml index 57fba4377a6ff..68f0469376fc5 100644 --- a/server/tests-py/queries/v1/metadata/export_metadata.yaml +++ b/server/tests-py/queries/v1/metadata/export_metadata.yaml @@ -1,4 +1,4 @@ -description: Export schema cache (metadata) +description: Export metadata url: /v1/query status: 200 response: @@ -7,6 +7,8 @@ response: remote_schemas: [] query_collections: [] allowlist: [] + actions: [] + custom_types: null tables: - table: author is_enum: false From b9257523f1996ffbfbd30a020a580c5700607b6b Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Tue, 22 Oct 2019 15:28:12 +0530 Subject: [PATCH 14/62] allow specifying arguments of actions --- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 12 ++++---- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 12 +++----- server/src-lib/Hasura/RQL/DDL/Action.hs | 28 +++++++++++-------- server/src-lib/Hasura/RQL/Types/Action.hs | 27 ++++++++++++++---- 4 files changed, 46 insertions(+), 33 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index c3dde1682c636..8dabfc40fc970 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -65,11 +65,10 @@ resolveOutputSelectionSet :: ( MonadError QErr m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => ObjTyInfo - -> G.NamedType + => G.NamedType -> SelSet -> m [(Text, OutputFieldResolved)] -resolveOutputSelectionSet objTyInfo ty selSet = +resolveOutputSelectionSet ty selSet = withSelSet selSet $ \fld -> case _fName fld of "__typename" -> return $ OutputFieldTypename ty G.Name t -> return $ OutputFieldSimple t @@ -87,7 +86,7 @@ resolveResponseSelectionSet ty selSet = "output" -> ResponseFieldOutput <$> - resolveOutputSelectionSet undefined (_fType fld) (_fSelSet fld) + resolveOutputSelectionSet (_fType fld) (_fSelSet fld) -- the metadata columns "id" -> return $ mkMetadataField "id" @@ -229,7 +228,7 @@ resolveActionInsertSync -> UserVars -> m RespTx resolveActionInsertSync field executionContext sessionVariables = do - inputArgs <- withArg (_fArguments field) "input" (return . annInpValueToJson) + let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field manager <- asks getter webhookRes <- callWebhook manager inputArgs case returnStrategy of @@ -315,8 +314,7 @@ resolveActionInsertAsync resolveActionInsertAsync field actionFilter sessionVariables = do responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ _fSelSet field - - inputArgs <- withArg (_fArguments field) "input" (return . annInpValueToJson) + let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field -- resolvedPresetFields <- resolvePresetFields diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index a89fdc9776771..86b2549a9cd3b 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -78,20 +78,16 @@ mkMutationField actionName actionInfo permission definitionList = description = G.Description $ "perform the action: " <>> actionName - inputType = _adInputType definition - fieldInfo = mkHsraObjFldInfo (Just description) (unActionName actionName) - (mapFromL _iviName [inputArgument]) $ + (mapFromL _iviName $ map mkActionArgument $ _adArguments definition) $ actionFieldResponseType actionName definition - inputArgument = - InpValInfo (Just inputDescription) "input" Nothing $ - unGraphQLType inputType - where - inputDescription = G.Description $ "input for action: " <>> actionName + mkActionArgument argument = + InpValInfo (_argDescription argument) (unArgumentName $ _argName argument) + Nothing $ unGraphQLType $ _argType argument actionFieldResponseType :: ActionName -> ActionDefinition a -> G.GType actionFieldResponseType actionName definition = diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index ca19e8be37350..628debf6e30ff 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -21,6 +21,7 @@ module Hasura.RQL.DDL.Action ) where import Hasura.EncJSON +import Hasura.GraphQL.Context (defaultTypes) import Hasura.GraphQL.Utils import Hasura.Prelude import Hasura.RQL.Types @@ -103,17 +104,18 @@ buildActionInfo :: (QErrM m, CacheRM m) => CreateAction -> m ActionInfo buildActionInfo q = do - let inputBaseType = G.getBaseType $ unGraphQLType $ _adInputType actionDefinition - responseType = unGraphQLType $ _adOutputType actionDefinition + let responseType = unGraphQLType $ _adOutputType actionDefinition responseBaseType = G.getBaseType responseType - inputTypeInfo <- getNonObjectTypeInfo inputBaseType - case inputTypeInfo of - VT.TIScalar _ -> return () - VT.TIEnum _ -> return () - VT.TIInpObj _ -> return () - _ -> throw400 InvalidParams $ "the input type: " - <> showNamedTy inputBaseType <> - " should be a scalar/enum/input_object" + forM (_adArguments actionDefinition) $ \argument -> do + let argumentBaseType = G.getBaseType $ unGraphQLType $ _argType argument + argTypeInfo <- getNonObjectTypeInfo argumentBaseType + case argTypeInfo of + VT.TIScalar _ -> return () + VT.TIEnum _ -> return () + VT.TIInpObj _ -> return () + _ -> throw400 InvalidParams $ "the argument's base type: " + <> showNamedTy argumentBaseType <> + " should be a scalar/enum/input_object" when (hasList responseType) $ throw400 InvalidParams $ "the output type: " <> G.showGT responseType <> " cannot be a list" @@ -131,10 +133,12 @@ buildActionInfo q = do (fmap ResolvedWebhook actionDefinition) mempty where getNonObjectTypeInfo typeName = do - customTypes <- (unNonObjectTypeMap . fst . scCustomTypes) <$> askSchemaCache - onNothing (Map.lookup typeName customTypes) $ + nonObjectTypeMap <- (unNonObjectTypeMap . fst . scCustomTypes) <$> askSchemaCache + let inputTypeInfos = nonObjectTypeMap <> VT.mapFromL VT.getNamedTy defaultTypes + onNothing (Map.lookup typeName inputTypeInfos) $ throw400 NotExists $ "the type: " <> showNamedTy typeName <> " is not defined in custom types" + getObjectTypeInfo typeName = do customTypes <- (snd . scCustomTypes) <$> askSchemaCache onNothing (Map.lookup (ObjectTypeName typeName) customTypes) $ diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index 22419292df1b8..d58da024814cf 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -1,7 +1,8 @@ module Hasura.RQL.Types.Action - ( ActionInfo(..) - , ActionName(..) + ( ArgumentName(..) + , ArgumentDefinition(..) + , ActionName(..) , ActionKind(..) , ActionDefinition(..) , getActionKind @@ -11,6 +12,7 @@ module Hasura.RQL.Types.Action , ResolvedWebhook(..) , ResolvedActionDefinition + , ActionInfo(..) , ActionPermissionInfo(..) , ActionPermissionMap @@ -60,9 +62,22 @@ $(J.deriveJSON J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 6} ''ActionKind) +newtype ArgumentName + = ArgumentName { unArgumentName :: G.Name } + deriving ( Show, Eq, J.FromJSON, J.ToJSON, J.FromJSONKey, J.ToJSONKey + , Hashable, DQuote, Lift) + +data ArgumentDefinition + = ArgumentDefinition + { _argName :: !ArgumentName + , _argType :: !GraphQLType + , _argDescription :: !(Maybe G.Description) + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ArgumentDefinition) + data ActionDefinition a = ActionDefinition - { _adInputType :: !GraphQLType + { _adArguments :: ![ArgumentDefinition] , _adOutputType :: !GraphQLType , _adKind :: !(Maybe ActionKind) , _adWebhook :: !a @@ -102,9 +117,9 @@ type ActionPermissionMap data ActionInfo = ActionInfo - { _aiName :: !ActionName - , _aiDefintion :: !ResolvedActionDefinition - , _aiPermissions :: !ActionPermissionMap + { _aiName :: !ActionName + , _aiDefintion :: !ResolvedActionDefinition + , _aiPermissions :: !ActionPermissionMap } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionInfo) From ea0f8f7029d99484b6f9c592690471a389f431ce Mon Sep 17 00:00:00 2001 From: Aravind Shankar Date: Thu, 24 Oct 2019 15:43:24 +0530 Subject: [PATCH 15/62] fix blacklist check on check_build_worthiness job --- .ciignore | 10 ---------- .circleci/ciignore.sh | 26 +++----------------------- 2 files changed, 3 insertions(+), 33 deletions(-) delete mode 100644 .ciignore diff --git a/.ciignore b/.ciignore deleted file mode 100644 index 0b361fa978722..0000000000000 --- a/.ciignore +++ /dev/null @@ -1,10 +0,0 @@ -*.md -LICENSE -scripts/* -assets/* -docs/* -community/* -install-manifests/* -.ciignore -.gitignore -.github/* diff --git a/.circleci/ciignore.sh b/.circleci/ciignore.sh index 260ac9ea6231d..314a2b275fecd 100755 --- a/.circleci/ciignore.sh +++ b/.circleci/ciignore.sh @@ -25,11 +25,6 @@ if [[ "$CIRCLE_BRANCH" = "release-"* ]]; then exit fi -if [[ ! -a "$ROOT/.ciignore" ]]; then - echo "Skipping check since .ciignore is not found" - exit # If .ciignore doesn't exists, just quit this script -fi - # get the diff if [[ ! -z "$CIRCLE_COMPARE_URL" ]]; then # CIRCLE_COMPARE_URL is not empty, use it to get the diff @@ -39,36 +34,21 @@ if [[ ! -z "$CIRCLE_COMPARE_URL" ]]; then COMMIT_RANGE=$(echo $CIRCLE_COMPARE_URL | sed 's:^.*/compare/::g') fi echo "Diff: $COMMIT_RANGE" - changes="$(git diff $COMMIT_RANGE --name-only)" + changes="$(git diff $COMMIT_RANGE --name-only -- . ':!scripts' ':!assets' ':!docs' ':!community' ':!install-manifests' ':!github' ':!*.md' ':!.ciignore' ':!.gitignore' ':!LICENSE')" elif [[ "$CIRCLE_BRANCH" == "master" ]]; then # CIRCLE_COMPARE_URL is not set, but branch is master, diff with last commit echo "Diff: HEAD~1" - changes="$(git diff HEAD~1 --name-only)" + changes="$(git diff HEAD~1 --name-only -- . ':!scripts' ':!assets' ':!docs' ':!community' ':!install-manifests' ':!github' ':!*.md' ':!.ciignore' ':!.gitignore' ':!LICENSE')" else # CIRCLE_COMPARE_URL is not set, branch is not master, diff with origin/master echo "Diff: origin/master..HEAD" - changes="$(git diff-tree --no-commit-id --name-only -r origin/master..HEAD)" + changes="$(git diff-tree --no-commit-id --name-only -r origin/master..HEAD -- . ':!scripts' ':!assets' ':!docs' ':!community' ':!install-manifests' ':!github' ':!*.md' ':!.ciignore' ':!.gitignore' ':!LICENSE')" fi echo "Changes in this build:" echo $changes echo -# Load the patterns we want to skip into an array -mapfile -t blacklist < "$ROOT/.ciignore" - -for i in "${blacklist[@]}" -do - # Remove the current pattern from the list of changes - changes=( ${changes[@]/$i/} ) - - if [[ ${#changes[@]} -eq 0 ]]; then - # If we've exhausted the list of changes before we've finished going - # through patterns, that's okay, just quit the loop - break - fi -done - if [[ ${#changes[@]} -gt 0 ]]; then # If there's still changes left, then we have stuff to build, leave the commit alone. echo "Files that are not ignored present in commits, need to build, succeed the job" From a40b68e7545063ebf07d130fa040b0034797d288 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Thu, 24 Oct 2019 17:06:21 +0530 Subject: [PATCH 16/62] track custom_types and actions related tables --- server/src-lib/Hasura/RQL/DDL/CustomTypes.hs | 4 +-- server/src-lib/Hasura/RQL/DDL/Metadata.hs | 4 +-- server/src-rsr/catalog_metadata.sql | 2 +- server/src-rsr/hdb_metadata.yaml | 34 ++++++++++++++++++++ server/src-rsr/initialise.sql | 6 ++-- server/src-rsr/migrations/25_to_26.sql | 6 ++-- 6 files changed, 45 insertions(+), 11 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs index f991912bdd06f..3a67c1849f5f6 100644 --- a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs @@ -230,7 +230,7 @@ persistCustomTypes :: CustomTypes -> Q.TxE QErr () persistCustomTypes customTypes = do clearCustomTypes Q.unitQE defaultTxErrorHandler [Q.sql| - INSERT into hdb_catalog.hdb_custom_graphql_types + INSERT into hdb_catalog.hdb_custom_types (custom_types) VALUES ($1) |] (Identity $ Q.AltJ customTypes) False @@ -238,7 +238,7 @@ persistCustomTypes customTypes = do clearCustomTypes :: Q.TxE QErr () clearCustomTypes = do Q.unitQE defaultTxErrorHandler [Q.sql| - DELETE FROM hdb_catalog.hdb_custom_graphql_types + DELETE FROM hdb_catalog.hdb_custom_types |] () False validateCustomTypesAndAddToCache diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index bd53ab688e9c6..bc07cbe17145a 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -135,7 +135,7 @@ clearMetadata = Q.catchE defaultTxErrorHandler $ do Q.unitQ "DELETE FROM hdb_catalog.remote_schemas" () False Q.unitQ "DELETE FROM hdb_catalog.hdb_allowlist" () False Q.unitQ "DELETE FROM hdb_catalog.hdb_query_collection WHERE is_system_defined <> 'true'" () False - Q.unitQ "DELETE FROM hdb_catalog.hdb_custom_graphql_types" () False + Q.unitQ "DELETE FROM hdb_catalog.hdb_custom_types" () False Q.unitQ "DELETE FROM hdb_catalog.hdb_action_permission" () False Q.unitQ "DELETE FROM hdb_catalog.hdb_action WHERE is_system_defined <> 'true'" () False @@ -492,7 +492,7 @@ fetchMetadata = do fetchCustomTypes = fmap (Q.getAltJ . runIdentity) <$> Q.rawQE defaultTxErrorHandler [Q.sql| - select custom_types::json from hdb_catalog.hdb_custom_graphql_types + select custom_types::json from hdb_catalog.hdb_custom_types |] [] False fetchActions = Q.getAltJ . runIdentity . Q.getRow <$> Q.rawQE defaultTxErrorHandler [Q.sql| diff --git a/server/src-rsr/catalog_metadata.sql b/server/src-rsr/catalog_metadata.sql index e35eef826333a..678b45fa249a0 100644 --- a/server/src-rsr/catalog_metadata.sql +++ b/server/src-rsr/catalog_metadata.sql @@ -8,7 +8,7 @@ select 'functions', functions.items, 'foreign_keys', foreign_keys.items, 'allowlist_collections', allowlist.item, - 'custom_types', coalesce((select custom_types from hdb_catalog.hdb_custom_graphql_types), '{}'), + 'custom_types', coalesce((select custom_types from hdb_catalog.hdb_custom_types), '{}'), 'actions', actions.items, 'action_permissions', action_permissions.items ) diff --git a/server/src-rsr/hdb_metadata.yaml b/server/src-rsr/hdb_metadata.yaml index fe1146bcadb8b..6ac5bdf98d017 100644 --- a/server/src-rsr/hdb_metadata.yaml +++ b/server/src-rsr/hdb_metadata.yaml @@ -284,3 +284,37 @@ args: args: name: hdb_allowlist schema: hdb_catalog + +- type: track_table + args: + name: hdb_custom_types + schema: hdb_catalog + +- type: track_table + args: + name: hdb_action + schema: hdb_catalog + +- type: track_table + args: + name: hdb_action_permission + schema: hdb_catalog + +- type: create_array_relationship + args: + name: permissions + table: + schema: hdb_catalog + name: hdb_action + using: + manual_configuration: + remote_table: + schema: hdb_catalog + name: hdb_action_permission + column_mapping: + action_name : action_name + +- type: track_table + args: + name: hdb_action_log + schema: hdb_catalog diff --git a/server/src-rsr/initialise.sql b/server/src-rsr/initialise.sql index f569e012f9a69..d797774b2fa23 100644 --- a/server/src-rsr/initialise.sql +++ b/server/src-rsr/initialise.sql @@ -655,19 +655,19 @@ CREATE TABLE hdb_catalog.hdb_action_log id UUID PRIMARY KEY DEFAULT gen_random_uuid(), -- we deliberately do not reference the action name -- because sometimes we may want to retain history - -- when after dropping the action + -- after dropping the action action_name TEXT, input_payload JSONB NOT NULL, session_variables JSONB NOT NULL, response_payload JSONB NULL, - + errors JSONB NULL, created_at timestamptz NOT NULL default now(), response_received_at timestamptz NULL, status text NOT NULL, CHECK (status IN ('created', 'processing', 'completed', 'error')) ); -CREATE TABLE hdb_catalog.hdb_custom_graphql_types +CREATE TABLE hdb_catalog.hdb_custom_types ( custom_types jsonb NOT NULL ); diff --git a/server/src-rsr/migrations/25_to_26.sql b/server/src-rsr/migrations/25_to_26.sql index 81511b93f2291..680fb87d94309 100644 --- a/server/src-rsr/migrations/25_to_26.sql +++ b/server/src-rsr/migrations/25_to_26.sql @@ -22,19 +22,19 @@ CREATE TABLE hdb_catalog.hdb_action_log id UUID PRIMARY KEY DEFAULT gen_random_uuid(), -- we deliberately do not reference the action name -- because sometimes we may want to retain history - -- when after dropping the action + -- after dropping the action action_name TEXT, input_payload JSONB NOT NULL, session_variables JSONB NOT NULL, response_payload JSONB NULL, - + errors JSONB NULL, created_at timestamptz NOT NULL default now(), response_received_at timestamptz NULL, status text NOT NULL, CHECK (status IN ('created', 'processing', 'completed', 'error')) ); -CREATE TABLE hdb_catalog.hdb_custom_graphql_types +CREATE TABLE hdb_catalog.hdb_custom_types ( custom_types jsonb NOT NULL ); From c33372a8766aa11c6e1501d0f264486be2de19bb Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Thu, 24 Oct 2019 20:23:34 +0530 Subject: [PATCH 17/62] handlers are now triggered on async actions --- server/src-exec/Main.hs | 66 +++---- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 167 ++++++++++++++---- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 13 +- server/src-lib/Hasura/RQL/Types/Action.hs | 2 +- 4 files changed, 182 insertions(+), 66 deletions(-) diff --git a/server/src-exec/Main.hs b/server/src-exec/Main.hs index dfcde6dff5e51..642ef3a880f49 100644 --- a/server/src-exec/Main.hs +++ b/server/src-exec/Main.hs @@ -1,49 +1,52 @@ module Main where -import Migrate (migrateCatalog) +import Migrate (migrateCatalog) import Ops -import Control.Monad.STM (atomically) -import Data.Time.Clock (getCurrentTime) +import Control.Monad.STM (atomically) +import Data.Time.Clock (getCurrentTime) import Options.Applicative -import System.Environment (getEnvironment, lookupEnv) -import System.Exit (exitFailure) - - -import qualified Control.Concurrent as C -import qualified Data.Aeson as A -import qualified Data.ByteString.Char8 as BC -import qualified Data.ByteString.Lazy as BL -import qualified Data.ByteString.Lazy.Char8 as BLC -import qualified Data.Text as T -import qualified Data.Time.Clock as Clock -import qualified Data.Yaml as Y -import qualified Network.HTTP.Client as HTTP -import qualified Network.HTTP.Client.TLS as HTTP -import qualified Network.Wai.Handler.Warp as Warp -import qualified System.Posix.Signals as Signals +import System.Environment (getEnvironment, lookupEnv) +import System.Exit (exitFailure) + + +import qualified Control.Concurrent as C +import qualified Data.Aeson as A +import qualified Data.ByteString.Char8 as BC +import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Lazy.Char8 as BLC +import qualified Data.Text as T +import qualified Data.Time.Clock as Clock +import qualified Data.Yaml as Y +import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Client.TLS as HTTP +import qualified Network.Wai.Handler.Warp as Warp +import qualified System.Posix.Signals as Signals import Hasura.Db import Hasura.Events.Lib +import Hasura.GraphQL.Resolve.Action (asyncActionsProcessor) import Hasura.Logging import Hasura.Prelude -import Hasura.RQL.DDL.Metadata (fetchMetadata) -import Hasura.RQL.Types (SQLGenCtx (..), SchemaCache (..), - SystemDefined (..), adminUserInfo, - emptySchemaCache) -import Hasura.Server.App (HasuraApp (..), - SchemaCacheRef (..), getSCFromRef, - logInconsObjs, mkWaiApp) +import Hasura.RQL.DDL.Metadata (fetchMetadata) +import Hasura.RQL.Types (SQLGenCtx (..), + SchemaCache (..), + SystemDefined (..), + adminUserInfo, emptySchemaCache) +import Hasura.Server.App (HasuraApp (..), + SchemaCacheRef (..), + getSCFromRef, logInconsObjs, + mkWaiApp) import Hasura.Server.Auth -import Hasura.Server.CheckUpdates (checkForUpdates) +import Hasura.Server.CheckUpdates (checkForUpdates) import Hasura.Server.Init import Hasura.Server.Logging -import Hasura.Server.Query (RunCtx (..), peelRun) +import Hasura.Server.Query (RunCtx (..), peelRun) import Hasura.Server.SchemaUpdate import Hasura.Server.Telemetry -import Hasura.Server.Version (currentVersion) +import Hasura.Server.Version (currentVersion) -import qualified Database.PG.Query as Q +import qualified Database.PG.Query as Q printErrExit :: forall a . String -> IO a printErrExit = (>> exitFailure) . putStrLn @@ -183,6 +186,9 @@ main = do void $ C.forkIO $ processEventQueue hloggerCtx logEnvHeaders httpManager pool scRef eventEngineCtx + void $ C.forkIO $ asyncActionsProcessor (_scrCache cacheRef) + pool httpManager + -- start a background thread to check for updates void $ C.forkIO $ checkForUpdates loggerCtx httpManager diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 8dabfc40fc970..53c7a66bbb8c3 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -1,6 +1,7 @@ module Hasura.GraphQL.Resolve.Action ( resolveActionSelect , resolveActionInsert + , asyncActionsProcessor -- , resolveResponseSelectionSet , ActionSelect(..) @@ -10,10 +11,13 @@ module Hasura.GraphQL.Resolve.Action import Hasura.Prelude +import Control.Concurrent (threadDelay) import Control.Exception (try) import Control.Lens import Data.Has +import Data.IORef +import qualified Control.Concurrent.Async as A import qualified Data.Aeson as J import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J @@ -25,8 +29,8 @@ import qualified Language.GraphQL.Draft.Syntax as G import qualified Network.HTTP.Client as HTTP import qualified Network.Wreq as Wreq -import qualified Hasura.RQL.DML.Select as RS import qualified Hasura.GraphQL.Resolve.Select as GRS +import qualified Hasura.RQL.DML.Select as RS import qualified Hasura.SQL.DML as S import Hasura.EncJSON @@ -36,7 +40,6 @@ import Hasura.GraphQL.Resolve.Select (processTableSelectionSet) import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types import Hasura.HTTP -import Hasura.RQL.DML.Internal (dmlTxErrorHandler) import Hasura.RQL.DML.Select (asSingleRowJsonResp) import Hasura.RQL.Types import Hasura.SQL.Types @@ -92,6 +95,7 @@ resolveResponseSelectionSet ty selSet = "id" -> return $ mkMetadataField "id" "created_at" -> return $ mkMetadataField "created_at" "status" -> return $ mkMetadataField "status" + "errors" -> return $ mkMetadataField "errors" G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t @@ -229,8 +233,9 @@ resolveActionInsertSync -> m RespTx resolveActionInsertSync field executionContext sessionVariables = do let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field + handlerPayload = ActionWebhookPayload sessionVariables inputArgs manager <- asks getter - webhookRes <- callWebhook manager inputArgs + webhookRes <- callWebhook manager resolvedWebhook handlerPayload case returnStrategy of ReturnJson -> return $ return $ encJFromJValue webhookRes ExecOnPostgres definitionList -> do @@ -256,33 +261,135 @@ resolveActionInsertSync field executionContext sessionVariables = do resolvedWebhook = _saecWebhook executionContext returnStrategy = _saecStrategy executionContext - callWebhook manager actionInput = do - let options = wreqOptions manager [contentType] - contentType = ("Content-Type", "application/json") - postPayload = J.toJSON $ ActionWebhookPayload - sessionVariables actionInput - url = (T.unpack $ unResolvedWebhook resolvedWebhook) - httpResponse <- liftIO $ try $ try $ - Wreq.asJSON =<< Wreq.postWith options url postPayload - -- case (^. Wreq.responseBody) <$> httpResponse of - case httpResponse of - Left e -> - throw500WithDetail "http exception when calling webhook" $ - J.toJSON $ HttpException e - Right (Left (Wreq.JSONError e)) -> - throw500WithDetail "not a valid json response from webhook" $ - J.toJSON e - Right (Right responseWreq) -> - let response = responseWreq ^. Wreq.responseBody - in case (_awrData response, _awrErrors response) of - (Nothing, Nothing) -> - throw500WithDetail "internal error" $ - J.String "webhook response has neither 'data' nor 'errors'" - (Just _, Just _) -> - throw500WithDetail "internal error" $ - J.String "webhook response cannot have both 'data' and 'errors'" - (Just d, Nothing) -> return d - (Nothing, Just e) -> throwVE $ T.pack $ show e +callWebhook + :: (MonadIO m, MonadError QErr m) + => HTTP.Manager -> ResolvedWebhook -> ActionWebhookPayload -> m J.Value +callWebhook manager resolvedWebhook actionWebhookPayload = do + let options = wreqOptions manager [contentType] + contentType = ("Content-Type", "application/json") + postPayload = J.toJSON actionWebhookPayload + url = (T.unpack $ unResolvedWebhook resolvedWebhook) + httpResponse <- liftIO $ try $ try $ + Wreq.asJSON =<< Wreq.postWith options url postPayload + case httpResponse of + Left e -> + throw500WithDetail "http exception when calling webhook" $ + J.toJSON $ HttpException e + Right (Left (Wreq.JSONError e)) -> + throw500WithDetail "not a valid json response from webhook" $ + J.toJSON e + Right (Right responseWreq) -> + let response = responseWreq ^. Wreq.responseBody + in case (_awrData response, _awrErrors response) of + (Nothing, Nothing) -> + throw500WithDetail "internal error" $ + J.String "webhook response has neither 'data' nor 'errors'" + (Just _, Just _) -> + throw500WithDetail "internal error" $ + J.String "webhook response cannot have both 'data' and 'errors'" + (Just d, Nothing) -> return d + (Nothing, Just e) -> throwVE $ T.pack $ show e + +data ActionLogItem + = ActionLogItem + { _aliId :: !UUID.UUID + , _aliActionName :: !ActionName + , _aliSessionVariables :: !UserVars + , _aliInputPayload :: !J.Value + } deriving (Show, Eq) + +asyncActionsProcessor + :: IORef (SchemaCache, SchemaCacheVer) + -> Q.PGPool + -> HTTP.Manager + -> IO () +asyncActionsProcessor cacheRef pgPool httpManager = forever $ do + asyncInvocations <- getUndeliveredEvents + actionCache <- scActions . fst <$> readIORef cacheRef + A.mapConcurrently_ (callHandler actionCache) asyncInvocations + threadDelay (1 * 1000 * 1000) + where + getActionWebhook actionCache actionName = + _adWebhook . _aiDefinition <$> Map.lookup actionName actionCache + + runTx :: (Monoid a) => Q.TxE QErr a -> IO a + runTx q = do + res <- runExceptT $ Q.runTx' pgPool q + either mempty return res + + callHandler :: ActionCache -> ActionLogItem -> IO () + callHandler actionCache actionLogItem = do + let ActionLogItem actionId actionName + sessionVariables inputPayload = actionLogItem + case getActionWebhook actionCache actionName of + Nothing -> return () + Just webhookUrl -> do + res <- runExceptT $ callWebhook httpManager webhookUrl $ + ActionWebhookPayload sessionVariables inputPayload + case res of + Left e -> setError actionId e + Right responsePayload -> setCompleted actionId responsePayload + + setError :: UUID.UUID -> QErr -> IO () + setError actionId e = + runTx $ setErrorQuery actionId e + + setErrorQuery + :: UUID.UUID -> QErr -> Q.TxE QErr () + setErrorQuery actionId e = + Q.unitQE defaultTxErrorHandler [Q.sql| + update hdb_catalog.hdb_action_log + set errors = $1, status = 'error' + where id = $2 + |] (Q.AltJ e, actionId) False + + setCompleted :: UUID.UUID -> J.Value -> IO () + setCompleted actionId responsePayload = + runTx $ setCompletedQuery actionId responsePayload + + setCompletedQuery + :: UUID.UUID -> J.Value -> Q.TxE QErr () + setCompletedQuery actionId responsePayload = + Q.unitQE defaultTxErrorHandler [Q.sql| + update hdb_catalog.hdb_action_log + set response_payload = $1, status = 'completed' + where id = $2 + |] (Q.AltJ responsePayload, actionId) False + + undeliveredEventsQuery + :: Q.TxE QErr [ActionLogItem] + undeliveredEventsQuery = + map mapEvent <$> Q.listQE defaultTxErrorHandler [Q.sql| + update hdb_catalog.hdb_action_log set status = 'processing' + where + id in ( + select id from hdb_catalog.hdb_action_log + where status = 'created' + for update skip locked limit 10 + ) + returning + id, action_name, session_variables::json, input_payload::json + |] () False + where + mapEvent (actionId, actionName, + Q.AltJ sessionVariables, Q.AltJ inputPayload) = + ActionLogItem actionId actionName sessionVariables inputPayload + + getUndeliveredEvents = runTx undeliveredEventsQuery + + -- map uncurryEvent <$> + -- Q.listQE defaultTxErrorHandler [Q.sql| + -- update hdb_catalog.hdb_action_log set status = 'processing' + -- where + -- id in ( + -- select id from hdb_catalog.hdb_action_log + -- where status = 'created' + -- for update skip locked limit 10 + -- ) returning action_name, session_variables, input_payload + -- |] + + + resolveActionInsert :: ( MonadError QErr m, MonadReader r m, Has FieldMap r diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 86b2549a9cd3b..14be1c5ca5f3f 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -47,6 +47,8 @@ mkActionResponseTypeInfo actionName outputType = , G.toGT $ mkScalarTy PGUUID) , ( "created_at", "the time at which this action was created" , G.toGT $ mkScalarTy PGTimeStampTZ) + , ( "errors", "errors related to the invocation" + , G.toGT $ mkScalarTy PGJSON) -- , ( "status", "the status of this action, whether it is processed, etc." -- , G.toGT $ G.NamedType "action_status") , ( "output", "the output fields of this action" @@ -64,7 +66,7 @@ mkMutationField actionName actionInfo permission definitionList = , fieldInfo ) where - definition = _aiDefintion actionInfo + definition = _aiDefinition actionInfo actionExecutionContext = case getActionKind definition of ActionSynchronous -> @@ -144,7 +146,7 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = ) where actionName = _aiName actionInfo - definition = _aiDefintion actionInfo + definition = _aiDefinition actionInfo roleName = _apiRole permission mkPGFieldType (fieldType, fieldTypeInfo) = case (G.isListType fieldType, fieldTypeInfo) of @@ -208,7 +210,7 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = getSelectPermissionInfoM remoteTableInfo roleName return (spiFilter selectPermisisonInfo, spiLimit selectPermisisonInfo) actionOutputBaseType = - G.getBaseType $ unGraphQLType $ _adOutputType $ _aiDefintion actionInfo + G.getBaseType $ unGraphQLType $ _adOutputType $ _aiDefinition actionInfo mkActionSchemaOne :: (QErrM m) @@ -234,7 +236,7 @@ mkActionSchemaOne annotatedObjects actionInfo = do adminPermission = ActionPermissionInfo adminRole annBoolExpTrue permissions = Map.insert adminRole adminPermission $ _aiPermissions actionInfo actionOutputBaseType = - G.getBaseType $ unGraphQLType $ _adOutputType $ _aiDefintion actionInfo + G.getBaseType $ unGraphQLType $ _adOutputType $ _aiDefinition actionInfo mkActionsSchema :: (QErrM m) @@ -250,7 +252,8 @@ mkActionsSchema annotatedObjects = mempty where -- we'll need to add uuid and timestamptz for actions - newRoleState = (mempty, addScalarToTyAgg PGTimeStampTZ $ + newRoleState = (mempty, addScalarToTyAgg PGJSON $ + addScalarToTyAgg PGTimeStampTZ $ addScalarToTyAgg PGUUID mempty) f roleName (queryFieldM, mutationField, fields) = Map.alter (Just . addToState . fromMaybe newRoleState) roleName diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index d58da024814cf..aa52daad22b2c 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -118,7 +118,7 @@ type ActionPermissionMap data ActionInfo = ActionInfo { _aiName :: !ActionName - , _aiDefintion :: !ResolvedActionDefinition + , _aiDefinition :: !ResolvedActionDefinition , _aiPermissions :: !ActionPermissionMap } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionInfo) From 1ba45d1f637d796bfd2fb18e4e7df01e3a19930d Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Wed, 30 Oct 2019 18:40:04 +0530 Subject: [PATCH 18/62] clean up annotated relationship related code --- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 12 +++---- .../Hasura/GraphQL/Schema/CustomTypes.hs | 21 +++++------ server/src-lib/Hasura/RQL/DDL/CustomTypes.hs | 8 ++--- .../src-lib/Hasura/RQL/Types/CustomTypes.hs | 36 +++++++++---------- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 3 +- 5 files changed, 40 insertions(+), 40 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 14be1c5ca5f3f..c2778d59e72be 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -2,15 +2,14 @@ module Hasura.GraphQL.Schema.Action ( mkActionsSchema ) where -import qualified Data.HashMap.Strict as Map -import qualified Language.GraphQL.Draft.Syntax as G +import qualified Data.HashMap.Strict as Map +import qualified Language.GraphQL.Draft.Syntax as G -import Data.Coerce (coerce) +import Data.Coerce (coerce) import Hasura.GraphQL.Schema.Builder import Hasura.GraphQL.Resolve.Types -import Hasura.GraphQL.Schema.CustomTypes import Hasura.GraphQL.Validate.Types import Hasura.Prelude import Hasura.RQL.Types @@ -179,13 +178,12 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = relationships = flip map (Map.toList $ _aotRelationships annotatedOutputType) $ \(relationshipName, relationship) -> - let remoteTableInfo = _arRemoteTableInfo relationship + let remoteTableInfo = _orRemoteTable relationship remoteTable = _tiName remoteTableInfo filterAndLimitM = getFilterAndLimit remoteTableInfo columnMapping = [ (PGCol $ coerce k, v) - | (k, v) <- Map.toList $ - _ordFieldMapping $ _arDefinition relationship + | (k, v) <- Map.toList $ _orFieldMapping relationship ] in case filterAndLimitM of Just (tableFilter, tableLimit) -> diff --git a/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs b/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs index 4ac62b7026f08..6188bf2ea2962 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs @@ -1,9 +1,10 @@ module Hasura.GraphQL.Schema.CustomTypes - ( AnnotatedRelationship(..) - , buildCustomTypesSchemaPartial + ( buildCustomTypesSchemaPartial , buildCustomTypesSchema ) where +import Control.Lens + import qualified Data.HashMap.Strict as Map import qualified Language.GraphQL.Draft.Syntax as G @@ -28,18 +29,18 @@ buildObjectTypeInfo roleName annotatedObjectType = relationships = flip map (toList $ _aotRelationships annotatedObjectType) $ - \(AnnotatedRelationship definition remoteTableInfo) -> + \(ObjectRelationship name remoteTableInfo _) -> if isJust (getSelectPermissionInfoM remoteTableInfo roleName) || roleName == adminRole - then Just (relationshipToFieldInfo definition) + then Just (relationshipToFieldInfo name $ _tiName remoteTableInfo) else Nothing where - relationshipToFieldInfo relationship = + relationshipToFieldInfo name remoteTableName = VT.ObjFldInfo { VT._fiDesc = Nothing -- TODO - , VT._fiName = unObjectRelationshipName $ _ordName relationship + , VT._fiName = unObjectRelationshipName name , VT._fiParams = mempty - , VT._fiTy = G.toGT $ mkTableTy $ _ordRemoteTable relationship + , VT._fiTy = G.toGT $ mkTableTy remoteTableName , VT._fiLoc = VT.TLCustom } @@ -81,13 +82,13 @@ annotateObjectType nonObjectTypeMap objectDefinition = do annotatedRelationships <- fmap Map.fromList $ forM relationships $ \relationship -> do - let relationshipName = _ordName relationship - remoteTable = _ordRemoteTable relationship + let relationshipName = _orName relationship + remoteTable = _orRemoteTable relationship remoteTableInfoM <- askTabInfoM remoteTable remoteTableInfo <- onNothing remoteTableInfoM $ throw500 $ "missing table info for: " <>> remoteTable return ( relationshipName - , AnnotatedRelationship relationship remoteTableInfo) + , relationship & orRemoteTable .~ remoteTableInfo) return $ AnnotatedObjectType objectDefinition annotatedFields annotatedRelationships where diff --git a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs index 3a67c1849f5f6..841de22b33ba0 100644 --- a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs @@ -99,7 +99,7 @@ validateCustomTypeDefinitions customTypes = do fieldNames = map (unObjectFieldName . _ofdName) $ toList (_otdFields objectDefinition) relationships = fromMaybe [] $ _otdRelationships objectDefinition - relNames = map (unObjectRelationshipName . _ordName) relationships + relNames = map (unObjectRelationshipName . _orName) relationships duplicateFieldNames = L.duplicates $ fieldNames <> relNames fields = toList $ _otdFields objectDefinition @@ -138,9 +138,9 @@ validateCustomTypeDefinitions customTypes = do else pure Nothing for_ relationships $ \relationshipField -> do - let relationshipName = _ordName relationshipField - remoteTable = _ordRemoteTable relationshipField - fieldMapping = _ordFieldMapping relationshipField + let relationshipName = _orName relationshipField + remoteTable = _orRemoteTable relationshipField + fieldMapping = _orFieldMapping relationshipField --check that the table exists remoteTableInfoM <- askTabInfoM remoteTable diff --git a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs index 986033884e319..bb5d8a10b4311 100644 --- a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs @@ -12,7 +12,9 @@ module Hasura.RQL.Types.CustomTypes , ObjectFieldName(..) , ObjectFieldDefinition(..) , ObjectRelationshipName(..) - , ObjectRelationshipDefinition(..) + , ObjectRelationship(..) + , orName, orRemoteTable, orFieldMapping + , ObjectRelationshipDefinition , ObjectTypeName(..) , ObjectTypeDefinition(..) , CustomTypeName @@ -21,10 +23,11 @@ module Hasura.RQL.Types.CustomTypes , OutputFieldTypeInfo(..) , AnnotatedObjectType(..) , AnnotatedObjects - , AnnotatedRelationship(..) + , AnnotatedRelationship , NonObjectTypeMap(..) ) where +import Control.Lens.TH (makeLenses) import Language.Haskell.TH.Syntax (Lift) import qualified Data.Aeson as J @@ -109,13 +112,18 @@ newtype ObjectRelationshipName = ObjectRelationshipName { unObjectRelationshipName :: G.Name } deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) -data ObjectRelationshipDefinition - = ObjectRelationshipDefinition - { _ordName :: !ObjectRelationshipName - , _ordRemoteTable :: !QualifiedTable - , _ordFieldMapping :: !(Map.HashMap ObjectFieldName PGCol) +data ObjectRelationship t + = ObjectRelationship + { _orName :: !ObjectRelationshipName + , _orRemoteTable :: !t + , _orFieldMapping :: !(Map.HashMap ObjectFieldName PGCol) } deriving (Show, Eq, Lift) -$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectRelationshipDefinition) +$(makeLenses ''ObjectRelationship) + +type ObjectRelationshipDefinition = + ObjectRelationship QualifiedTable + +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectRelationship) newtype ObjectTypeName = ObjectTypeName { unObjectTypeName :: G.NamedType } @@ -180,22 +188,14 @@ data CustomTypes } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''CustomTypes) --- TODO: parameterise the ObjectRelationshipDefinition type --- instead of doing this -data AnnotatedRelationship - = AnnotatedRelationship - { _arDefinition :: !ObjectRelationshipDefinition - , _arRemoteTableInfo :: !(TableInfo PGColumnInfo) - } deriving (Show, Eq) +type AnnotatedRelationship = + ObjectRelationship (TableInfo PGColumnInfo) data OutputFieldTypeInfo = OutputFieldScalar !VT.ScalarTyInfo | OutputFieldEnum !VT.EnumTyInfo deriving (Show, Eq) --- instance ToJSON OutputFieldTypeInfo where --- toJSON = toJSON . show - data AnnotatedObjectType = AnnotatedObjectType { _aotDefinition :: !ObjectTypeDefinition diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 1b4eab81a2ded..f0a3f9e54ea87 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -19,7 +19,8 @@ module Hasura.RQL.Types.SchemaCache , OutputFieldTypeInfo(..) , AnnotatedObjectType(..) , AnnotatedObjects - , AnnotatedRelationship(..) + , ObjectRelationship(..) + , orName, orRemoteTable, orFieldMapping , NonObjectTypeMap(..) , TableInfo(..) , askTabInfoM From 25598377b2a36806366d71d102c588bf5077aabb Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Wed, 30 Oct 2019 19:39:36 +0530 Subject: [PATCH 19/62] default to pgjson unless a field is involved in relationships, for generating definition list --- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 25 +++++++++++++------ .../Hasura/GraphQL/Schema/CustomTypes.hs | 9 ++++++- .../src-lib/Hasura/RQL/Types/CustomTypes.hs | 10 ++++---- 3 files changed, 31 insertions(+), 13 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index c2778d59e72be..7efb846cd4e0e 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -147,17 +147,28 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = actionName = _aiName actionInfo definition = _aiDefinition actionInfo roleName = _apiRole permission - mkPGFieldType (fieldType, fieldTypeInfo) = + + -- all the possible field references + fieldReferences = + Map.unions $ map _orFieldMapping $ Map.elems $ + _aotRelationships annotatedOutputType + + mkPGFieldType fieldName (fieldType, fieldTypeInfo) = case (G.isListType fieldType, fieldTypeInfo) of -- for scalar lists, we treat them as json columns (True, _) -> PGJSON -- enums the same (False, OutputFieldEnum _) -> PGJSON - -- specific scalars - (False, OutputFieldScalar scalarTypeInfo) -> - namedTypeToPGScalar $ G.NamedType $ _stiName scalarTypeInfo + -- default to PGJSON unless you have to join with a postgres table + -- i.e, if this field is specified as part of some relationship's + -- mapping, we can cast this column's value as the remote column's type + (False, OutputFieldScalar _) -> + case Map.lookup fieldName fieldReferences of + Just columnInfo -> unsafePGColumnToRepresentation $ pgiType columnInfo + Nothing -> PGJSON + definitionList = - [ (coerce k, mkPGFieldType v) + [ (coerce k, mkPGFieldType k v) | (k, v) <- Map.toList $ _aotAnnotatedFields annotatedOutputType ] -- mkFieldMap annotatedOutputType = @@ -171,7 +182,7 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = , Left $ PGColumnInfo (PGCol $ coerce fieldName) (coerce fieldName) - (PGColumnScalar $ mkPGFieldType (fieldType, fieldTypeInfo)) + (PGColumnScalar $ mkPGFieldType fieldName (fieldType, fieldTypeInfo)) (G.isNullable fieldType) Nothing ) @@ -182,7 +193,7 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = remoteTable = _tiName remoteTableInfo filterAndLimitM = getFilterAndLimit remoteTableInfo columnMapping = - [ (PGCol $ coerce k, v) + [ (PGCol $ coerce k, pgiColumn v) | (k, v) <- Map.toList $ _orFieldMapping relationship ] in case filterAndLimitM of diff --git a/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs b/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs index 6188bf2ea2962..fc7e3f1458b12 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs @@ -87,8 +87,15 @@ annotateObjectType nonObjectTypeMap objectDefinition = do remoteTableInfoM <- askTabInfoM remoteTable remoteTableInfo <- onNothing remoteTableInfoM $ throw500 $ "missing table info for: " <>> remoteTable + annotatedFieldMapping <- + forM (_orFieldMapping relationship) $ \remoteTableColumn -> do + let fieldName = fromPGCol remoteTableColumn + onNothing (getPGColumnInfoM remoteTableInfo fieldName) $ + throw500 $ "missing column info of " <> fieldName + <<> " in table" <>> remoteTable return ( relationshipName - , relationship & orRemoteTable .~ remoteTableInfo) + , relationship & orRemoteTable .~ remoteTableInfo + & orFieldMapping .~ annotatedFieldMapping) return $ AnnotatedObjectType objectDefinition annotatedFields annotatedRelationships where diff --git a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs index bb5d8a10b4311..38335bc168fb7 100644 --- a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs @@ -112,18 +112,18 @@ newtype ObjectRelationshipName = ObjectRelationshipName { unObjectRelationshipName :: G.Name } deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift) -data ObjectRelationship t +data ObjectRelationship t f = ObjectRelationship { _orName :: !ObjectRelationshipName , _orRemoteTable :: !t - , _orFieldMapping :: !(Map.HashMap ObjectFieldName PGCol) + , _orFieldMapping :: !(Map.HashMap ObjectFieldName f) } deriving (Show, Eq, Lift) $(makeLenses ''ObjectRelationship) type ObjectRelationshipDefinition = - ObjectRelationship QualifiedTable + ObjectRelationship QualifiedTable PGCol -$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectRelationship) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ObjectRelationship) newtype ObjectTypeName = ObjectTypeName { unObjectTypeName :: G.NamedType } @@ -189,7 +189,7 @@ data CustomTypes $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''CustomTypes) type AnnotatedRelationship = - ObjectRelationship (TableInfo PGColumnInfo) + ObjectRelationship (TableInfo PGColumnInfo) PGColumnInfo data OutputFieldTypeInfo = OutputFieldScalar !VT.ScalarTyInfo From 1c9819abd45270b1d9bed2fac111b06488920da2 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Tue, 3 Dec 2019 23:08:11 +0530 Subject: [PATCH 20/62] temporary fix for async subscriptions --- server/src-lib/Hasura/GraphQL/Resolve.hs | 8 +- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 80 +++++++++++++++++-- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 9 ++- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 7 +- 4 files changed, 85 insertions(+), 19 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 6f73ff3a94ccc..fd78edac2c2ad 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -43,7 +43,7 @@ data QueryRootFldAST v | QRFAgg !(DS.AnnAggSelG v) | QRFFnSimple !(DS.AnnSimpleSelG v) | QRFFnAgg !(DS.AnnAggSelG v) - | QRFActionSelect !(RA.ActionSelect v) + | QRFActionSelect !(DS.AnnSimpleSelG v) deriving (Show, Eq) type QueryRootFldUnresolved = QueryRootFldAST UnresolvedVal @@ -60,7 +60,7 @@ traverseQueryRootFldAST f = \case QRFAgg s -> QRFAgg <$> DS.traverseAnnAggSel f s QRFFnSimple s -> QRFFnSimple <$> DS.traverseAnnSimpleSel f s QRFFnAgg s -> QRFFnAgg <$> DS.traverseAnnAggSel f s - QRFActionSelect s -> QRFActionSelect <$> RA.traverseActionSelect f s + QRFActionSelect s -> QRFActionSelect <$> DS.traverseAnnSimpleSel f s toPGQuery :: QueryRootFldResolved -> Q.Query toPGQuery = \case @@ -69,7 +69,7 @@ toPGQuery = \case QRFAgg s -> DS.selectAggQuerySQL s QRFFnSimple s -> DS.selectQuerySQL False s QRFFnAgg s -> DS.selectAggQuerySQL s - QRFActionSelect s -> RA.actionSelectToSql s + QRFActionSelect s -> DS.selectQuerySQL True s validateHdrs :: (Foldable t, QErrM m) => UserInfo -> t Text -> m () @@ -106,7 +106,7 @@ queryFldToPGAST fld = do validateHdrs userInfo (_fqocHeaders ctx) QRFFnAgg <$> RS.convertFuncQueryAgg ctx fld QCActionFetch ctx -> - QRFActionSelect <$> RA.resolveActionSelect ctx fld + QRFActionSelect <$> RA.resolveAsyncResponse ctx fld mutFldToTx :: ( MonadResolve m diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 53c7a66bbb8c3..c1a4269e7c5fb 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -2,6 +2,7 @@ module Hasura.GraphQL.Resolve.Action ( resolveActionSelect , resolveActionInsert , asyncActionsProcessor + , resolveAsyncResponse -- , resolveResponseSelectionSet , ActionSelect(..) @@ -102,6 +103,7 @@ resolveResponseSelectionSet ty selSet = where mkMetadataField = ResponseFieldMetadata . PGCol + data ActionSelect v = ActionSelect { _asId :: !v @@ -239,28 +241,27 @@ resolveActionInsertSync field executionContext sessionVariables = do case returnStrategy of ReturnJson -> return $ return $ encJFromJValue webhookRes ExecOnPostgres definitionList -> do + let webhookResponseExpression = + toTxtValue $ WithScalarType PGJSON $ PGValJSON $ Q.JSON webhookRes selectAstUnresolved <- processOutputSelectionSet - (mkSyncFromExpression definitionList webhookRes) + (mkJsonToRecordFromExpression definitionList webhookResponseExpression) (_fType field) $ _fSelSet field astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] - where + resolvedWebhook = _saecWebhook executionContext + returnStrategy = _saecStrategy executionContext - mkSyncFromExpression definitionList webhookData = + mkJsonToRecordFromExpression definitionList webhookResponseExpression = let functionName = QualifiedObject (SchemaName "pg_catalog") $ FunctionName "json_to_record" functionArgs = RS.FunctionArgsExp - (pure $ UVSQL $ toTxtValue $ WithScalarType PGJSON $ - PGValJSON $ Q.JSON webhookData) + (pure $ UVSQL webhookResponseExpression) mempty in RS.FromExpressionFunction functionName functionArgs (Just definitionList) - resolvedWebhook = _saecWebhook executionContext - returnStrategy = _saecStrategy executionContext - callWebhook :: (MonadIO m, MonadError QErr m) => HTTP.Manager -> ResolvedWebhook -> ActionWebhookPayload -> m J.Value @@ -476,3 +477,66 @@ annInpValueToJson annInpValue = AGEReference _ enumValueM -> J.toJSON enumValueM AGObject _ objectM -> J.toJSON $ fmap (fmap annInpValueToJson) objectM AGArray _ valuesM -> J.toJSON $ fmap (fmap annInpValueToJson) valuesM + +resolveAsyncResponse + :: ( MonadError QErr m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r, MonadResolve m + ) + => ActionSelectOpContext + -> Field + -> m GRS.AnnSimpleSelect +resolveAsyncResponse selectContext field = do + actionId <- withArg (_fArguments field) "id" parseActionId + stringifyNumerics <- stringifyNum <$> asks getter + annotatedFields <- forM (toList $ _fSelSet field) $ \fld -> do + let fldName = _fName fld + let rqlFldName = FieldName $ G.unName $ G.unAlias $ _fAlias fld + (rqlFldName,) <$> case fldName of + "__typename" -> return $ RS.FExp $ G.unName $ G.unNamedType $ _fType field + "output" -> do + let relationshipFromExp = + mkJsonToRecordFromExpression (_asocDefinitionList selectContext) $ + -- TODO: An absolute hack, please fix this + UVSQL $ S.mkQIdenExp (Iden "_0_root.base") (Iden "response_payload") + outputSelect <- processOutputSelectionSet relationshipFromExp (_fType fld) + (_fSelSet fld) + return $ RS.FObj $ RS.AnnRelG outputRelName [] outputSelect + -- the metadata columns + "id" -> return $ mkAnnFldFromPGCol "id" PGUUID + "created_at" -> return $ mkAnnFldFromPGCol "created_at" PGTimeStampTZ + -- "status" -> return $ mkAnnFldFromPGCol "status" + "errors" -> return $ mkAnnFldFromPGCol "errors" PGJSONB + G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t + let tableFromExp = RS.FromExpressionTable actionLogTable + tableArguments = RS.noTableArgs + { RS._taWhere = Just $ mkTableBoolExpression actionId} + tablePermissions = RS.TablePerm unresolvedFilter Nothing + selectAstUnresolved = RS.AnnSelG annotatedFields tableFromExp tablePermissions + tableArguments stringifyNumerics + return selectAstUnresolved + + -- astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved + -- return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] + where + outputRelName = RelName $ mkNonEmptyTextUnsafe "output" + actionLogTable = + QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log") + mkAnnFldFromPGCol column columnType = + RS.FCol (PGCol column, PGColumnScalar columnType) Nothing + unresolvedFilter = + fmapAnnBoolExp partialSQLExpToUnresolvedVal $ + _asocFilter selectContext + parseActionId annInpValue = do + mkParameterizablePGValue <$> asPGColumnValue annInpValue + mkTableBoolExpression actionId = + BoolFld $ AVCol + (PGColumnInfo (PGCol "id") "id" (PGColumnScalar PGUUID) False Nothing) $ + pure $ AEQ True actionId + mkJsonToRecordFromExpression definitionList webhookResponseExpression = + let functionName = QualifiedObject (SchemaName "pg_catalog") $ + FunctionName "jsonb_to_record" + functionArgs = RS.FunctionArgsExp + (pure webhookResponseExpression) + mempty + in RS.FromExpressionFunction functionName functionArgs + (Just definitionList) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 7ec63468b721d..37d1d0662f063 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -98,8 +98,8 @@ data SyncReturnStrategy data SyncActionExecutionContext = SyncActionExecutionContext - { _saecStrategy :: !SyncReturnStrategy - , _saecWebhook :: !ResolvedWebhook + { _saecStrategy :: !SyncReturnStrategy + , _saecWebhook :: !ResolvedWebhook } deriving (Show, Eq) data ActionExecutionContext @@ -107,9 +107,10 @@ data ActionExecutionContext | ActionExecutionAsync !AnnBoolExpPartialSQL deriving (Show, Eq) -newtype ActionSelectOpContext +data ActionSelectOpContext = ActionSelectOpContext - { _asocFilter :: AnnBoolExpPartialSQL + { _asocFilter :: AnnBoolExpPartialSQL + , _asocDefinitionList :: [(PGCol, PGScalarType)] } deriving (Show, Eq) -- (custom name | generated name) -> PG column info diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 7efb846cd4e0e..afe39b2c52151 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -100,11 +100,12 @@ mkQueryField :: ActionName -> ResolvedActionDefinition -> ActionPermissionInfo + -> [(PGCol, PGScalarType)] -> Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) -mkQueryField actionName definition permission = +mkQueryField actionName definition permission definitionList = case getActionKind definition of ActionAsynchronous -> - Just ( ActionSelectOpContext $ _apiFilter permission + Just ( ActionSelectOpContext (_apiFilter permission) definitionList , fieldInfo , TIObj $ mkActionResponseTypeInfo actionName $ _adOutputType definition @@ -138,7 +139,7 @@ mkActionFieldsAndTypes , FieldMap ) mkActionFieldsAndTypes actionInfo annotatedOutputType permission = - return ( mkQueryField actionName definition permission + return ( mkQueryField actionName definition permission definitionList , mkMutationField actionName actionInfo permission definitionList -- , maybe mempty mkFieldMap annotatedOutputTypeM , fieldMap From aa02af1fc691b1345b40305d76fabac71ccd16fc Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Tue, 10 Dec 2019 13:36:20 +0530 Subject: [PATCH 21/62] use 'true' for action filter for non admin role --- server/src-lib/Hasura/RQL/DDL/Action.hs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 628debf6e30ff..cf30f0296991f 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -232,12 +232,13 @@ validateAndCacheActionPermission createActionPermission = do actionName = _capAction createActionPermission role = _capRole createActionPermission permissionDefinition = _capDefinition createActionPermission - -- TODO + -- TODO buildActionFilter :: (QErrM m) => ActionPermissionSelect -> m AnnBoolExpPartialSQL - buildActionFilter permission = undefined + buildActionFilter permission = + return annBoolExpTrue runCreateActionPermission_ :: ( QErrM m , CacheRWM m, MonadTx m) From 0c7b4993d5a60e92de2ce3140e27c70ef7225fc2 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Tue, 10 Dec 2019 15:46:02 +0530 Subject: [PATCH 22/62] fix create_action_permission sql query --- server/src-lib/Hasura/RQL/DDL/Action.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index cf30f0296991f..53fbb9211b583 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -257,7 +257,7 @@ runCreateActionPermission_ createActionPermission = do liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql| INSERT into hdb_catalog.hdb_action_permission (action_name, role_name, definition, comment) - VALUES ($1, $2, $3) + VALUES ($1, $2, $3, $4) |] (actionName, role, Q.AltJ permissionDefinition, comment) True runCreateActionPermission From 5a5ad19c75f382b8a79e4803b307fce9f0d6ec3a Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Tue, 10 Dec 2019 16:03:24 +0530 Subject: [PATCH 23/62] drop permissions when dropping an action --- server/src-lib/Hasura/RQL/DDL/Action.hs | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 53fbb9211b583..8f048bd6a1d0c 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -175,8 +175,16 @@ runDropAction (DropAction actionName clearDataM)= do adminOnly void $ getActionInfo actionName delActionFromCache actionName - liftTx $ deleteActionFromCatalog actionName clearDataM + liftTx $ do + deleteActionPermissionsFromCatalog + deleteActionFromCatalog actionName clearDataM return successMsg + where + deleteActionPermissionsFromCatalog = + Q.unitQE defaultTxErrorHandler [Q.sql| + DELETE FROM hdb_catalog.hdb_action_permission + WHERE action_name = $1 + |] (Identity actionName) True deleteActionFromCatalog :: ActionName From 1f6adacdbe24e94d802dafaffcea438bdf34ea58 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Tue, 10 Dec 2019 19:26:30 +0530 Subject: [PATCH 24/62] add a hdb_role view (and relationships) to fetch all roles in the system --- server/src-rsr/hdb_metadata.yaml | 34 ++++++++++++++++++++++++++ server/src-rsr/initialise.sql | 9 +++++++ server/src-rsr/migrations/25_to_26.sql | 9 +++++++ 3 files changed, 52 insertions(+) diff --git a/server/src-rsr/hdb_metadata.yaml b/server/src-rsr/hdb_metadata.yaml index 6ac5bdf98d017..4980d696bd0d6 100644 --- a/server/src-rsr/hdb_metadata.yaml +++ b/server/src-rsr/hdb_metadata.yaml @@ -318,3 +318,37 @@ args: args: name: hdb_action_log schema: hdb_catalog + +- type: track_table + args: + name: hdb_role + schema: hdb_catalog + +- type: create_array_relationship + args: + name: action_permissions + table: + schema: hdb_catalog + name: hdb_role + using: + manual_configuration: + remote_table: + schema: hdb_catalog + name: hdb_action_permission + column_mapping: + role_name : role_name + +- type: create_array_relationship + args: + name: permissions + table: + schema: hdb_catalog + name: hdb_role + using: + manual_configuration: + remote_table: + schema: hdb_catalog + name: hdb_permission_agg + column_mapping: + role_name : role_name + diff --git a/server/src-rsr/initialise.sql b/server/src-rsr/initialise.sql index d797774b2fa23..43a5d62394abb 100644 --- a/server/src-rsr/initialise.sql +++ b/server/src-rsr/initialise.sql @@ -671,3 +671,12 @@ CREATE TABLE hdb_catalog.hdb_custom_types ( custom_types jsonb NOT NULL ); + +CREATE VIEW hdb_catalog.hdb_role AS +( + SELECT DISTINCT role_name FROM ( + SELECT role_name FROM hdb_catalog.hdb_permission + UNION ALL + SELECT role_name FROM hdb_catalog.hdb_action_permission + ) q +); diff --git a/server/src-rsr/migrations/25_to_26.sql b/server/src-rsr/migrations/25_to_26.sql index 680fb87d94309..546c31ff24eb8 100644 --- a/server/src-rsr/migrations/25_to_26.sql +++ b/server/src-rsr/migrations/25_to_26.sql @@ -38,3 +38,12 @@ CREATE TABLE hdb_catalog.hdb_custom_types ( custom_types jsonb NOT NULL ); + +CREATE VIEW hdb_catalog.hdb_role AS +( + SELECT DISTINCT role_name FROM ( + SELECT role_name FROM hdb_catalog.hdb_permission + UNION ALL + SELECT role_name FROM hdb_catalog.hdb_action_permission + ) q +); From 6944f42d7c630e9eb6a2a091a15078d158ef3a50 Mon Sep 17 00:00:00 2001 From: Vamshi Surabhi Date: Wed, 11 Dec 2019 11:39:07 +0530 Subject: [PATCH 25/62] fix retrieving action permission information from catalog --- server/src-lib/Hasura/RQL/DDL/Metadata.hs | 21 +++++++-------------- server/src-rsr/catalog_metadata.sql | 9 +++------ 2 files changed, 10 insertions(+), 20 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index bc07cbe17145a..14d09a1edfcff 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -500,14 +500,10 @@ fetchMetadata = do coalesce( json_agg( json_build_object( - 'name', - a.action_name, - 'definition', - a.action_defn, - 'comment', - a.comment, - 'permissions', - ap.permissions + 'name', a.action_name, + 'definition', a.action_defn, + 'comment', a.comment, + 'permissions', ap.permissions ) ), '[]' @@ -519,12 +515,9 @@ fetchMetadata = do coalesce( json_agg( json_build_object( - 'role', - ap.role_name, - 'definition', - ap.definition, - 'comment', - ap.comment + 'role', ap.role_name, + 'definition', ap.definition, + 'comment', ap.comment ) ), '[]' diff --git a/server/src-rsr/catalog_metadata.sql b/server/src-rsr/catalog_metadata.sql index 678b45fa249a0..33178dbb9f10c 100644 --- a/server/src-rsr/catalog_metadata.sql +++ b/server/src-rsr/catalog_metadata.sql @@ -185,8 +185,7 @@ from coalesce( json_agg( json_build_object( - 'name', - action_name, + 'name', action_name, 'definition', action_defn :: json, 'comment', comment ) @@ -201,10 +200,8 @@ from coalesce( json_agg( json_build_object( - 'name', - action_name, - 'role', - role_name, + 'action', action_name, + 'role', role_name, 'definition', definition :: json, 'comment', comment ) From 4e819610937e1b8084cf85e5c4f084b6afad9bbd Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 26 Dec 2019 17:07:23 +0530 Subject: [PATCH 26/62] fix error message when action webhook returns 'errors' --- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 39 +++++++++++++------ server/src-lib/Hasura/RQL/Types/Error.hs | 3 ++ 2 files changed, 30 insertions(+), 12 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index c1a4269e7c5fb..e5e0133489e31 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -197,10 +197,17 @@ data ActionWebhookPayload } deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookPayload) +data ActionWebhookError + = ActionWebhookError + { _aweCode :: !(Maybe Text) + , _aweMessage :: !(Maybe Text) + } deriving (Show, Eq) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookError) + data ActionWebhookResponse = ActionWebhookResponse { _awrData :: !(Maybe J.Value) - , _awrErrors :: !(Maybe J.Value) + , _awrErrors :: !(Maybe ActionWebhookError) } deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookResponse) @@ -279,17 +286,25 @@ callWebhook manager resolvedWebhook actionWebhookPayload = do Right (Left (Wreq.JSONError e)) -> throw500WithDetail "not a valid json response from webhook" $ J.toJSON e - Right (Right responseWreq) -> - let response = responseWreq ^. Wreq.responseBody - in case (_awrData response, _awrErrors response) of - (Nothing, Nothing) -> - throw500WithDetail "internal error" $ - J.String "webhook response has neither 'data' nor 'errors'" - (Just _, Just _) -> - throw500WithDetail "internal error" $ - J.String "webhook response cannot have both 'data' and 'errors'" - (Just d, Nothing) -> return d - (Nothing, Just e) -> throwVE $ T.pack $ show e + Right (Right responseWreq) -> do + let responseValue = responseWreq ^. Wreq.responseBody + response <- decodeValue responseValue + case (_awrData response, _awrErrors response) of + (Nothing, Nothing) -> + throw500WithDetail "internal error" $ + J.String "webhook response has neither 'data' nor 'errors'" + (Just _, Just _) -> + throw500WithDetail "internal error" $ + J.String "webhook response cannot have both 'data' and 'errors'" + (Just d, Nothing) -> return d + (Nothing, Just errorResponse) -> do + let ActionWebhookError maybeCode maybeMessage = errorResponse + code = maybe Unexpected ActionWebhookCode maybeCode + withMessage message = err500 code message + noMessagekey = "\"message\" key is not found in webhook \"errors\" response" + withoutMessage = (err500 code noMessagekey) + {qeInternal = Just $ J.object ["webhook_response" J..= responseValue]} + throwError $ maybe withoutMessage withMessage maybeMessage data ActionLogItem = ActionLogItem diff --git a/server/src-lib/Hasura/RQL/Types/Error.hs b/server/src-lib/Hasura/RQL/Types/Error.hs index 364fdb4f3e341..9701c7d2e8cee 100644 --- a/server/src-lib/Hasura/RQL/Types/Error.hs +++ b/server/src-lib/Hasura/RQL/Types/Error.hs @@ -86,6 +86,8 @@ data Code -- Websocket/Subscription errors | StartFailed | InvalidCustomTypes + -- Actions Webhook code + | ActionWebhookCode !Text deriving (Eq) instance Show Code where @@ -125,6 +127,7 @@ instance Show Code where RemoteSchemaConflicts -> "remote-schema-conflicts" StartFailed -> "start-failed" InvalidCustomTypes -> "invalid-custom-types" + ActionWebhookCode t -> T.unpack t data QErr = QErr From 483ef3640c1814af5071e371e918a3e29f74d0db Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 26 Dec 2019 18:43:45 +0530 Subject: [PATCH 27/62] rename 'webhook' key in action definition to 'handler' --- server/src-lib/Hasura/GraphQL/Resolve/Action.hs | 2 +- server/src-lib/Hasura/GraphQL/Schema/Action.hs | 2 +- server/src-lib/Hasura/RQL/Types/Action.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index e5e0133489e31..c45e323b2d0a2 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -326,7 +326,7 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do threadDelay (1 * 1000 * 1000) where getActionWebhook actionCache actionName = - _adWebhook . _aiDefinition <$> Map.lookup actionName actionCache + _adHandler . _aiDefinition <$> Map.lookup actionName actionCache runTx :: (Monoid a) => Q.TxE QErr a -> IO a runTx q = do diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index afe39b2c52151..d3f10a2b2ad7c 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -72,7 +72,7 @@ mkMutationField actionName actionInfo permission definitionList = ActionExecutionSyncWebhook $ SyncActionExecutionContext -- TODO: only covers object types (ExecOnPostgres definitionList) - (_adWebhook definition) + (_adHandler definition) ActionAsynchronous -> ActionExecutionAsync $ _apiFilter permission -- TODO: we need to capture the comment from action definition diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index aa52daad22b2c..55c2bf3d7e9ec 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -80,7 +80,7 @@ data ActionDefinition a { _adArguments :: ![ArgumentDefinition] , _adOutputType :: !GraphQLType , _adKind :: !(Maybe ActionKind) - , _adWebhook :: !a + , _adHandler :: !a } deriving (Show, Eq, Lift, Functor) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ActionDefinition) @@ -118,7 +118,7 @@ type ActionPermissionMap data ActionInfo = ActionInfo { _aiName :: !ActionName - , _aiDefinition :: !ResolvedActionDefinition + , _aiDefinition :: !ResolvedActionDefinition , _aiPermissions :: !ActionPermissionMap } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionInfo) From 7d736c23ed1ec34c434189b72ce431168467b68b Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Fri, 27 Dec 2019 13:16:51 +0530 Subject: [PATCH 28/62] allow templating actions wehook URLs with env vars Example:- {{MY_APP_BASE}}/api1/webhook --- server/graphql-engine.cabal | 1 + server/src-lib/Data/URL/Template.hs | 52 +++++++++++++++++++++++ server/src-lib/Hasura/RQL/DDL/Action.hs | 19 ++++++--- server/src-lib/Hasura/RQL/Types/Action.hs | 24 ++++++++++- 4 files changed, 89 insertions(+), 7 deletions(-) create mode 100644 server/src-lib/Data/URL/Template.hs diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 0e5ffecdb60c8..a43133f38d6b7 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -282,6 +282,7 @@ library , Control.Concurrent.Extended , Control.Lens.Extended , Data.Aeson.Extended + , Data.URL.Template , Data.List.Extended , Data.HashMap.Strict.InsOrd.Extended , Data.Parser.JSONPath diff --git a/server/src-lib/Data/URL/Template.hs b/server/src-lib/Data/URL/Template.hs new file mode 100644 index 0000000000000..44e1222c1aca3 --- /dev/null +++ b/server/src-lib/Data/URL/Template.hs @@ -0,0 +1,52 @@ +-- | Simple URL templating language enables interpolating environment variables + +module Data.URL.Template + ( URLTemplate + , printURLTemplate + , parseURLTemplate + , renderURLTemplate + ) +where + +import Hasura.Prelude + +import qualified Data.Text as T + +import Data.Attoparsec.Text +import Instances.TH.Lift () +import Language.Haskell.TH.Syntax (Lift) +import System.Environment (lookupEnv) + +newtype Variable = Variable {unVariable :: Text} + deriving (Show, Eq, Lift) + +-- | A String with single environment variable enclosed in '{{' and '}}' +-- http://{{APP_HOST}}/v1/api +data URLTemplate + = URLTemplate + { _utPreVarText :: !Text + , _utVariable :: !Variable + , _utPostVarText :: !Text + } deriving (Show, Eq, Lift) + +printURLTemplate :: URLTemplate -> Text +printURLTemplate (URLTemplate preVar var postVar) = + preVar <> "{{" <> unVariable var <> "}}" <> postVar + +parseURLTemplate :: Text -> Either String URLTemplate +parseURLTemplate = parseOnly parseTemplate + where + parseTemplate :: Parser URLTemplate + parseTemplate = URLTemplate + <$> (T.pack <$> manyTill anyChar (string "{{")) + <*> (Variable . T.pack <$> manyTill anyChar (string "}}")) + <*> takeText + +renderURLTemplate :: MonadIO m => URLTemplate -> m (Either String Text) +renderURLTemplate (URLTemplate preVar var postVar) = do + maybeEnvValue <- liftIO $ lookupEnv variableString + case maybeEnvValue of + Nothing -> pure $ Left $ "Value for environment variable " <> variableString <> " not found" + Just value -> pure $ Right $ preVar <> T.pack value <> postVar + where + variableString = T.unpack $ unVariable var diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 8f048bd6a1d0c..0ad3029d37721 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -33,9 +33,11 @@ import qualified Data.Aeson as J import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J import qualified Data.HashMap.Strict as Map +import qualified Data.Text as T import qualified Database.PG.Query as Q import qualified Language.GraphQL.Draft.Syntax as G +import Data.URL.Template (renderURLTemplate) import Language.Haskell.TH.Syntax (Lift) -- data RetryConf -- = RetryConf @@ -65,6 +67,7 @@ getActionInfo actionName = do runCreateAction :: ( QErrM m, UserInfoM m , CacheRWM m, MonadTx m + , MonadIO m ) => CreateAction -> m EncJSON runCreateAction q = do @@ -73,7 +76,7 @@ runCreateAction q = do return successMsg runCreateAction_ - :: (QErrM m , CacheRWM m, MonadTx m) + :: (QErrM m , CacheRWM m, MonadTx m, MonadIO m) => CreateAction -> m () runCreateAction_ q@(CreateAction actionName actionDefinition comment) = do validateAndCacheAction q @@ -88,7 +91,7 @@ runCreateAction_ q@(CreateAction actionName actionDefinition comment) = do |] (actionName, Q.AltJ actionDefinition, comment) True validateAndCacheAction - :: (QErrM m, CacheRWM m) + :: (QErrM m, CacheRWM m, MonadIO m) => CreateAction -> m () validateAndCacheAction q = do actionMap <- scActions <$> askSchemaCache @@ -101,7 +104,7 @@ validateAndCacheAction q = do actionName = _caName q buildActionInfo - :: (QErrM m, CacheRM m) + :: (QErrM m, CacheRM m, MonadIO m) => CreateAction -> m ActionInfo buildActionInfo q = do let responseType = unGraphQLType $ _adOutputType actionDefinition @@ -129,8 +132,8 @@ buildActionInfo q = do -- _ -> throw400 InvalidParams $ "the output type: " <> -- showNamedTy responseBaseType <> -- " should be a scalar/enum/object" - return $ ActionInfo actionName - (fmap ResolvedWebhook actionDefinition) mempty + resolvedDefinition <- traverse resolveWebhook actionDefinition + return $ ActionInfo actionName resolvedDefinition mempty where getNonObjectTypeInfo typeName = do nonObjectTypeMap <- (unNonObjectTypeMap . fst . scCustomTypes) <$> askSchemaCache @@ -139,6 +142,12 @@ buildActionInfo q = do throw400 NotExists $ "the type: " <> showNamedTy typeName <> " is not defined in custom types" + resolveWebhook = \case + IWPlain t -> pure $ ResolvedWebhook t + IWTemplate template -> do + eitherRenderedTemplate <- renderURLTemplate template + either (throw400 Unexpected . T.pack) (pure . ResolvedWebhook) eitherRenderedTemplate + getObjectTypeInfo typeName = do customTypes <- (snd . scCustomTypes) <$> askSchemaCache onNothing (Map.lookup (ObjectTypeName typeName) customTypes) $ diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index 55c2bf3d7e9ec..976cbc91176a2 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -8,6 +8,7 @@ module Hasura.RQL.Types.Action , getActionKind , CreateAction(..) , ActionDefinitionInput + , InputWebhook(..) , ResolvedWebhook(..) , ResolvedActionDefinition @@ -24,6 +25,7 @@ module Hasura.RQL.Types.Action ) where +import Data.URL.Template import Hasura.Prelude import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.CustomTypes @@ -36,6 +38,7 @@ import qualified Data.Aeson as J import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J import qualified Data.HashMap.Strict as Map +import qualified Data.Text as T import qualified Database.PG.Query as Q import qualified Language.GraphQL.Draft.Syntax as G @@ -81,7 +84,7 @@ data ActionDefinition a , _adOutputType :: !GraphQLType , _adKind :: !(Maybe ActionKind) , _adHandler :: !a - } deriving (Show, Eq, Lift, Functor) + } deriving (Show, Eq, Lift, Functor, Foldable, Traversable) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ActionDefinition) getActionKind :: ActionDefinition a -> ActionKind @@ -123,7 +126,24 @@ data ActionInfo } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionInfo) -type InputWebhook = Text +data InputWebhook + = IWTemplate !URLTemplate + | IWPlain !Text + deriving (Show, Eq, Lift) + +instance J.ToJSON InputWebhook where + toJSON = \case + IWTemplate template -> J.String $ printURLTemplate template + IWPlain t -> J.String t + +instance J.FromJSON InputWebhook where + parseJSON = J.withText "String" $ \t -> + if T.any (== '{') t then + case parseURLTemplate t of + Left _ -> fail "Parsing URL template failed" + Right template -> pure $ IWTemplate template + else pure $ IWPlain t + type ActionDefinitionInput = ActionDefinition InputWebhook data CreateAction From 3fcc90853acfc2a619e8c7aa65580f8d3141a95c Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 25 Dec 2019 14:31:50 +0530 Subject: [PATCH 29/62] add 'update_action' /v1/query type --- server/src-lib/Hasura/RQL/DDL/Action.hs | 41 ++++++++++++++++++++--- server/src-lib/Hasura/RQL/Types/Action.hs | 8 +++++ server/src-lib/Hasura/Server/Query.hs | 5 ++- 3 files changed, 49 insertions(+), 5 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 0ad3029d37721..4247847a8cabb 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -4,6 +4,9 @@ module Hasura.RQL.DDL.Action , runCreateAction , runCreateAction_ + , UpdateAction + , runUpdateAction + , DropAction , runDropAction , deleteActionFromCatalog @@ -98,15 +101,16 @@ validateAndCacheAction q = do onJust (Map.lookup actionName actionMap) $ const $ throw400 AlreadyExists $ "action with name " <> actionName <<> " already exists" - actionInfo <- buildActionInfo q + actionInfo <- buildActionInfo actionName actionDefinition addActionToCache actionInfo where actionName = _caName q + actionDefinition = _caDefinition q buildActionInfo :: (QErrM m, CacheRM m, MonadIO m) - => CreateAction -> m ActionInfo -buildActionInfo q = do + => ActionName -> ActionDefinitionInput -> m ActionInfo +buildActionInfo actionName actionDefinition = do let responseType = unGraphQLType $ _adOutputType actionDefinition responseBaseType = G.getBaseType responseType forM (_adArguments actionDefinition) $ \argument -> do @@ -154,12 +158,41 @@ buildActionInfo q = do throw400 NotExists $ "the type: " <> showNamedTy typeName <> " is not an object type defined in custom types" - CreateAction actionName actionDefinition _ = q hasList = \case G.TypeList _ _ -> True G.TypeNamed _ _ -> False +runUpdateAction + :: forall m. ( QErrM m, UserInfoM m + , CacheRWM m, MonadTx m + , MonadIO m + ) + => UpdateAction -> m EncJSON +runUpdateAction (UpdateAction actionName actionDefinition) = do + adminOnly + sc <- askSchemaCache + let actionsMap = scActions sc + actionPerms <- fmap _aiPermissions $ onNothing (Map.lookup actionName actionsMap) $ + throw400 NotExists $ "action with name " <> actionName <<> " not exists" + newActionInfo <- buildActionInfo actionName actionDefinition + -- FIXME:- This is not ideal implementation of updating ActionInfo. + -- With incremental schema build PR (https://github.com/hasura/graphql-engine/pull/3394) going in + -- the logic here would be just updating the catalog with definition and incrementally + -- building schema cache for action + let newActionInfoPerms = newActionInfo{_aiPermissions = actionPerms} + writeSchemaCache sc{scActions = Map.insert actionName newActionInfoPerms actionsMap} + updateActionInCatalog + pure successMsg + where + updateActionInCatalog :: m () + updateActionInCatalog = + liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql| + UPDATE hdb_catalog.hdb_action + SET action_defn = $2 + WHERE action_name = $1 + |] (actionName, Q.AltJ actionDefinition) True + newtype ClearActionData = ClearActionData { unClearActionData :: Bool } deriving (Show, Eq, Lift, J.FromJSON, J.ToJSON) diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index 976cbc91176a2..c3897ec623d7d 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -7,6 +7,7 @@ module Hasura.RQL.Types.Action , ActionDefinition(..) , getActionKind , CreateAction(..) + , UpdateAction(..) , ActionDefinitionInput , InputWebhook(..) @@ -154,6 +155,13 @@ data CreateAction } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''CreateAction) +data UpdateAction + = UpdateAction + { _uaName :: !ActionName + , _uaDefinition :: !ActionDefinitionInput + } deriving (Show, Eq, Lift) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''UpdateAction) + newtype ActionPermissionSelect = ActionPermissionSelect { _apsFilter :: BoolExp diff --git a/server/src-lib/Hasura/Server/Query.hs b/server/src-lib/Hasura/Server/Query.hs index 55c626532e8f8..70d1f458f1d10 100644 --- a/server/src-lib/Hasura/Server/Query.hs +++ b/server/src-lib/Hasura/Server/Query.hs @@ -12,10 +12,10 @@ import qualified Network.HTTP.Client as HTTP import Hasura.EncJSON import Hasura.Prelude import Hasura.RQL.DDL.Action +import Hasura.RQL.DDL.CustomTypes import Hasura.RQL.DDL.EventTrigger import Hasura.RQL.DDL.Metadata import Hasura.RQL.DDL.Permission -import Hasura.RQL.DDL.CustomTypes import Hasura.RQL.DDL.QueryCollection import Hasura.RQL.DDL.Relationship import Hasura.RQL.DDL.Relationship.Rename @@ -95,6 +95,7 @@ data RQLQueryV1 | RQCreateAction !CreateAction | RQDropAction !DropAction + | RQUpdateAction !UpdateAction | RQCreateActionPermission !CreateActionPermission | RQDropActionPermission !DropActionPermission @@ -283,6 +284,7 @@ queryNeedsReload (RQV1 qi) = case qi of RQCreateAction _ -> True RQDropAction _ -> True + RQUpdateAction _ -> True RQCreateActionPermission _ -> True RQDropActionPermission _ -> True @@ -368,6 +370,7 @@ runQueryM rq = RQCreateAction q -> runCreateAction q RQDropAction q -> runDropAction q + RQUpdateAction q -> runUpdateAction q RQCreateActionPermission q -> runCreateActionPermission q RQDropActionPermission q -> runDropActionPermission q From a6b5a8c9c67585c6e9afc8cb0f668e9bfd760df4 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Mon, 6 Jan 2020 17:45:43 +0530 Subject: [PATCH 30/62] allow forwarding client headers by setting `forward_client_headers` in action definition Catalog changed, migration SQL: ALTER TABLE hdb_catalog.hdb_action_log ADD COLUMN request_headers JSONB NOT NULL DEFAULT '[]'::jsonb --- server/src-lib/Hasura/GraphQL/Execute.hs | 30 ++++------ server/src-lib/Hasura/GraphQL/Resolve.hs | 2 + .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 56 ++++++++++++------- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 5 +- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 1 + .../src-lib/Hasura/GraphQL/Transport/HTTP.hs | 10 ++-- .../Hasura/GraphQL/Transport/WebSocket.hs | 2 +- server/src-lib/Hasura/RQL/Types/Action.hs | 9 +-- server/src-lib/Hasura/RQL/Types/Permission.hs | 12 ++-- server/src-lib/Hasura/Server/Auth/JWT.hs | 13 ++--- server/src-lib/Hasura/Server/Utils.hs | 13 +++++ server/src-rsr/initialise.sql | 1 + server/src-rsr/migrations/28_to_29.sql | 1 + 13 files changed, 88 insertions(+), 67 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Execute.hs b/server/src-lib/Hasura/GraphQL/Execute.hs index 3584007d22ff6..a879c851097ab 100644 --- a/server/src-lib/Hasura/GraphQL/Execute.hs +++ b/server/src-lib/Hasura/GraphQL/Execute.hs @@ -47,7 +47,7 @@ import Hasura.Prelude import Hasura.RQL.DDL.Headers import Hasura.RQL.Types import Hasura.Server.Context -import Hasura.Server.Utils (RequestId, filterRequestHeaders) +import Hasura.Server.Utils (RequestId, mkClientHeadersForward) import qualified Hasura.GraphQL.Execute.LiveQuery as EL import qualified Hasura.GraphQL.Execute.Plan as EP @@ -185,10 +185,11 @@ getResolvedExecPlan -> SchemaCache -> SchemaCacheVer -> HTTP.Manager + -> [N.Header] -> GQLReqUnparsed -> m ExecPlanResolved getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx - enableAL sc scVer httpManager reqUnparsed = do + enableAL sc scVer httpManager reqHeaders reqUnparsed = do planM <- liftIO $ EP.getPlan scVer (userRole userInfo) opNameM queryStr planCache let usrVars = userVars userInfo @@ -213,7 +214,7 @@ getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx forM partialExecPlan $ \(gCtx, rootSelSet) -> case rootSelSet of VQ.RMutation selSet -> - ExOpMutation <$> getMutOp gCtx sqlGenCtx userInfo httpManager selSet + ExOpMutation <$> getMutOp gCtx sqlGenCtx userInfo httpManager reqHeaders selSet VQ.RQuery selSet -> do (queryTx, plan, genSql) <- getQueryOp gCtx sqlGenCtx userInfo queryReusability selSet traverse_ (addPlanToCache . EP.RPQuery) plan @@ -278,6 +279,7 @@ resolveMutSelSet , Has SQLGenCtx r , Has InsCtxMap r , Has HTTP.Manager r + , Has [N.Header] r , MonadIO m ) => VQ.SelSet @@ -307,16 +309,17 @@ getMutOp -> SQLGenCtx -> UserInfo -> HTTP.Manager + -> [N.Header] -> VQ.SelSet -> m LazyRespTx -getMutOp ctx sqlGenCtx userInfo manager selSet = +getMutOp ctx sqlGenCtx userInfo manager reqHeaders selSet = runE_ $ resolveMutSelSet selSet where runE_ action = do res <- runExceptT $ runReaderT action ( userInfo, queryCtxMap, mutationCtxMap , typeMap, fldMap, ordByCtx, insCtxMap, sqlGenCtx - , manager + , manager, reqHeaders ) either throwError return res where @@ -386,12 +389,11 @@ execRemoteGQ reqId userInfo reqHdrs q rsi opDef = do throw400 NotSupported "subscription to remote server is not supported" hdrs <- getHeadersFromConf hdrConf let confHdrs = map (\(k, v) -> (CI.mk $ CS.cs k, CS.cs v)) hdrs - clientHdrs = bool [] filteredHeaders fwdClientHdrs + clientHdrs = bool [] (mkClientHeadersForward reqHdrs) fwdClientHdrs -- filter out duplicate headers - -- priority: conf headers > resolved userinfo vars > x-forwarded headers > client headers + -- priority: conf headers > resolved userinfo vars > client headers hdrMaps = [ Map.fromList confHdrs , Map.fromList userInfoToHdrs - , Map.fromList xForwardedHeaders , Map.fromList clientHdrs ] headers = Map.toList $ foldr Map.union Map.empty hdrMaps @@ -421,18 +423,6 @@ execRemoteGQ reqId userInfo reqHdrs q rsi opDef = do userInfoToHdrs = map (\(k, v) -> (CI.mk $ CS.cs k, CS.cs v)) $ userInfoToList userInfo - filteredHeaders = filterUserVars $ filterRequestHeaders reqHdrs - - xForwardedHeaders = flip mapMaybe reqHdrs $ \(hdrName, hdrValue) -> - case hdrName of - "Host" -> Just ("X-Forwarded-Host", hdrValue) - "User-Agent" -> Just ("X-Forwarded-User-Agent", hdrValue) - _ -> Nothing - - filterUserVars hdrs = - let txHdrs = map (\(n, v) -> (bsToTxt $ CI.original n, bsToTxt v)) hdrs - in map (\(k, v) -> (CI.mk $ CS.cs k, CS.cs v)) $ - filter (not . isUserVar . fst) txHdrs getCookieHdr = fmap (\h -> ("Set-Cookie", h)) diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 591e23562695d..91ecebe9cec09 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -22,6 +22,7 @@ import qualified Data.HashMap.Strict as Map import qualified Database.PG.Query as Q import qualified Language.GraphQL.Draft.Syntax as G import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Types as HTTP import Hasura.GraphQL.Resolve.Context import Hasura.Prelude @@ -131,6 +132,7 @@ mutFldToTx , Has SQLGenCtx r , Has InsCtxMap r , Has HTTP.Manager r + , Has [HTTP.Header] r , MonadIO m ) => V.Field diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 2ab9d475ab66a..2137dd0a5e7d3 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -22,12 +22,14 @@ import qualified Control.Concurrent.Async as A import qualified Data.Aeson as J import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J +import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as Map import qualified Data.Text as T import qualified Data.UUID as UUID import qualified Database.PG.Query as Q import qualified Language.GraphQL.Draft.Syntax as G import qualified Network.HTTP.Client as HTTP +import qualified Network.HTTP.Types as HTTP import qualified Network.Wreq as Wreq import qualified Hasura.GraphQL.Resolve.Select as GRS @@ -43,6 +45,7 @@ import Hasura.GraphQL.Validate.Types import Hasura.HTTP import Hasura.RQL.DML.Select (asSingleRowJsonResp) import Hasura.RQL.Types +import Hasura.Server.Utils (mkClientHeadersForward) import Hasura.SQL.Types import Hasura.SQL.Value (PGScalarValue (..), pgScalarValueToJson, toTxtValue) @@ -245,6 +248,7 @@ resolveActionInsertSync , Has OrdByCtx r , Has SQLGenCtx r , Has HTTP.Manager r + , Has [HTTP.Header] r ) => Field -> SyncActionExecutionContext @@ -254,7 +258,8 @@ resolveActionInsertSync field executionContext sessionVariables = do let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field handlerPayload = ActionWebhookPayload sessionVariables inputArgs manager <- asks getter - webhookRes <- callWebhook manager resolvedWebhook handlerPayload + reqHeaders <- asks getter + webhookRes <- callWebhook manager reqHeaders forwardClientHeaders resolvedWebhook handlerPayload case returnStrategy of ReturnJson -> return $ return $ encJFromJValue webhookRes ExecOnPostgres definitionList -> do @@ -267,8 +272,7 @@ resolveActionInsertSync field executionContext sessionVariables = do astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] where - resolvedWebhook = _saecWebhook executionContext - returnStrategy = _saecStrategy executionContext + SyncActionExecutionContext returnStrategy resolvedWebhook forwardClientHeaders = executionContext mkJsonToRecordFromExpression definitionList webhookResponseExpression = let functionName = QualifiedObject (SchemaName "pg_catalog") $ @@ -281,9 +285,15 @@ resolveActionInsertSync field executionContext sessionVariables = do callWebhook :: (MonadIO m, MonadError QErr m) - => HTTP.Manager -> ResolvedWebhook -> ActionWebhookPayload -> m J.Value -callWebhook manager resolvedWebhook actionWebhookPayload = do - let options = wreqOptions manager [contentType] + => HTTP.Manager + -> [HTTP.Header] + -> Bool + -> ResolvedWebhook + -> ActionWebhookPayload + -> m J.Value +callWebhook manager reqHeaders forwardClientHeaders resolvedWebhook actionWebhookPayload = do + let options = wreqOptions manager (contentType:clientHeaders) + clientHeaders = if forwardClientHeaders then mkClientHeadersForward reqHeaders else [] contentType = ("Content-Type", "application/json") postPayload = J.toJSON actionWebhookPayload url = (T.unpack $ unResolvedWebhook resolvedWebhook) @@ -320,6 +330,7 @@ data ActionLogItem = ActionLogItem { _aliId :: !UUID.UUID , _aliActionName :: !ActionName + , _aliRequestHeaders :: ![HTTP.Header] , _aliSessionVariables :: !UserVars , _aliInputPayload :: !J.Value } deriving (Show, Eq) @@ -335,8 +346,8 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do A.mapConcurrently_ (callHandler actionCache) asyncInvocations threadDelay (1 * 1000 * 1000) where - getActionWebhook actionCache actionName = - _adHandler . _aiDefinition <$> Map.lookup actionName actionCache + getActionDefinition actionCache actionName = + _aiDefinition <$> Map.lookup actionName actionCache runTx :: (Monoid a) => Q.TxE QErr a -> IO a runTx q = do @@ -345,12 +356,14 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do callHandler :: ActionCache -> ActionLogItem -> IO () callHandler actionCache actionLogItem = do - let ActionLogItem actionId actionName + let ActionLogItem actionId actionName reqHeaders sessionVariables inputPayload = actionLogItem - case getActionWebhook actionCache actionName of + case getActionDefinition actionCache actionName of Nothing -> return () - Just webhookUrl -> do - res <- runExceptT $ callWebhook httpManager webhookUrl $ + Just definition -> do + let webhookUrl = _adHandler definition + forwardClientHeaders = fromMaybe False $ _adForwardClientHeaders definition + res <- runExceptT $ callWebhook httpManager reqHeaders forwardClientHeaders webhookUrl $ ActionWebhookPayload sessionVariables inputPayload case res of Left e -> setError actionId e @@ -394,12 +407,14 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do for update skip locked limit 10 ) returning - id, action_name, session_variables::json, input_payload::json + id, action_name, request_headers::json, session_variables::json, input_payload::json |] () False where - mapEvent (actionId, actionName, + mapEvent (actionId, actionName, Q.AltJ headersMap, Q.AltJ sessionVariables, Q.AltJ inputPayload) = - ActionLogItem actionId actionName sessionVariables inputPayload + ActionLogItem actionId actionName (fromHeadersMap headersMap) sessionVariables inputPayload + + fromHeadersMap = map ((CI.mk . txtToBs) *** txtToBs) . Map.toList getUndeliveredEvents = runTx undeliveredEventsQuery @@ -426,6 +441,7 @@ resolveActionInsert , Has OrdByCtx r , Has SQLGenCtx r , Has HTTP.Manager r + , Has [HTTP.Header] r ) => Field -> ActionExecutionContext @@ -441,7 +457,7 @@ resolveActionInsert field executionContext sessionVariables = resolveActionInsertAsync :: ( MonadError QErr m, MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r + , Has OrdByCtx r, Has SQLGenCtx r, Has [HTTP.Header] r ) => Field -> AnnBoolExpPartialSQL @@ -451,6 +467,7 @@ resolveActionInsertAsync resolveActionInsertAsync field actionFilter sessionVariables = do responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ _fSelSet field + reqHeaders <- asks getter let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field -- resolvedPresetFields <- resolvePresetFields @@ -466,18 +483,19 @@ resolveActionInsertAsync field actionFilter sessionVariables = do actionId <- runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler [Q.sql| INSERT INTO "hdb_catalog"."hdb_action_log" - ("action_name", "session_variables", "input_payload", "status") + ("action_name", "session_variables", "request_headers", "input_payload", "status") VALUES - ($1, $2, $3, $4) + ($1, $2, $3, $4, $5) RETURNING "id" |] - (actionName, Q.AltJ sessionVariables, Q.AltJ inputArgs, "created"::Text) False + (actionName, Q.AltJ sessionVariables, Q.AltJ $ toHeadersMap reqHeaders, Q.AltJ inputArgs, "created"::Text) False actionSelectToTx $ ActionSelect (S.SELit $ UUID.toText actionId) responseSelectionSet resolvedFilter where actionName = G.unName $ _fName field + toHeadersMap = Map.fromList . map ((bsToTxt . CI.original) *** bsToTxt) -- resolveFilter = -- flip traverseAnnBoolExp (_aiocSelectFilter insertContext) $ \case diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 3f9963d8bd2b0..f263582e5a4e2 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -104,8 +104,9 @@ data SyncReturnStrategy data SyncActionExecutionContext = SyncActionExecutionContext - { _saecStrategy :: !SyncReturnStrategy - , _saecWebhook :: !ResolvedWebhook + { _saecStrategy :: !SyncReturnStrategy + , _saecWebhook :: !ResolvedWebhook + , _saecForwardClientHeaders :: !Bool } deriving (Show, Eq) data ActionExecutionContext diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index b9c99bd3ad92d..1c9ba349ddaa3 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -73,6 +73,7 @@ mkMutationField actionName actionInfo permission definitionList = -- TODO: only covers object types (ExecOnPostgres definitionList) (_adHandler definition) + (fromMaybe False $ _adForwardClientHeaders definition) ActionAsynchronous -> ActionExecutionAsync $ _apiFilter permission -- TODO: we need to capture the comment from action definition diff --git a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs index 0402c1e9ce856..683782904f830 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/HTTP.hs @@ -30,7 +30,7 @@ runGQ runGQ reqId userInfo reqHdrs req = do E.ExecutionCtx _ sqlGenCtx pgExecCtx planCache sc scVer httpManager enableAL <- ask execPlan <- E.getResolvedExecPlan pgExecCtx planCache - userInfo sqlGenCtx enableAL sc scVer httpManager req + userInfo sqlGenCtx enableAL sc scVer httpManager reqHdrs req case execPlan of E.GExPHasura resolvedOp -> flip HttpResponse Nothing <$> runHasuraGQ reqId req userInfo resolvedOp @@ -55,12 +55,12 @@ runGQBatched reqId userInfo reqHdrs reqs = -- It's unclear what we should do if we receive multiple -- responses with distinct headers, so just do the simplest thing -- in this case, and don't forward any. - let removeHeaders = - flip HttpResponse Nothing - . encJFromList + let removeHeaders = + flip HttpResponse Nothing + . encJFromList . map (either (encJFromJValue . encodeGQErr False) _hrBody) try = flip catchError (pure . Left) . fmap Right - fmap removeHeaders $ + fmap removeHeaders $ traverse (try . runGQ reqId userInfo reqHdrs) batch runHasuraGQ diff --git a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs index 33948f1779600..7951879f96f33 100644 --- a/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs +++ b/server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs @@ -279,7 +279,7 @@ onStart serverEnv wsConn (StartMsg opId q) = catchAndIgnore $ do requestId <- getRequestId reqHdrs (sc, scVer) <- liftIO $ IORef.readIORef gCtxMapRef execPlanE <- runExceptT $ E.getResolvedExecPlan pgExecCtx - planCache userInfo sqlGenCtx enableAL sc scVer httpMgr q + planCache userInfo sqlGenCtx enableAL sc scVer httpMgr reqHdrs q execPlan <- either (withComplete . preExecErr requestId) return execPlanE let execCtx = E.ExecutionCtx logger sqlGenCtx pgExecCtx planCache sc scVer httpMgr enableAL diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index 8d92ec46c362f..c72b59b6b29d2 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -81,10 +81,11 @@ $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ArgumentDefinition) data ActionDefinition a = ActionDefinition - { _adArguments :: ![ArgumentDefinition] - , _adOutputType :: !GraphQLType - , _adKind :: !(Maybe ActionKind) - , _adHandler :: !a + { _adArguments :: ![ArgumentDefinition] + , _adOutputType :: !GraphQLType + , _adKind :: !(Maybe ActionKind) + , _adForwardClientHeaders :: !(Maybe Bool) + , _adHandler :: !a } deriving (Show, Eq, Lift, Functor, Foldable, Traversable, Generic) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ActionDefinition) diff --git a/server/src-lib/Hasura/RQL/Types/Permission.hs b/server/src-lib/Hasura/RQL/Types/Permission.hs index 128657b1b9a64..b1f18a12ff3eb 100644 --- a/server/src-lib/Hasura/RQL/Types/Permission.hs +++ b/server/src-lib/Hasura/RQL/Types/Permission.hs @@ -24,11 +24,10 @@ module Hasura.RQL.Types.Permission ) where import Hasura.Prelude -import Hasura.RQL.Types.Common (NonEmptyText, adminText, - mkNonEmptyText, unNonEmptyText) -import Hasura.Server.Utils (adminSecretHeader, - deprecatedAccessKeyHeader, - userRoleHeader) +import Hasura.RQL.Types.Common (NonEmptyText, adminText, mkNonEmptyText, + unNonEmptyText) +import Hasura.Server.Utils (adminSecretHeader, deprecatedAccessKeyHeader, + isUserVar, userRoleHeader) import Hasura.SQL.Types import qualified Database.PG.Query as Q @@ -66,9 +65,6 @@ newtype UserVars = UserVars { unUserVars :: Map.HashMap SessVar SessVarVal} deriving (Show, Eq, FromJSON, ToJSON, Hashable) -isUserVar :: T.Text -> Bool -isUserVar = T.isPrefixOf "x-hasura-" . T.toLower - -- returns Nothing if x-hasura-role is an empty string roleFromVars :: UserVars -> Maybe RoleName roleFromVars uv = diff --git a/server/src-lib/Hasura/Server/Auth/JWT.hs b/server/src-lib/Hasura/Server/Auth/JWT.hs index 9ef2121b7992e..577c494ef623a 100644 --- a/server/src-lib/Hasura/Server/Auth/JWT.hs +++ b/server/src-lib/Hasura/Server/Auth/JWT.hs @@ -16,20 +16,18 @@ import Control.Monad (when) import Data.IORef (IORef, modifyIORef, readIORef) import Data.List (find) -import Data.Time.Clock (NominalDiffTime, UTCTime, - diffUTCTime, getCurrentTime) +import Data.Time.Clock (NominalDiffTime, UTCTime, diffUTCTime, + getCurrentTime) import Data.Time.Format (defaultTimeLocale, parseTimeM) import Network.URI (URI) import Hasura.HTTP -import Hasura.Logging (Hasura, LogLevel (..), - Logger (..)) +import Hasura.Logging (Hasura, LogLevel (..), Logger (..)) import Hasura.Prelude import Hasura.RQL.Types import Hasura.Server.Auth.JWT.Internal (parseHmacKey, parseRsaKey) import Hasura.Server.Auth.JWT.Logging -import Hasura.Server.Utils (diffTimeToMicro, fmapL, - userRoleHeader) +import Hasura.Server.Utils (diffTimeToMicro, fmapL, userRoleHeader) import qualified Control.Concurrent as C import qualified Crypto.JWT as Jose @@ -261,7 +259,7 @@ processAuthZHeader jwtCtx headers authzHeader = do hasuraClaims <- parseObjectFromString claimsFmt hasuraClaimsV -- filter only x-hasura claims and convert to lower-case - let claimsMap = Map.filterWithKey (\k _ -> T.isPrefixOf "x-hasura-" k) + let claimsMap = Map.filterWithKey (\k _ -> isUserVar k) $ Map.fromList $ map (first T.toLower) $ Map.toList hasuraClaims @@ -437,4 +435,3 @@ instance A.FromJSON JWTConfig where runEither = either (invalidJwk . T.unpack) return invalidJwk msg = fail ("Invalid JWK: " <> msg) - diff --git a/server/src-lib/Hasura/Server/Utils.hs b/server/src-lib/Hasura/Server/Utils.hs index c0ea7cb4e8215..26c37686b1693 100644 --- a/server/src-lib/Hasura/Server/Utils.hs +++ b/server/src-lib/Hasura/Server/Utils.hs @@ -166,6 +166,19 @@ commonResponseHeadersIgnored = , "Content-Type", "Content-Length" ] +isUserVar :: Text -> Bool +isUserVar = T.isPrefixOf "x-hasura-" . T.toLower + +mkClientHeadersForward :: [HTTP.Header] -> [HTTP.Header] +mkClientHeadersForward reqHeaders = + xForwardedHeaders <> (filterUserVars . filterRequestHeaders) reqHeaders + where + filterUserVars = filter (\(k, _) -> not $ isUserVar $ bsToTxt $ CI.original k) + xForwardedHeaders = flip mapMaybe reqHeaders $ \(hdrName, hdrValue) -> + case hdrName of + "Host" -> Just ("X-Forwarded-Host", hdrValue) + "User-Agent" -> Just ("X-Forwarded-User-Agent", hdrValue) + _ -> Nothing filterRequestHeaders :: [HTTP.Header] -> [HTTP.Header] filterRequestHeaders = diff --git a/server/src-rsr/initialise.sql b/server/src-rsr/initialise.sql index 19d762e311c3a..d3f49dea33962 100644 --- a/server/src-rsr/initialise.sql +++ b/server/src-rsr/initialise.sql @@ -690,6 +690,7 @@ CREATE TABLE hdb_catalog.hdb_action_log -- after dropping the action action_name TEXT, input_payload JSONB NOT NULL, + request_headers JSONB NOT NULL, session_variables JSONB NOT NULL, response_payload JSONB NULL, errors JSONB NULL, diff --git a/server/src-rsr/migrations/28_to_29.sql b/server/src-rsr/migrations/28_to_29.sql index 546c31ff24eb8..2ff954c12c1dc 100644 --- a/server/src-rsr/migrations/28_to_29.sql +++ b/server/src-rsr/migrations/28_to_29.sql @@ -25,6 +25,7 @@ CREATE TABLE hdb_catalog.hdb_action_log -- after dropping the action action_name TEXT, input_payload JSONB NOT NULL, + request_headers JSONB NOT NULL, session_variables JSONB NOT NULL, response_payload JSONB NULL, errors JSONB NULL, From 81806749f2a4830a6e63b2d9a9f749d28a7eb9b5 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Tue, 7 Jan 2020 14:53:08 +0530 Subject: [PATCH 31/62] add 'headers' configuration in action definition --- server/src-lib/Hasura/GraphQL/Execute.hs | 5 ++-- server/src-lib/Hasura/GraphQL/RemoteServer.hs | 10 +++---- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 22 ++++++++++----- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 2 ++ .../src-lib/Hasura/GraphQL/Schema/Action.hs | 9 ++++--- server/src-lib/Hasura/RQL/DDL/Headers.hs | 27 ++++++++++--------- server/src-lib/Hasura/RQL/Types/Action.hs | 22 ++++++++++----- 7 files changed, 57 insertions(+), 40 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Execute.hs b/server/src-lib/Hasura/GraphQL/Execute.hs index a879c851097ab..6230c713077db 100644 --- a/server/src-lib/Hasura/GraphQL/Execute.hs +++ b/server/src-lib/Hasura/GraphQL/Execute.hs @@ -387,9 +387,8 @@ execRemoteGQ reqId userInfo reqHdrs q rsi opDef = do opTy = G._todType opDef when (opTy == G.OperationTypeSubscription) $ throw400 NotSupported "subscription to remote server is not supported" - hdrs <- getHeadersFromConf hdrConf - let confHdrs = map (\(k, v) -> (CI.mk $ CS.cs k, CS.cs v)) hdrs - clientHdrs = bool [] (mkClientHeadersForward reqHdrs) fwdClientHdrs + confHdrs <- makeHeadersFromConf hdrConf + let clientHdrs = bool [] (mkClientHeadersForward reqHdrs) fwdClientHdrs -- filter out duplicate headers -- priority: conf headers > resolved userinfo vars > client headers hdrMaps = [ Map.fromList confHdrs diff --git a/server/src-lib/Hasura/GraphQL/RemoteServer.hs b/server/src-lib/Hasura/GraphQL/RemoteServer.hs index f4aa1537b78b6..ddb77ee89b513 100644 --- a/server/src-lib/Hasura/GraphQL/RemoteServer.hs +++ b/server/src-lib/Hasura/GraphQL/RemoteServer.hs @@ -10,17 +10,15 @@ import Hasura.Prelude import qualified Data.Aeson as J import qualified Data.ByteString.Lazy as BL -import qualified Data.CaseInsensitive as CI import qualified Data.HashMap.Strict as Map import qualified Data.HashSet as Set import qualified Data.Text as T -import qualified Data.Text.Encoding as T import qualified Language.GraphQL.Draft.Parser as G import qualified Language.GraphQL.Draft.Syntax as G import qualified Network.HTTP.Client as HTTP import qualified Network.Wreq as Wreq -import Hasura.RQL.DDL.Headers (getHeadersFromConf) +import Hasura.RQL.DDL.Headers (makeHeadersFromConf) import Hasura.RQL.Types import Hasura.Server.Utils (httpExceptToJSON) @@ -38,10 +36,8 @@ fetchRemoteSchema -> RemoteSchemaInfo -> m GC.RemoteGCtx fetchRemoteSchema manager name def@(RemoteSchemaInfo url headerConf _ timeout) = do - headers <- getHeadersFromConf headerConf - let hdrs = flip map headers $ - \(hn, hv) -> (CI.mk . T.encodeUtf8 $ hn, T.encodeUtf8 hv) - hdrsWithDefaults = addDefaultHeaders hdrs + headers <- makeHeadersFromConf headerConf + let hdrsWithDefaults = addDefaultHeaders headers initReqE <- liftIO $ try $ HTTP.parseRequest (show url) initReq <- either throwHttpErr pure initReqE diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 2137dd0a5e7d3..b2d6fe096d666 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -43,6 +43,7 @@ import Hasura.GraphQL.Resolve.Select (processTableSelectionSet) import Hasura.GraphQL.Validate.Field import Hasura.GraphQL.Validate.Types import Hasura.HTTP +import Hasura.RQL.DDL.Headers (HeaderConf, makeHeadersFromConf) import Hasura.RQL.DML.Select (asSingleRowJsonResp) import Hasura.RQL.Types import Hasura.Server.Utils (mkClientHeadersForward) @@ -259,7 +260,7 @@ resolveActionInsertSync field executionContext sessionVariables = do handlerPayload = ActionWebhookPayload sessionVariables inputArgs manager <- asks getter reqHeaders <- asks getter - webhookRes <- callWebhook manager reqHeaders forwardClientHeaders resolvedWebhook handlerPayload + webhookRes <- callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook handlerPayload case returnStrategy of ReturnJson -> return $ return $ encJFromJValue webhookRes ExecOnPostgres definitionList -> do @@ -272,7 +273,8 @@ resolveActionInsertSync field executionContext sessionVariables = do astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] where - SyncActionExecutionContext returnStrategy resolvedWebhook forwardClientHeaders = executionContext + SyncActionExecutionContext returnStrategy resolvedWebhook confHeaders + forwardClientHeaders = executionContext mkJsonToRecordFromExpression definitionList webhookResponseExpression = let functionName = QualifiedObject (SchemaName "pg_catalog") $ @@ -287,14 +289,19 @@ callWebhook :: (MonadIO m, MonadError QErr m) => HTTP.Manager -> [HTTP.Header] + -> [HeaderConf] -> Bool -> ResolvedWebhook -> ActionWebhookPayload -> m J.Value -callWebhook manager reqHeaders forwardClientHeaders resolvedWebhook actionWebhookPayload = do - let options = wreqOptions manager (contentType:clientHeaders) - clientHeaders = if forwardClientHeaders then mkClientHeadersForward reqHeaders else [] +callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook actionWebhookPayload = do + resolvedConfHeaders <- makeHeadersFromConf confHeaders + let clientHeaders = if forwardClientHeaders then mkClientHeadersForward reqHeaders else [] contentType = ("Content-Type", "application/json") + options = wreqOptions manager $ + -- Using HashMap to avoid duplicate headers between configuration headers + -- and client headers where configuration headers are preferred + contentType : (Map.toList . Map.fromList) (resolvedConfHeaders <> clientHeaders) postPayload = J.toJSON actionWebhookPayload url = (T.unpack $ unResolvedWebhook resolvedWebhook) httpResponse <- liftIO $ try $ try $ @@ -362,8 +369,9 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do Nothing -> return () Just definition -> do let webhookUrl = _adHandler definition - forwardClientHeaders = fromMaybe False $ _adForwardClientHeaders definition - res <- runExceptT $ callWebhook httpManager reqHeaders forwardClientHeaders webhookUrl $ + forwardClientHeaders = _adForwardClientHeaders definition + confHeaders = _adHeaders definition + res <- runExceptT $ callWebhook httpManager reqHeaders confHeaders forwardClientHeaders webhookUrl $ ActionWebhookPayload sessionVariables inputPayload case res of Left e -> setError actionId e diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index f263582e5a4e2..7317cd1e4c1d3 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -13,6 +13,7 @@ import qualified Data.Text as T import qualified Language.GraphQL.Draft.Syntax as G import Hasura.GraphQL.Validate.Types +import Hasura.RQL.DDL.Headers (HeaderConf) import Hasura.RQL.Types.Action import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.Column @@ -106,6 +107,7 @@ data SyncActionExecutionContext = SyncActionExecutionContext { _saecStrategy :: !SyncReturnStrategy , _saecWebhook :: !ResolvedWebhook + , _saecHeaders :: ![HeaderConf] , _saecForwardClientHeaders :: !Bool } deriving (Show, Eq) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 1c9ba349ddaa3..db3af70b96384 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -67,13 +67,14 @@ mkMutationField actionName actionInfo permission definitionList = where definition = _aiDefinition actionInfo actionExecutionContext = - case getActionKind definition of + case _adKind definition of ActionSynchronous -> ActionExecutionSyncWebhook $ SyncActionExecutionContext -- TODO: only covers object types (ExecOnPostgres definitionList) (_adHandler definition) - (fromMaybe False $ _adForwardClientHeaders definition) + (_adHeaders definition) + (_adForwardClientHeaders definition) ActionAsynchronous -> ActionExecutionAsync $ _apiFilter permission -- TODO: we need to capture the comment from action definition @@ -93,7 +94,7 @@ mkMutationField actionName actionInfo permission definitionList = actionFieldResponseType :: ActionName -> ActionDefinition a -> G.GType actionFieldResponseType actionName definition = - case getActionKind definition of + case _adKind definition of ActionSynchronous -> unGraphQLType $ _adOutputType definition ActionAsynchronous -> G.toGT $ G.toGT $ mkActionSelectionType actionName @@ -104,7 +105,7 @@ mkQueryField -> [(PGCol, PGScalarType)] -> Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) mkQueryField actionName definition permission definitionList = - case getActionKind definition of + case _adKind definition of ActionAsynchronous -> Just ( ActionSelectOpContext (_apiFilter permission) definitionList , fieldInfo diff --git a/server/src-lib/Hasura/RQL/DDL/Headers.hs b/server/src-lib/Hasura/RQL/DDL/Headers.hs index 3b4591780f2f6..9f2d3a40feb7d 100644 --- a/server/src-lib/Hasura/RQL/DDL/Headers.hs +++ b/server/src-lib/Hasura/RQL/DDL/Headers.hs @@ -7,7 +7,9 @@ import Hasura.RQL.Types.Error import Language.Haskell.TH.Syntax (Lift) import System.Environment (lookupEnv) +import qualified Data.CaseInsensitive as CI import qualified Data.Text as T +import qualified Network.HTTP.Types as HTTP data HeaderConf = HeaderConf HeaderName HeaderValue @@ -36,18 +38,19 @@ instance FromJSON HeaderConf where instance ToJSON HeaderConf where toJSON (HeaderConf name (HVValue val)) = object ["name" .= name, "value" .= val] - toJSON (HeaderConf name (HVEnv val)) = object ["name" .= name, "value_from_env" .= val] + toJSON (HeaderConf name (HVEnv val)) = object ["name" .= name, "value_from_env" .= val] --- | This is used by schema stitching -getHeadersFromConf :: (MonadError QErr m, MonadIO m) => [HeaderConf] -> m [(HeaderName, T.Text)] -getHeadersFromConf = mapM getHeader +-- | Resolve configuration headers +makeHeadersFromConf :: (MonadError QErr m, MonadIO m) => [HeaderConf] -> m [HTTP.Header] +makeHeadersFromConf = mapM getHeader where - getHeader :: (QErrM m, MonadIO m) => HeaderConf -> m (HeaderName, T.Text) - getHeader hconf = case hconf of - (HeaderConf name (HVValue val)) -> return (name, val) - (HeaderConf name (HVEnv val)) -> do - mEnv <- liftIO $ lookupEnv (T.unpack val) - case mEnv of - Nothing -> throw400 NotFound $ "environment variable '" <> val <> "' not set" - Just envval -> return (name, T.pack envval) + getHeader hconf = do + ((CI.mk . txtToBs) *** txtToBs) <$> + case hconf of + (HeaderConf name (HVValue val)) -> return (name, val) + (HeaderConf name (HVEnv val)) -> do + mEnv <- liftIO $ lookupEnv (T.unpack val) + case mEnv of + Nothing -> throw400 NotFound $ "environment variable '" <> val <> "' not set" + Just envval -> pure (name, T.pack envval) diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index c72b59b6b29d2..3c3a92ce7a09f 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -5,7 +5,6 @@ module Hasura.RQL.Types.Action , ActionName(..) , ActionKind(..) , ActionDefinition(..) - , getActionKind , CreateAction(..) , UpdateAction(..) , ActionDefinitionInput @@ -28,6 +27,7 @@ module Hasura.RQL.Types.Action import Data.URL.Template import Hasura.Prelude +import Hasura.RQL.DDL.Headers import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.CustomTypes import Hasura.RQL.Types.DML @@ -83,14 +83,22 @@ data ActionDefinition a = ActionDefinition { _adArguments :: ![ArgumentDefinition] , _adOutputType :: !GraphQLType - , _adKind :: !(Maybe ActionKind) - , _adForwardClientHeaders :: !(Maybe Bool) + , _adKind :: !ActionKind + , _adHeaders :: ![HeaderConf] + , _adForwardClientHeaders :: !Bool , _adHandler :: !a } deriving (Show, Eq, Lift, Functor, Foldable, Traversable, Generic) -$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ActionDefinition) - -getActionKind :: ActionDefinition a -> ActionKind -getActionKind = fromMaybe ActionSynchronous . _adKind +$(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionDefinition) + +instance (J.FromJSON a) => J.FromJSON (ActionDefinition a) where + parseJSON = J.withObject "ActionDefinition" $ \o -> + ActionDefinition + <$> o J..: "arguments" + <*> o J..: "output_type" + <*> o J..:? "kind" J..!= ActionSynchronous -- Synchronous is default action kind + <*> o J..:? "headers" J..!= [] + <*> o J..:? "forward_client_headers" J..!= False + <*> o J..: "handler" type ResolvedActionDefinition = ActionDefinition ResolvedWebhook From 694791bfa9f7a247ffc99bdae338853ba975afe5 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Tue, 7 Jan 2020 16:33:02 +0530 Subject: [PATCH 32/62] handle webhook error response based on status codes --- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 60 ++++++++++--------- 1 file changed, 33 insertions(+), 27 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index b2d6fe096d666..37e8974dfa5a6 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -204,19 +204,23 @@ data ActionWebhookPayload } deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookPayload) -data ActionWebhookError - = ActionWebhookError - { _aweCode :: !(Maybe Text) - , _aweMessage :: !(Maybe Text) +newtype ActionWebhookSuccess + = ActionWebhookSuccess {_awsData :: Maybe J.Value} + deriving (Show, Eq) +$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookSuccess) + +data ActionWebhookErrorResponse + = ActionWebhookErrorResponse + { _awerMessage :: !Text + , _awerCode :: !(Maybe Text) } deriving (Show, Eq) +$(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''ActionWebhookErrorResponse) + +newtype ActionWebhookError + = ActionWebhookError {_aweErrors :: Maybe ActionWebhookErrorResponse} + deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookError) -data ActionWebhookResponse - = ActionWebhookResponse - { _awrData :: !(Maybe J.Value) - , _awrErrors :: !(Maybe ActionWebhookError) - } deriving (Show, Eq) -$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookResponse) data ResolvePlan = ResolveReturn @@ -315,23 +319,25 @@ callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook J.toJSON e Right (Right responseWreq) -> do let responseValue = responseWreq ^. Wreq.responseBody - response <- decodeValue responseValue - case (_awrData response, _awrErrors response) of - (Nothing, Nothing) -> - throw500WithDetail "internal error" $ - J.String "webhook response has neither 'data' nor 'errors'" - (Just _, Just _) -> - throw500WithDetail "internal error" $ - J.String "webhook response cannot have both 'data' and 'errors'" - (Just d, Nothing) -> return d - (Nothing, Just errorResponse) -> do - let ActionWebhookError maybeCode maybeMessage = errorResponse - code = maybe Unexpected ActionWebhookCode maybeCode - withMessage message = err500 code message - noMessagekey = "\"message\" key is not found in webhook \"errors\" response" - withoutMessage = (err500 code noMessagekey) - {qeInternal = Just $ J.object ["webhook_response" J..= responseValue]} - throwError $ maybe withoutMessage withMessage maybeMessage + responseStatus = responseWreq ^. Wreq.responseStatus + + if | HTTP.statusIsSuccessful responseStatus -> do + maybeData <- _awsData <$> decodeValue responseValue + onNothing maybeData $ throw500WithDetail "internal error" $ + "webhook response does not have 'data' key for 2xx response status" + + | HTTP.statusIsClientError responseStatus -> do + maybeError <- _aweErrors <$> decodeValue responseValue + ActionWebhookErrorResponse message maybeCode <- + onNothing maybeError $ throw500WithDetail "internal error" $ + "webhook response does not have 'errors' key for 4xx response status" + let code = maybe Unexpected ActionWebhookCode maybeCode + qErr = QErr [] responseStatus message code Nothing + throwError qErr + + | otherwise -> + throw500WithDetail "internal error" $ + J.object ["webhook_response" J..= responseValue] data ActionLogItem = ActionLogItem From 0865aac437b145d5231e19810198aa7a5f61c5f5 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 8 Jan 2020 18:37:43 +0530 Subject: [PATCH 33/62] support array relationships for custom types Now a relationship object will have a compulsory 'type' key whose value is either 'array' or 'object' --- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 10 ++--- .../Hasura/GraphQL/Schema/CustomTypes.hs | 35 +++++++++-------- server/src-lib/Hasura/RQL/DDL/CustomTypes.hs | 14 +++---- .../Hasura/RQL/DDL/Metadata/Generator.hs | 7 +++- server/src-lib/Hasura/RQL/Types/Common.hs | 6 +-- .../src-lib/Hasura/RQL/Types/CustomTypes.hs | 38 ++++++++++--------- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 4 +- 7 files changed, 61 insertions(+), 53 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index db3af70b96384..dc55ac117d781 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -153,7 +153,7 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = -- all the possible field references fieldReferences = - Map.unions $ map _orFieldMapping $ Map.elems $ + Map.unions $ map _trFieldMapping $ Map.elems $ _aotRelationships annotatedOutputType mkPGFieldType fieldName (fieldType, fieldTypeInfo) = @@ -192,22 +192,22 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = relationships = flip map (Map.toList $ _aotRelationships annotatedOutputType) $ \(relationshipName, relationship) -> - let remoteTableInfo = _orRemoteTable relationship + let remoteTableInfo = _trRemoteTable relationship remoteTable = _tiName remoteTableInfo filterAndLimitM = getFilterAndLimit remoteTableInfo columnMapping = [ (unsafePGCol $ coerce k, pgiColumn v) - | (k, v) <- Map.toList $ _orFieldMapping relationship + | (k, v) <- Map.toList $ _trFieldMapping relationship ] in case filterAndLimitM of Just (tableFilter, tableLimit) -> Just ( ( actionOutputBaseType - , unObjectRelationshipName relationshipName + , unRelationshipName relationshipName ) , RFRelationship $ RelationshipField (RelInfo (RelName $ mkNonEmptyTextUnsafe $ coerce relationshipName) - ObjRel + (_trType relationship) columnMapping remoteTable True) False mempty tableFilter diff --git a/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs b/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs index fc7e3f1458b12..b04e3297bff05 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/CustomTypes.hs @@ -3,7 +3,7 @@ module Hasura.GraphQL.Schema.CustomTypes , buildCustomTypesSchema ) where -import Control.Lens +import Control.Lens import qualified Data.HashMap.Strict as Map import qualified Language.GraphQL.Draft.Syntax as G @@ -29,20 +29,23 @@ buildObjectTypeInfo roleName annotatedObjectType = relationships = flip map (toList $ _aotRelationships annotatedObjectType) $ - \(ObjectRelationship name remoteTableInfo _) -> + \(TypeRelationship name ty remoteTableInfo _) -> if isJust (getSelectPermissionInfoM remoteTableInfo roleName) || roleName == adminRole - then Just (relationshipToFieldInfo name $ _tiName remoteTableInfo) + then Just (relationshipToFieldInfo name ty $ _tiName remoteTableInfo) else Nothing where - relationshipToFieldInfo name remoteTableName = - VT.ObjFldInfo - { VT._fiDesc = Nothing -- TODO - , VT._fiName = unObjectRelationshipName name - , VT._fiParams = mempty - , VT._fiTy = G.toGT $ mkTableTy remoteTableName - , VT._fiLoc = VT.TLCustom - } + relationshipToFieldInfo name relTy remoteTableName = + let fieldTy = case relTy of + ObjRel -> G.toGT $ mkTableTy remoteTableName + ArrRel -> G.toGT $ G.toLT $ mkTableTy remoteTableName + in VT.ObjFldInfo + { VT._fiDesc = Nothing -- TODO + , VT._fiName = unRelationshipName name + , VT._fiParams = mempty + , VT._fiTy = fieldTy + , VT._fiLoc = VT.TLCustom + } fields = map convertObjectFieldDefinition $ @@ -82,20 +85,20 @@ annotateObjectType nonObjectTypeMap objectDefinition = do annotatedRelationships <- fmap Map.fromList $ forM relationships $ \relationship -> do - let relationshipName = _orName relationship - remoteTable = _orRemoteTable relationship + let relationshipName = _trName relationship + remoteTable = _trRemoteTable relationship remoteTableInfoM <- askTabInfoM remoteTable remoteTableInfo <- onNothing remoteTableInfoM $ throw500 $ "missing table info for: " <>> remoteTable annotatedFieldMapping <- - forM (_orFieldMapping relationship) $ \remoteTableColumn -> do + forM (_trFieldMapping relationship) $ \remoteTableColumn -> do let fieldName = fromPGCol remoteTableColumn onNothing (getPGColumnInfoM remoteTableInfo fieldName) $ throw500 $ "missing column info of " <> fieldName <<> " in table" <>> remoteTable return ( relationshipName - , relationship & orRemoteTable .~ remoteTableInfo - & orFieldMapping .~ annotatedFieldMapping) + , relationship & trRemoteTable .~ remoteTableInfo + & trFieldMapping .~ annotatedFieldMapping) return $ AnnotatedObjectType objectDefinition annotatedFields annotatedRelationships where diff --git a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs index 841de22b33ba0..427331e2e5d00 100644 --- a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs @@ -99,7 +99,7 @@ validateCustomTypeDefinitions customTypes = do fieldNames = map (unObjectFieldName . _ofdName) $ toList (_otdFields objectDefinition) relationships = fromMaybe [] $ _otdRelationships objectDefinition - relNames = map (unObjectRelationshipName . _orName) relationships + relNames = map (unRelationshipName . _trName) relationships duplicateFieldNames = L.duplicates $ fieldNames <> relNames fields = toList $ _otdFields objectDefinition @@ -138,9 +138,9 @@ validateCustomTypeDefinitions customTypes = do else pure Nothing for_ relationships $ \relationshipField -> do - let relationshipName = _orName relationshipField - remoteTable = _orRemoteTable relationshipField - fieldMapping = _orFieldMapping relationshipField + let relationshipName = _trName relationshipField + remoteTable = _trRemoteTable relationshipField + fieldMapping = _trFieldMapping relationshipField --check that the table exists remoteTableInfoM <- askTabInfoM remoteTable @@ -187,13 +187,13 @@ data CustomTypeValidationError | ObjectFieldObjectBaseType !ObjectTypeName !ObjectFieldName !G.NamedType -- ^ The table specified in the relationship does not exist | ObjectRelationshipTableDoesNotExist - !ObjectTypeName !ObjectRelationshipName !QualifiedTable + !ObjectTypeName !RelationshipName !QualifiedTable -- ^ The field specified in the relationship mapping does not exist | ObjectRelationshipFieldDoesNotExist - !ObjectTypeName !ObjectRelationshipName !ObjectFieldName + !ObjectTypeName !RelationshipName !ObjectFieldName -- ^ The column specified in the relationship mapping does not exist | ObjectRelationshipColumnDoesNotExist - !ObjectTypeName !ObjectRelationshipName !QualifiedTable !PGCol + !ObjectTypeName !RelationshipName !QualifiedTable !PGCol -- ^ duplicate enum values | DuplicateEnumValues !EnumTypeName !(Set.HashSet G.EnumValue) deriving (Show, Eq) diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs b/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs index 5bbba454a76b0..f672d64f0bd14 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs @@ -241,13 +241,16 @@ instance Arbitrary InputObjectFieldDefinition where instance Arbitrary InputObjectTypeDefinition where arbitrary = genericArbitrary -instance Arbitrary ObjectRelationshipName where +instance Arbitrary RelType where + arbitrary = genericArbitrary + +instance Arbitrary RelationshipName where arbitrary = genericArbitrary instance Arbitrary ObjectFieldName where arbitrary = genericArbitrary -instance Arbitrary ObjectRelationshipDefinition where +instance Arbitrary TypeRelationshipDefinition where arbitrary = genericArbitrary instance Arbitrary ObjectTypeName where diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index dc5d842349ace..c469e790c5ce7 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -102,7 +102,7 @@ relTypeToTxt ArrRel = "array" data RelType = ObjRel | ArrRel - deriving (Show, Eq, Generic) + deriving (Show, Eq, Lift, Generic) instance Hashable RelType @@ -111,8 +111,8 @@ instance ToJSON RelType where instance FromJSON RelType where parseJSON (String "object") = return ObjRel - parseJSON (String "array") = return ArrRel - parseJSON _ = fail "expecting either 'object' or 'array' for rel_type" + parseJSON (String "array") = return ArrRel + parseJSON _ = fail "expecting either 'object' or 'array' for rel_type" instance Q.FromCol RelType where fromCol bs = flip Q.fromColHelper bs $ PD.enum $ \case diff --git a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs index f76bf3c304984..c7aa7da3e2f51 100644 --- a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs @@ -12,10 +12,10 @@ module Hasura.RQL.Types.CustomTypes , InputObjectTypeDefinition(..) , ObjectFieldName(..) , ObjectFieldDefinition(..) - , ObjectRelationshipName(..) - , ObjectRelationship(..) - , orName, orRemoteTable, orFieldMapping - , ObjectRelationshipDefinition + , RelationshipName(..) + , TypeRelationship(..) + , trName, trType, trRemoteTable, trFieldMapping + , TypeRelationshipDefinition , ObjectTypeName(..) , ObjectTypeDefinition(..) , CustomTypeName @@ -49,6 +49,7 @@ import qualified Hasura.GraphQL.Validate.Types as VT import Hasura.Prelude import Hasura.RQL.Instances () import Hasura.RQL.Types.Column +import Hasura.RQL.Types.Common (RelType) import Hasura.RQL.Types.Table import Hasura.SQL.Types @@ -109,22 +110,23 @@ data ObjectFieldDefinition } deriving (Show, Eq, Lift, Generic) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectFieldDefinition) -newtype ObjectRelationshipName - = ObjectRelationshipName { unObjectRelationshipName :: G.Name } +newtype RelationshipName + = RelationshipName { unRelationshipName :: G.Name } deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift, Generic) -data ObjectRelationship t f - = ObjectRelationship - { _orName :: !ObjectRelationshipName - , _orRemoteTable :: !t - , _orFieldMapping :: !(Map.HashMap ObjectFieldName f) +data TypeRelationship t f + = TypeRelationship + { _trName :: !RelationshipName + , _trType :: !RelType + , _trRemoteTable :: !t + , _trFieldMapping :: !(Map.HashMap ObjectFieldName f) } deriving (Show, Eq, Lift, Generic) -$(makeLenses ''ObjectRelationship) +$(makeLenses ''TypeRelationship) -type ObjectRelationshipDefinition = - ObjectRelationship QualifiedTable PGCol +type TypeRelationshipDefinition = + TypeRelationship QualifiedTable PGCol -$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ObjectRelationship) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''TypeRelationship) newtype ObjectTypeName = ObjectTypeName { unObjectTypeName :: G.NamedType } @@ -136,7 +138,7 @@ data ObjectTypeDefinition { _otdName :: !ObjectTypeName , _otdDescription :: !(Maybe G.Description) , _otdFields :: !(NEList.NonEmpty ObjectFieldDefinition) - , _otdRelationships :: !(Maybe [ObjectRelationshipDefinition]) + , _otdRelationships :: !(Maybe [TypeRelationshipDefinition]) } deriving (Show, Eq, Lift, Generic) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectTypeDefinition) @@ -193,7 +195,7 @@ emptyCustomTypes :: CustomTypes emptyCustomTypes = CustomTypes Nothing Nothing Nothing Nothing type AnnotatedRelationship = - ObjectRelationship (TableInfo PGColumnInfo) PGColumnInfo + TypeRelationship (TableInfo PGColumnInfo) PGColumnInfo data OutputFieldTypeInfo = OutputFieldScalar !VT.ScalarTyInfo @@ -204,7 +206,7 @@ data AnnotatedObjectType = AnnotatedObjectType { _aotDefinition :: !ObjectTypeDefinition , _aotAnnotatedFields :: !(Map.HashMap ObjectFieldName (G.GType, OutputFieldTypeInfo)) - , _aotRelationships :: !(Map.HashMap ObjectRelationshipName AnnotatedRelationship) + , _aotRelationships :: !(Map.HashMap RelationshipName AnnotatedRelationship) } deriving (Show, Eq) instance J.ToJSON AnnotatedObjectType where diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index eb3e6f0086b59..da98deecd7e72 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -19,8 +19,8 @@ module Hasura.RQL.Types.SchemaCache , OutputFieldTypeInfo(..) , AnnotatedObjectType(..) , AnnotatedObjects - , ObjectRelationship(..) - , orName, orRemoteTable, orFieldMapping + , TypeRelationship(..) + , trName, trType, trRemoteTable, trFieldMapping , NonObjectTypeMap(..) , TableInfo(..) , askTabInfoM From d4668bfe8d4bfd8b1849b40601b32b4353bad323 Mon Sep 17 00:00:00 2001 From: Tirumarai Selvan A Date: Thu, 9 Jan 2020 15:11:31 +0530 Subject: [PATCH 34/62] temp: ignore errors on warnings --- server/Makefile | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/server/Makefile b/server/Makefile index dd98ca379663a..5bc38644c7fdb 100644 --- a/server/Makefile +++ b/server/Makefile @@ -55,7 +55,8 @@ release-image: $(project).cabal ci-binary: mkdir -p packaging/build/rootfs # --no-terminal for a cleaner output in circleci - stack $(STACK_FLAGS) build --no-terminal --test --no-run-tests --bench --no-run-benchmarks --ghc-options=-Werror $(BUILD_FLAGS) + # TODO: add --ghc-options=-Werror + stack $(STACK_FLAGS) build --no-terminal --test --no-run-tests --bench --no-run-benchmarks $(BUILD_FLAGS) mkdir -p $(build_output) cp $(build_dir)/$(project)/$(project) $(build_dir)/graphql-engine-tests/graphql-engine-tests $(build_output) echo "$(VERSION)" > $(build_output)/version.txt From 8323c301ff9a0ff21ae3d1fc5cd0c8a604cf3d60 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Fri, 17 Jan 2020 19:50:06 +0530 Subject: [PATCH 35/62] implement single row mutation, see https://github.com/hasura/graphql-engine/issues/3731 --- server/src-lib/Hasura/GraphQL/Resolve.hs | 12 +- .../src-lib/Hasura/GraphQL/Resolve/BoolExp.hs | 18 +++ .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 31 ++++- .../Hasura/GraphQL/Resolve/Mutation.hs | 130 +++++++++++++++--- .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 16 --- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 5 +- server/src-lib/Hasura/GraphQL/Schema.hs | 30 +++- .../src-lib/Hasura/GraphQL/Schema/Common.hs | 6 + .../Hasura/GraphQL/Schema/Mutation/Common.hs | 27 ++++ .../Hasura/GraphQL/Schema/Mutation/Delete.hs | 21 +++ .../Hasura/GraphQL/Schema/Mutation/Insert.hs | 40 +++++- .../Hasura/GraphQL/Schema/Mutation/Update.hs | 43 +++++- .../src-lib/Hasura/GraphQL/Schema/Select.hs | 5 +- .../Hasura/RQL/DDL/Metadata/Generator.hs | 6 +- server/src-lib/Hasura/RQL/DML/Mutation.hs | 27 ++++ server/src-lib/Hasura/RQL/DML/Returning.hs | 3 + server/src-lib/Hasura/RQL/Types/Table.hs | 15 +- 17 files changed, 372 insertions(+), 63 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 91ecebe9cec09..4435afe74e268 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -142,15 +142,23 @@ mutFldToTx fld = do opCtx <- getOpCtx $ V._fName fld case opCtx of MCInsert ctx -> do - let roleName = userRole userInfo validateHdrs userInfo (_iocHeaders ctx) - RI.convertInsert roleName (_iocTable ctx) fld + RI.convertInsert (userRole userInfo) (_iocTable ctx) fld + MCInsertOne ctx -> do + validateHdrs userInfo (_iocHeaders ctx) + RI.convertInsertOne (userRole userInfo) (_iocTable ctx) fld MCUpdate ctx -> do validateHdrs userInfo (_uocHeaders ctx) RM.convertUpdate ctx fld + MCUpdateByPk ctx -> do + validateHdrs userInfo (_uocHeaders ctx) + RM.convertUpdateByPk ctx fld MCDelete ctx -> do validateHdrs userInfo (_docHeaders ctx) RM.convertDelete ctx fld + MCDeleteByPk ctx -> do + validateHdrs userInfo (_docHeaders ctx) + RM.convertDeleteByPk ctx fld MCAction ctx -> RA.resolveActionInsert fld ctx (userVars userInfo) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs index 2bdb9008a6205..48680e47310b4 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/BoolExp.hs @@ -1,5 +1,6 @@ module Hasura.GraphQL.Resolve.BoolExp ( parseBoolExp + , pgColValToBoolExp ) where import Data.Has @@ -187,3 +188,20 @@ parseBoolExp annGVal = do | k == "_not" -> BoolNot <$> parseBoolExp v | otherwise -> BoolFld <$> parseColExp nt k v return $ BoolAnd $ fromMaybe [] boolExpsM + +type PGColValMap = Map.HashMap G.Name AnnInpVal + +pgColValToBoolExp + :: (MonadReusability m, MonadError QErr m) + => PGColArgMap -> PGColValMap -> m AnnBoolExpUnresolved +pgColValToBoolExp colArgMap colValMap = do + colExps <- forM colVals $ \(name, val) -> + BoolFld <$> do + opExp <- AEQ True . mkParameterizablePGValue <$> asPGColumnValue val + colInfo <- onNothing (Map.lookup name colArgMap) $ + throw500 $ "column name " <> showName name + <> " not found in column arguments map" + return $ AVCol colInfo [opExp] + return $ BoolAnd colExps + where + colVals = Map.toList colValMap diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index e389cb01bd833..6b730b0605576 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -1,5 +1,7 @@ module Hasura.GraphQL.Resolve.Insert - (convertInsert) + ( convertInsert + , convertInsertOne + ) where import Control.Arrow ((>>>)) @@ -530,6 +532,33 @@ convertInsert role tn fld = prefixErrPath fld $ do arguments = _fArguments fld onConflictM = Map.lookup "on_conflict" arguments +convertInsertOne + :: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r, Has InsCtxMap r + ) + => RoleName + -> QualifiedTable -- table + -> Field -- the mutation field + -> m RespTx +convertInsertOne role qt field = prefixErrPath field $ do + tableSelFields <- processTableSelectionSet (_fType field) $ _fSelSet field + let mutationFieldsUnResolved = RR.onlyReturningMutFld tableSelFields + mutationFieldsResolved <- RR.traverseMutFlds resolveValTxt mutationFieldsUnResolved + annInputObj <- withArg arguments "object" asObject + InsCtx vn tableColMap defValMap relInfoMap updPerm <- getInsCtx qt + annInsertObj <- mkAnnInsObj relInfoMap tableColMap annInputObj + conflictClauseM <- forM (Map.lookup "on_conflict" arguments) $ parseOnConflict qt updPerm tableColMap + defValMapRes <- mapM (convPartialSQLExp sessVarFromCurrentSetting) defValMap + let multiObjIns = AnnIns [annInsertObj] conflictClauseM vn tableCols defValMapRes + tableCols = Map.elems tableColMap + strfyNum <- stringifyNum <$> asks getter + pure $ do + response <- prefixErrPath field $ insertMultipleObjects strfyNum role qt + multiObjIns [] mutationFieldsResolved "object" + withSingleTableRow response + where + arguments = _fArguments field + -- helper functions getInsCtx :: (MonadError QErr m, MonadReader r m, Has InsCtxMap r) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index b7bdf664f6f99..29836c1af8524 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -1,6 +1,8 @@ module Hasura.GraphQL.Resolve.Mutation ( convertUpdate + , convertUpdateByPk , convertDelete + , convertDeleteByPk , convertMutResp , buildEmptyMutResp ) where @@ -18,6 +20,7 @@ import qualified Data.Text as T import qualified Language.GraphQL.Draft.Syntax as G import qualified Hasura.RQL.DML.Delete as RD +import qualified Hasura.RQL.DML.Mutation as RM import qualified Hasura.RQL.DML.Returning as RR import qualified Hasura.RQL.DML.Update as RU @@ -111,18 +114,17 @@ convDeleteAtPathObj colGNameMap val = return (pgCol, UVSQL sqlExp) convertUpdateP1 - :: ( MonadReusability m, MonadError QErr m - , MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r - ) + :: (MonadReusability m, MonadError QErr m) => UpdOpCtx -- the update context + -> (ArgsMap -> m AnnBoolExpUnresolved) -- the bool expression parser + -> (Field -> m (RR.MutFldsG UnresolvedVal)) -- the selection set resolver -> Field -- the mutation field -> m (RU.AnnUpdG UnresolvedVal) -convertUpdateP1 opCtx fld = do +convertUpdateP1 opCtx boolExpParser selectionResolver fld = do -- a set expression is same as a row object setExpM <- resolveUpdateOperator "_set" $ convertRowObj colGNameMap -- where bool expression to filter column - whereExp <- withArg args "where" parseBoolExp + whereExp <- boolExpParser args -- increment operator on integer columns incExpM <- resolveUpdateOperator "_inc" $ convObjWithOp' $ rhsExpOp S.incOp S.intTypeAnn @@ -147,7 +149,7 @@ convertUpdateP1 opCtx fld = do , deleteKeyExpM, deleteElemExpM, deleteAtPathExpM ] - mutFlds <- convertMutResp (_fType fld) $ _fSelSet fld + mutFlds <- selectionResolver fld pure $ RU.AnnUpd tn updateItems (unresolvedPermFilter, whereExp) mutFlds allCols where @@ -184,16 +186,18 @@ convertUpdateP1 opCtx fld = do columnsWithMultiOps) Right items -> pure $ resolvedPreSetItems <> OMap.toList items -convertUpdate +convertUpdateGeneric :: ( MonadReusability m, MonadError QErr m - , MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r + , MonadReader r m + , Has SQLGenCtx r ) => UpdOpCtx -- the update context - -> Field -- the mutation field + -> (ArgsMap -> m AnnBoolExpUnresolved) -- the bool exp parser + -> (Field -> m (RR.MutFldsG UnresolvedVal)) -- the selection set resolver + -> Field -> m RespTx -convertUpdate opCtx fld = do - annUpdUnresolved <- convertUpdateP1 opCtx fld +convertUpdateGeneric opCtx boolExpParser selectionResolver fld = do + annUpdUnresolved <- convertUpdateP1 opCtx boolExpParser selectionResolver fld (annUpdResolved, prepArgs) <- withPrepArgs $ RU.traverseAnnUpd resolveValPrep annUpdUnresolved strfyNum <- stringifyNum <$> asks getter @@ -205,17 +209,47 @@ convertUpdate opCtx fld = do -- update and return empty mutation response bool whenNonEmptyItems whenEmptyItems $ null $ RU.uqp1SetExps annUpdResolved -convertDelete +convertUpdate :: ( MonadReusability m, MonadError QErr m , MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) + => UpdOpCtx -- the update context + -> Field -- the mutation field + -> m RespTx +convertUpdate opCtx = + convertUpdateGeneric opCtx whereExpressionParser mutationFieldsResolver + +convertUpdateByPk + :: ( MonadReusability m, MonadError QErr m + , MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => UpdOpCtx -- the update context + -> Field -- the mutation field + -> m RespTx +convertUpdateByPk opCtx field = do + responseTx <- convertUpdateGeneric opCtx boolExpParser tableSelAsMutationFields field + pure $ do + response <- responseTx + RM.withSingleTableRow response + where + boolExpParser = primaryKeyColumnsToBoolExp (_uocAllCols opCtx) + + +convertDeleteGeneric + :: ( MonadReusability m + , MonadReader r m + , Has SQLGenCtx r + ) => DelOpCtx -- the delete context + -> (ArgsMap -> m AnnBoolExpUnresolved) -- the bool exp parser + -> (Field -> m (RR.MutFldsG UnresolvedVal)) -- the selection set resolver -> Field -- the mutation field -> m RespTx -convertDelete opCtx fld = do - whereExp <- withArg (_fArguments fld) "where" parseBoolExp - mutFlds <- convertMutResp (_fType fld) $ _fSelSet fld +convertDeleteGeneric opCtx boolExpParser selectionResolver fld = do + whereExp <- boolExpParser $ _fArguments fld + mutFlds <- selectionResolver fld let unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal filterExp annDelUnresolved = RD.AnnDel tn (unresolvedPermFltr, whereExp) @@ -225,7 +259,67 @@ convertDelete opCtx fld = do strfyNum <- stringifyNum <$> asks getter return $ RD.deleteQueryToTx strfyNum (annDelResolved, prepArgs) where - DelOpCtx tn _ filterExp allCols = opCtx + DelOpCtx tn _ colGNameMap filterExp = opCtx + allCols = Map.elems colGNameMap + +convertDelete + :: ( MonadReusability m, MonadError QErr m + , MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => DelOpCtx -- the delete context + -> Field -- the mutation field + -> m RespTx +convertDelete opCtx = + convertDeleteGeneric opCtx whereExpressionParser mutationFieldsResolver + +convertDeleteByPk + :: ( MonadReusability m, MonadError QErr m + , MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => DelOpCtx -- the delete context + -> Field -- the mutation field + -> m RespTx +convertDeleteByPk opCtx field = do + responseTx <- convertDeleteGeneric opCtx boolExpParser tableSelAsMutationFields field + pure $ do + response <- responseTx + RM.withSingleTableRow response + where + boolExpParser = primaryKeyColumnsToBoolExp (_docAllCols opCtx) + +whereExpressionParser + :: ( MonadReusability m, MonadError QErr m + , MonadReader r m, Has FieldMap r + ) + => ArgsMap -> m AnnBoolExpUnresolved +whereExpressionParser args = withArg args "where" parseBoolExp + +primaryKeyColumnsToBoolExp + :: (MonadReusability m, MonadError QErr m) + => PGColGNameMap -> ArgsMap -> m AnnBoolExpUnresolved +primaryKeyColumnsToBoolExp colGNameMap args = withArg args "pk_columns" $ \inpVal -> do + obj <- asObject inpVal + pgColValToBoolExp colGNameMap $ Map.fromList $ OMap.toList obj + +mutationFieldsResolver + :: ( MonadReusability m, MonadError QErr m + , MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => Field -> m (RR.MutFldsG UnresolvedVal) +mutationFieldsResolver field = convertMutResp (_fType field) $ _fSelSet field + +tableSelAsMutationFields + :: ( MonadReusability m, MonadError QErr m + , MonadReader r m, Has FieldMap r + , Has OrdByCtx r, Has SQLGenCtx r + ) + => Field -> m (RR.MutFldsG UnresolvedVal) +tableSelAsMutationFields field = do + annFlds <- processTableSelectionSet (_fType field) $ _fSelSet field + pure $ RR.onlyReturningMutFld annFlds -- | build mutation response for empty objects buildEmptyMutResp :: RR.MutFlds -> EncJSON diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 36f4513a85646..9de29075a6b73 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -297,22 +297,6 @@ parseLimit v = do type AnnSimpleSel = RS.AnnSimpleSelG UnresolvedVal -type PGColValMap = Map.HashMap G.Name AnnInpVal - -pgColValToBoolExp - :: (MonadReusability m, MonadError QErr m) => PGColArgMap -> PGColValMap -> m AnnBoolExpUnresolved -pgColValToBoolExp colArgMap colValMap = do - colExps <- forM colVals $ \(name, val) -> - BoolFld <$> do - opExp <- AEQ True . mkParameterizablePGValue <$> asPGColumnValue val - colInfo <- onNothing (Map.lookup name colArgMap) $ - throw500 $ "column name " <> showName name - <> " not found in column arguments map" - return $ AVCol colInfo [opExp] - return $ BoolAnd colExps - where - colVals = Map.toList colValMap - fromFieldByPKey :: ( MonadReusability m , MonadError QErr m diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 7e2f9b7b2740c..5a92d4434bff1 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -37,8 +37,11 @@ data QueryCtx data MutationCtx = MCInsert !InsOpCtx + | MCInsertOne !InsOpCtx | MCUpdate !UpdOpCtx + | MCUpdateByPk !UpdOpCtx | MCDelete !DelOpCtx + | MCDeleteByPk !DelOpCtx | MCAction !ActionExecutionContext deriving (Show, Eq) @@ -94,8 +97,8 @@ data DelOpCtx = DelOpCtx { _docTable :: !QualifiedTable , _docHeaders :: ![T.Text] + , _docAllCols :: !PGColGNameMap , _docFilter :: !AnnBoolExpPartialSQL - , _docAllCols :: ![PGColumnInfo] } deriving (Show, Eq) data SyncReturnStrategy diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 07f41ce1b0eec..6a1448717d79f 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -165,6 +165,7 @@ mkGCtxRole' tn descM insPermM selPermM updColsM delPermM pkeyCols constraints vi [ TIInpObj <$> mutHelper viIsInsertable insInpObjM , TIInpObj <$> mutHelper viIsUpdatable updSetInpObjM , TIInpObj <$> mutHelper viIsUpdatable updIncInpObjM + , TIInpObj <$> mutHelper (\vi -> viIsDeletable vi || viIsUpdatable vi) primaryKeysInpObjM , TIObj <$> mutRespObjM , TIEnum <$> selColInpTyM ] @@ -198,6 +199,9 @@ mkGCtxRole' tn descM insPermM selPermM updColsM delPermM pkeyCols constraints vi -- fields used in set input object updSetInpObjFldsM = mkColFldMap (mkUpdSetTy tn) <$> updColsM + -- primary key columns input object + primaryKeysInpObjM = mkPKeyColumnsInpObj tn <$> pkeyCols + selFldsM = snd <$> selPermM selColNamesM = (map pgiName . getPGColumnFields) <$> selFldsM selColInpTyM = mkSelColumnTy tn <$> selColNamesM @@ -343,16 +347,18 @@ getRootFldsRole' tn primaryKey constraints fields funcs insM ] , _rootMutationFields = makeFieldMap $ catMaybes [ mutHelper viIsInsertable getInsDet insM + , mutHelper viIsInsertable getInsOneDet insM , mutHelper viIsUpdatable getUpdDet updM + , mutHelper viIsUpdatable getUpdByPkDet $ (,) <$> updM <*> primaryKey , mutHelper viIsDeletable getDelDet delM + , mutHelper viIsDeletable getDelByPkDet $ (,) <$> delM <*> primaryKey ] } where makeFieldMap = mapFromL (_fiName . snd) customRootFields = _tcCustomRootFields tableConfig - colGNameMap = mkPGColGNameMap $ getValidCols fields + colGNameMap = mkPGColGNameMap $ getCols fields - allCols = getCols fields funcQueries = maybe [] getFuncQueryFlds selM funcAggQueries = maybe [] getFuncAggQueryFlds selM @@ -369,17 +375,35 @@ getRootFldsRole' tn primaryKey constraints fields funcs insM , mkInsMutFld insCustName tn isUpsertable ) + insOneCustName = getCustomNameWith _tcrfInsertOne + getInsOneDet (hdrs, upsertPerm) = + let isUpsertable = upsertable constraints upsertPerm $ isJust viM + in ( MCInsertOne $ InsOpCtx tn $ hdrs `union` maybe [] (\(_, _, _, x) -> x) updM + , mkInsertOneMutationField insOneCustName tn isUpsertable + ) + updCustName = getCustomNameWith _tcrfUpdate getUpdDet (updCols, preSetCols, updFltr, hdrs) = ( MCUpdate $ UpdOpCtx tn hdrs colGNameMap updFltr preSetCols , mkUpdMutFld updCustName tn updCols ) + updByPkCustName = getCustomNameWith _tcrfUpdateByPk + getUpdByPkDet ((updCols, preSetCols, updFltr, hdrs), pKey) = + ( MCUpdateByPk $ UpdOpCtx tn hdrs colGNameMap updFltr preSetCols + , mkUpdateByPkMutationField updByPkCustName tn updCols pKey + ) + delCustName = getCustomNameWith _tcrfDelete getDelDet (delFltr, hdrs) = - ( MCDelete $ DelOpCtx tn hdrs delFltr allCols + ( MCDelete $ DelOpCtx tn hdrs colGNameMap delFltr , mkDelMutFld delCustName tn ) + delByPkCustName = getCustomNameWith _tcrfDeleteByPk + getDelByPkDet ((delFltr, hdrs), pKey) = + ( MCDeleteByPk $ DelOpCtx tn hdrs colGNameMap delFltr + , mkDeleteByPkMutationField delByPkCustName tn pKey + ) selCustName = getCustomNameWith _tcrfSelect diff --git a/server/src-lib/Hasura/GraphQL/Schema/Common.hs b/server/src-lib/Hasura/GraphQL/Schema/Common.hs index f3cc4e9ed3cff..df51b9c725a6a 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Common.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Common.hs @@ -20,6 +20,7 @@ module Hasura.GraphQL.Schema.Common , mkTableAggTy , mkColumnEnumVal + , mkColumnInputVal , mkDescriptionWith , mkDescription @@ -102,6 +103,11 @@ mkColumnEnumVal :: G.Name -> EnumValInfo mkColumnEnumVal colName = EnumValInfo (Just "column name") (G.EnumValue colName) False +mkColumnInputVal :: PGColumnInfo -> InpValInfo +mkColumnInputVal ci = + InpValInfo (mkDescription <$> pgiDescription ci) (pgiName ci) + Nothing $ G.toGT $ G.toNT $ mkColumnType $ pgiType ci + mkDescriptionWith :: Maybe PGDescription -> Text -> G.Description mkDescriptionWith descM defaultTxt = G.Description $ case descM of Nothing -> defaultTxt diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs index b1c61c3694c47..218d024f4007c 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs @@ -2,6 +2,8 @@ module Hasura.GraphQL.Schema.Mutation.Common ( mkPGColInp , mkMutRespTy , mkMutRespObj + , mkPKeyColumnsInpObj + , primaryKeyColumnsInp ) where import qualified Data.HashMap.Strict as Map @@ -49,3 +51,28 @@ mkMutRespObj tn sel = G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableTy tn where desc = "data of the affected rows by the mutation" + +{- +input table_pk_columns_input { + col1: col-ty1! + col2: col-ty2! +} + +where col1, col2 are primary key columns +-} + +mkPKeyColumnsInpTy :: QualifiedTable -> G.NamedType +mkPKeyColumnsInpTy qt = + G.NamedType $ qualObjectToName qt <> "_pk_columns_input" + +mkPKeyColumnsInpObj :: QualifiedTable -> PrimaryKey PGColumnInfo -> InpObjTyInfo +mkPKeyColumnsInpObj qt primaryKey = + mkHsraInpTyInfo (Just description) (mkPKeyColumnsInpTy qt) $ + fromInpValL $ map mkColumnInputVal $ toList $ _pkColumns primaryKey + where + description = G.Description $ "primary key columns input for table: " <>> qt + +primaryKeyColumnsInp :: QualifiedTable -> InpValInfo +primaryKeyColumnsInp qt = + InpValInfo Nothing "pk_columns" Nothing $ G.toGT $ G.toNT $ + mkPKeyColumnsInpTy qt diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs index c5b6330fcc350..0463354ea8b1c 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs @@ -1,5 +1,6 @@ module Hasura.GraphQL.Schema.Mutation.Delete ( mkDelMutFld + , mkDeleteByPkMutationField ) where import qualified Language.GraphQL.Draft.Syntax as G @@ -9,6 +10,7 @@ import Hasura.GraphQL.Schema.Common import Hasura.GraphQL.Schema.Mutation.Common import Hasura.GraphQL.Validate.Types import Hasura.Prelude +import Hasura.RQL.Types import Hasura.SQL.Types {- @@ -33,3 +35,22 @@ mkDelMutFld mCustomName tn = filterArg = InpValInfo (Just filterArgDesc) "where" Nothing $ G.toGT $ G.toNT $ mkBoolExpTy tn + +{- +delete_table_by_pk( +pk_columns: table_pk_columns_input! +): table +-} + +mkDeleteByPkMutationField + :: Maybe G.Name + -> QualifiedTable + -> PrimaryKey PGColumnInfo + -> ObjFldInfo +mkDeleteByPkMutationField mCustomName qt _ = + mkHsraObjFldInfo (Just description) fieldName (fromInpValL inputArgs) $ + G.toGT $ mkTableTy qt + where + description = G.Description $ "delete single row from the table: " <>> qt + fieldName = flip fromMaybe mCustomName $ "delete_" <> qualObjectToName qt <> "_by_pk" + inputArgs = pure $ primaryKeyColumnsInp qt diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Insert.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Insert.hs index 8bc581fddf5dc..2adcb2917921d 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Insert.hs @@ -3,6 +3,7 @@ module Hasura.GraphQL.Schema.Mutation.Insert , mkInsInpTy , mkRelInsInps , mkInsMutFld + , mkInsertOneMutationField , mkOnConflictTypes ) where @@ -159,7 +160,7 @@ mkInsMutFld mCustomName tn isUpsertable = mkHsraObjFldInfo (Just desc) fldName (fromInpValL inputVals) $ G.toGT $ mkMutRespTy tn where - inputVals = catMaybes [Just objectsArg , onConflictInpVal] + inputVals = catMaybes [Just objectsArg , mkOnConflictInputVal tn isUpsertable] desc = G.Description $ "insert data into the table: " <>> tn @@ -171,12 +172,6 @@ mkInsMutFld mCustomName tn isUpsertable = InpValInfo (Just objsArgDesc) "objects" Nothing $ G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkInsInpTy tn - onConflictInpVal = bool Nothing (Just onConflictArg) isUpsertable - - onConflictDesc = "on conflict condition" - onConflictArg = InpValInfo (Just onConflictDesc) "on_conflict" - Nothing $ G.toGT $ mkOnConflictInpTy tn - mkConstraintTy :: QualifiedTable -> [ConstraintName] -> EnumTyInfo mkConstraintTy tn cons = enumTyInfo where @@ -208,3 +203,34 @@ mkOnConflictTypes tn uniqueOrPrimaryCons cols = , TIEnum $ mkUpdColumnTy tn cols , TIInpObj $ mkOnConflictInp tn ] + +mkOnConflictInputVal :: QualifiedTable -> Bool -> Maybe InpValInfo +mkOnConflictInputVal qt = + bool Nothing (Just onConflictArg) + where + onConflictDesc = "on conflict condition" + onConflictArg = InpValInfo (Just onConflictDesc) "on_conflict" + Nothing $ G.toGT $ mkOnConflictInpTy qt + + +{- +insert_table_one( + object: table_insert_input! + on_conflict: table_on_conflict + ): table +-} + +mkInsertOneMutationField :: Maybe G.Name -> QualifiedTable -> Bool -> ObjFldInfo +mkInsertOneMutationField mCustomName qt isUpsertable = + mkHsraObjFldInfo (Just description) fieldName (fromInpValL inputVals) $ + G.toGT $ mkTableTy qt + where + description = G.Description $ "insert a single row into the table: " <>> qt + + fieldName = flip fromMaybe mCustomName $ "insert_" <> qualObjectToName qt <> "_one" + + inputVals = catMaybes [Just objectArg, mkOnConflictInputVal qt isUpsertable] + + objectArgDesc = "the row to be inserted" + objectArg = InpValInfo (Just objectArgDesc) "object" Nothing $ G.toGT $ + G.toNT $ mkInsInpTy qt diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs index 614d5c59febfb..b1c4f0507e17b 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs @@ -4,6 +4,7 @@ module Hasura.GraphQL.Schema.Mutation.Update , mkUpdJSONOpInp , mkUpdSetTy , mkUpdMutFld + , mkUpdateByPkMutationField ) where import qualified Language.GraphQL.Draft.Syntax as G @@ -223,13 +224,21 @@ mkJSONOpInpVals tn cols = bool jsonbOpArgs [] $ null jsonbCols InpValInfo (Just deleteAtPathDesc) deleteAtPathOp Nothing $ G.toGT $ mkJSONOpTy tn deleteAtPathOp +mkUpdateOpInputs :: QualifiedTable -> [PGColumnInfo] -> [InpValInfo] +mkUpdateOpInputs qt cols = + catMaybes [Just setInp , mkIncInpVal qt cols] <> mkJSONOpInpVals qt cols + where + setArgDesc = "sets the columns of the filtered rows to the given values" + setInp = + InpValInfo (Just setArgDesc) "_set" Nothing $ G.toGT $ mkUpdSetTy qt + + mkUpdMutFld :: Maybe G.Name -> QualifiedTable -> [PGColumnInfo] -> ObjFldInfo mkUpdMutFld mCustomName tn cols = mkHsraObjFldInfo (Just desc) fldName (fromInpValL inputValues) $ G.toGT $ mkMutRespTy tn where - inputValues = [filterArg, setArg] <> incArg - <> mkJSONOpInpVals tn cols + inputValues = [filterArg] <> mkUpdateOpInputs tn cols desc = G.Description $ "update data of the table: " <>> tn defFldName = "update_" <> qualObjectToName tn @@ -240,8 +249,30 @@ mkUpdMutFld mCustomName tn cols = InpValInfo (Just filterArgDesc) "where" Nothing $ G.toGT $ G.toNT $ mkBoolExpTy tn - setArgDesc = "sets the columns of the filtered rows to the given values" - setArg = - InpValInfo (Just setArgDesc) "_set" Nothing $ G.toGT $ mkUpdSetTy tn +{- + +update_table_by_pk( + pk_columns: table_pk_columns_input! + _set : table_set_input + _inc : table_inc_input + _concat: table_concat_input + _delete_key: table_delete_key_input + _delete_elem: table_delete_elem_input + _delete_path_at: table_delete_path_at_input +) +-} + +mkUpdateByPkMutationField + :: Maybe G.Name + -> QualifiedTable + -> [PGColumnInfo] + -> PrimaryKey PGColumnInfo + -> ObjFldInfo +mkUpdateByPkMutationField mCustomName qt cols _ = + mkHsraObjFldInfo (Just description) fieldName (fromInpValL inputArgs) $ + G.toGT $ mkTableTy qt + where + description = G.Description $ "update single row of the table: " <>> qt + fieldName = flip fromMaybe mCustomName $ "update_" <> qualObjectToName qt <> "_by_pk" - incArg = maybeToList $ mkIncInpVal tn cols + inputArgs = pure (primaryKeyColumnsInp qt) <> mkUpdateOpInputs qt cols diff --git a/server/src-lib/Hasura/GraphQL/Schema/Select.hs b/server/src-lib/Hasura/GraphQL/Schema/Select.hs index fd2d0f9dbe974..e885b4147610f 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Select.hs @@ -295,11 +295,8 @@ mkSelFldPKey mCustomName tn cols = desc = G.Description $ "fetch data from the table: " <> tn <<> " using primary key columns" fldName = fromMaybe (mkTableByPkName tn) mCustomName - args = fromInpValL $ map colInpVal cols + args = fromInpValL $ map mkColumnInputVal cols ty = G.toGT $ mkTableTy tn - colInpVal ci = - InpValInfo (mkDescription <$> pgiDescription ci) (pgiName ci) - Nothing $ G.toGT $ G.toNT $ mkColumnType $ pgiType ci {- diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs b/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs index ba5784430d830..41c8ad3883707 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs @@ -61,9 +61,9 @@ instance Arbitrary TableCustomRootFields where arbitrary = uniqueRootFields where uniqueRootFields = do - (a, b, c, d, e, f) <- arbitrary - if null $ duplicates [a, b, c, d, e, f] then - pure $ TableCustomRootFields a b c d e f + (a, b, c, d, e, f, g, h, i) <- arbitrary + if null $ duplicates [a, b, c, d, e, f, g, h, i] then + pure $ TableCustomRootFields a b c d e f g h i else uniqueRootFields instance Arbitrary TableConfig where diff --git a/server/src-lib/Hasura/RQL/DML/Mutation.hs b/server/src-lib/Hasura/RQL/DML/Mutation.hs index 8ce47fef3c09e..acf6254ada6f5 100644 --- a/server/src-lib/Hasura/RQL/DML/Mutation.hs +++ b/server/src-lib/Hasura/RQL/DML/Mutation.hs @@ -3,14 +3,17 @@ module Hasura.RQL.DML.Mutation , runMutation , mutateAndFetchCols , mkSelCTEFromColVals + , withSingleTableRow ) where import Data.Aeson import Hasura.Prelude +import qualified Data.Aeson.Ordered as AO import qualified Data.HashMap.Strict as Map import qualified Data.Sequence as DS +import qualified Data.Text as T import qualified Database.PG.Query as Q import qualified Hasura.SQL.DML as S @@ -124,3 +127,27 @@ mkSelCTEFromColVals parseFn qt allCols colVals = , S.selFrom = Just $ S.mkSimpleFromExp qt , S.selWhere = Just $ S.WhereFrag $ S.BELit False } + + +-- | Note: Expecting '{"returning": [{}]}' encoded JSON +withSingleTableRow + :: MonadError QErr m => EncJSON -> m EncJSON +withSingleTableRow response = + case AO.eitherDecode $ encJToLBS response of + Left e -> throw500 $ "error occurred while parsing mutation result: " <> T.pack e + Right val -> do + obj <- asObject val + rowsVal <- onNothing (AO.lookup "returning" obj) $ + throw500 "returning field not found in mutation result" + rows <- asArray rowsVal + pure $ AO.toEncJSON $ case rows of + [] -> AO.Null + r:_ -> r + where + asObject = \case + AO.Object o -> pure o + _ -> throw500 "expecting ordered Object" + + asArray = \case + AO.Array arr -> pure $ toList arr + _ -> throw500 "expecting ordered Array" diff --git a/server/src-lib/Hasura/RQL/DML/Returning.hs b/server/src-lib/Hasura/RQL/DML/Returning.hs index 3649503467e2e..9233d3721d185 100644 --- a/server/src-lib/Hasura/RQL/DML/Returning.hs +++ b/server/src-lib/Hasura/RQL/DML/Returning.hs @@ -29,6 +29,9 @@ type MutFld = MutFldG S.SQLExp type MutFldsG v = [(T.Text, MutFldG v)] +onlyReturningMutFld :: AnnFldsG v -> MutFldsG v +onlyReturningMutFld annFlds = [("returning", MRet annFlds)] + traverseMutFlds :: (Applicative f) => (a -> f b) diff --git a/server/src-lib/Hasura/RQL/Types/Table.hs b/server/src-lib/Hasura/RQL/Types/Table.hs index 73894f995f694..77dc710eac3f0 100644 --- a/server/src-lib/Hasura/RQL/Types/Table.hs +++ b/server/src-lib/Hasura/RQL/Types/Table.hs @@ -108,8 +108,11 @@ data TableCustomRootFields , _tcrfSelectByPk :: !(Maybe G.Name) , _tcrfSelectAggregate :: !(Maybe G.Name) , _tcrfInsert :: !(Maybe G.Name) + , _tcrfInsertOne :: !(Maybe G.Name) , _tcrfUpdate :: !(Maybe G.Name) + , _tcrfUpdateByPk :: !(Maybe G.Name) , _tcrfDelete :: !(Maybe G.Name) + , _tcrfDeleteByPk :: !(Maybe G.Name) } deriving (Show, Eq, Lift, Generic) instance NFData TableCustomRootFields instance Cacheable TableCustomRootFields @@ -121,19 +124,24 @@ instance FromJSON TableCustomRootFields where selectByPk <- obj .:? "select_by_pk" selectAggregate <- obj .:? "select_aggregate" insert <- obj .:? "insert" + insertOne <- obj .:? "insert_one" update <- obj .:? "update" + updateByPk <- obj .:? "update_by_pk" delete <- obj .:? "delete" + deleteByPk <- obj .:? "delete_by_pk" let duplicateRootFields = duplicates $ catMaybes [ select, selectByPk, selectAggregate - , insert, update, delete + , insert, insertOne + , update, updateByPk + , delete, deleteByPk ] when (not $ null duplicateRootFields) $ fail $ T.unpack $ "the following custom root field names are duplicated: " <> showNames duplicateRootFields pure $ TableCustomRootFields select selectByPk selectAggregate - insert update delete + insert insertOne update updateByPk delete deleteByPk emptyCustomRootFields :: TableCustomRootFields emptyCustomRootFields = TableCustomRootFields @@ -141,8 +149,11 @@ emptyCustomRootFields = , _tcrfSelectByPk = Nothing , _tcrfSelectAggregate = Nothing , _tcrfInsert = Nothing + , _tcrfInsertOne = Nothing , _tcrfUpdate = Nothing + , _tcrfUpdateByPk = Nothing , _tcrfDelete = Nothing + , _tcrfDeleteByPk = Nothing } data FieldInfo From 596fe2afe8b0b55f4b0137cef352a0927dd0c655 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Mon, 20 Jan 2020 11:48:55 +0530 Subject: [PATCH 36/62] single row mutation: rename 'pk_columns' -> 'columns' and no-op refactor --- server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs | 10 +++++----- .../src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs | 3 +-- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index 29836c1af8524..5beb6d91a19b7 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -229,7 +229,7 @@ convertUpdateByPk -> Field -- the mutation field -> m RespTx convertUpdateByPk opCtx field = do - responseTx <- convertUpdateGeneric opCtx boolExpParser tableSelAsMutationFields field + responseTx <- convertUpdateGeneric opCtx boolExpParser tableSelectionAsMutationFields field pure $ do response <- responseTx RM.withSingleTableRow response @@ -282,7 +282,7 @@ convertDeleteByPk -> Field -- the mutation field -> m RespTx convertDeleteByPk opCtx field = do - responseTx <- convertDeleteGeneric opCtx boolExpParser tableSelAsMutationFields field + responseTx <- convertDeleteGeneric opCtx boolExpParser tableSelectionAsMutationFields field pure $ do response <- responseTx RM.withSingleTableRow response @@ -299,7 +299,7 @@ whereExpressionParser args = withArg args "where" parseBoolExp primaryKeyColumnsToBoolExp :: (MonadReusability m, MonadError QErr m) => PGColGNameMap -> ArgsMap -> m AnnBoolExpUnresolved -primaryKeyColumnsToBoolExp colGNameMap args = withArg args "pk_columns" $ \inpVal -> do +primaryKeyColumnsToBoolExp colGNameMap args = withArg args "columns" $ \inpVal -> do obj <- asObject inpVal pgColValToBoolExp colGNameMap $ Map.fromList $ OMap.toList obj @@ -311,13 +311,13 @@ mutationFieldsResolver => Field -> m (RR.MutFldsG UnresolvedVal) mutationFieldsResolver field = convertMutResp (_fType field) $ _fSelSet field -tableSelAsMutationFields +tableSelectionAsMutationFields :: ( MonadReusability m, MonadError QErr m , MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) => Field -> m (RR.MutFldsG UnresolvedVal) -tableSelAsMutationFields field = do +tableSelectionAsMutationFields field = do annFlds <- processTableSelectionSet (_fType field) $ _fSelSet field pure $ RR.onlyReturningMutFld annFlds diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs index 218d024f4007c..76f579f89f513 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs @@ -74,5 +74,4 @@ mkPKeyColumnsInpObj qt primaryKey = primaryKeyColumnsInp :: QualifiedTable -> InpValInfo primaryKeyColumnsInp qt = - InpValInfo Nothing "pk_columns" Nothing $ G.toGT $ G.toNT $ - mkPKeyColumnsInpTy qt + InpValInfo Nothing "columns" Nothing $ G.toGT $ G.toNT $ mkPKeyColumnsInpTy qt From 78ab4642cbaaa836be9ac15e3c1fa8773729c2f0 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Mon, 20 Jan 2020 16:59:07 +0530 Subject: [PATCH 37/62] use top level primary key inputs for delete_by_pk & account select permissions for single row mutations --- .../Hasura/GraphQL/Resolve/Mutation.hs | 13 +++------ server/src-lib/Hasura/GraphQL/Schema.hs | 14 +++++----- .../Hasura/GraphQL/Schema/Mutation/Common.hs | 26 ------------------ .../Hasura/GraphQL/Schema/Mutation/Delete.hs | 4 +-- .../Hasura/GraphQL/Schema/Mutation/Update.hs | 27 ++++++++++++++++++- 5 files changed, 40 insertions(+), 44 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index 5beb6d91a19b7..ef448b577f80d 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -234,7 +234,9 @@ convertUpdateByPk opCtx field = do response <- responseTx RM.withSingleTableRow response where - boolExpParser = primaryKeyColumnsToBoolExp (_uocAllCols opCtx) + boolExpParser args = withArg args "columns" $ \inpVal -> do + obj <- asObject inpVal + pgColValToBoolExp (_uocAllCols opCtx) $ Map.fromList $ OMap.toList obj convertDeleteGeneric @@ -287,7 +289,7 @@ convertDeleteByPk opCtx field = do response <- responseTx RM.withSingleTableRow response where - boolExpParser = primaryKeyColumnsToBoolExp (_docAllCols opCtx) + boolExpParser = pgColValToBoolExp (_docAllCols opCtx) whereExpressionParser :: ( MonadReusability m, MonadError QErr m @@ -296,13 +298,6 @@ whereExpressionParser => ArgsMap -> m AnnBoolExpUnresolved whereExpressionParser args = withArg args "where" parseBoolExp -primaryKeyColumnsToBoolExp - :: (MonadReusability m, MonadError QErr m) - => PGColGNameMap -> ArgsMap -> m AnnBoolExpUnresolved -primaryKeyColumnsToBoolExp colGNameMap args = withArg args "columns" $ \inpVal -> do - obj <- asObject inpVal - pgColValToBoolExp colGNameMap $ Map.fromList $ OMap.toList obj - mutationFieldsResolver :: ( MonadReusability m, MonadError QErr m , MonadReader r m, Has FieldMap r diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index 6a1448717d79f..0427f8f6a13a7 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -165,7 +165,7 @@ mkGCtxRole' tn descM insPermM selPermM updColsM delPermM pkeyCols constraints vi [ TIInpObj <$> mutHelper viIsInsertable insInpObjM , TIInpObj <$> mutHelper viIsUpdatable updSetInpObjM , TIInpObj <$> mutHelper viIsUpdatable updIncInpObjM - , TIInpObj <$> mutHelper (\vi -> viIsDeletable vi || viIsUpdatable vi) primaryKeysInpObjM + , TIInpObj <$> mutHelper viIsUpdatable primaryKeysInpObjM , TIObj <$> mutRespObjM , TIEnum <$> selColInpTyM ] @@ -199,8 +199,8 @@ mkGCtxRole' tn descM insPermM selPermM updColsM delPermM pkeyCols constraints vi -- fields used in set input object updSetInpObjFldsM = mkColFldMap (mkUpdSetTy tn) <$> updColsM - -- primary key columns input object - primaryKeysInpObjM = mkPKeyColumnsInpObj tn <$> pkeyCols + -- primary key columns input object for update_by_pk + primaryKeysInpObjM = guard (isJust selPermM) *> (mkPKeyColumnsInpObj tn <$> pkeyCols) selFldsM = snd <$> selPermM selColNamesM = (map pgiName . getPGColumnFields) <$> selFldsM @@ -347,11 +347,11 @@ getRootFldsRole' tn primaryKey constraints fields funcs insM ] , _rootMutationFields = makeFieldMap $ catMaybes [ mutHelper viIsInsertable getInsDet insM - , mutHelper viIsInsertable getInsOneDet insM + , onlyIfSelectPermExist $ mutHelper viIsInsertable getInsOneDet insM , mutHelper viIsUpdatable getUpdDet updM - , mutHelper viIsUpdatable getUpdByPkDet $ (,) <$> updM <*> primaryKey + , onlyIfSelectPermExist $ mutHelper viIsUpdatable getUpdByPkDet $ (,) <$> updM <*> primaryKey , mutHelper viIsDeletable getDelDet delM - , mutHelper viIsDeletable getDelByPkDet $ (,) <$> delM <*> primaryKey + , onlyIfSelectPermExist $ mutHelper viIsDeletable getDelByPkDet $ (,) <$> delM <*> primaryKey ] } where @@ -366,6 +366,8 @@ getRootFldsRole' tn primaryKey constraints fields funcs insM mutHelper f getDet mutM = bool Nothing (getDet <$> mutM) $ isMutable f viM + onlyIfSelectPermExist v = guard (isJust selM) *> v + getCustomNameWith f = f customRootFields insCustName = getCustomNameWith _tcrfInsert diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs index 76f579f89f513..b1c61c3694c47 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Common.hs @@ -2,8 +2,6 @@ module Hasura.GraphQL.Schema.Mutation.Common ( mkPGColInp , mkMutRespTy , mkMutRespObj - , mkPKeyColumnsInpObj - , primaryKeyColumnsInp ) where import qualified Data.HashMap.Strict as Map @@ -51,27 +49,3 @@ mkMutRespObj tn sel = G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableTy tn where desc = "data of the affected rows by the mutation" - -{- -input table_pk_columns_input { - col1: col-ty1! - col2: col-ty2! -} - -where col1, col2 are primary key columns --} - -mkPKeyColumnsInpTy :: QualifiedTable -> G.NamedType -mkPKeyColumnsInpTy qt = - G.NamedType $ qualObjectToName qt <> "_pk_columns_input" - -mkPKeyColumnsInpObj :: QualifiedTable -> PrimaryKey PGColumnInfo -> InpObjTyInfo -mkPKeyColumnsInpObj qt primaryKey = - mkHsraInpTyInfo (Just description) (mkPKeyColumnsInpTy qt) $ - fromInpValL $ map mkColumnInputVal $ toList $ _pkColumns primaryKey - where - description = G.Description $ "primary key columns input for table: " <>> qt - -primaryKeyColumnsInp :: QualifiedTable -> InpValInfo -primaryKeyColumnsInp qt = - InpValInfo Nothing "columns" Nothing $ G.toGT $ G.toNT $ mkPKeyColumnsInpTy qt diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs index 0463354ea8b1c..1e1c9282929a2 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs @@ -47,10 +47,10 @@ mkDeleteByPkMutationField -> QualifiedTable -> PrimaryKey PGColumnInfo -> ObjFldInfo -mkDeleteByPkMutationField mCustomName qt _ = +mkDeleteByPkMutationField mCustomName qt primaryKey = mkHsraObjFldInfo (Just description) fieldName (fromInpValL inputArgs) $ G.toGT $ mkTableTy qt where description = G.Description $ "delete single row from the table: " <>> qt fieldName = flip fromMaybe mCustomName $ "delete_" <> qualObjectToName qt <> "_by_pk" - inputArgs = pure $ primaryKeyColumnsInp qt + inputArgs = map mkColumnInputVal $ toList $ _pkColumns primaryKey diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs index b1c4f0507e17b..dfd6ebdf2f2ba 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs @@ -4,6 +4,7 @@ module Hasura.GraphQL.Schema.Mutation.Update , mkUpdJSONOpInp , mkUpdSetTy , mkUpdMutFld + , mkPKeyColumnsInpObj , mkUpdateByPkMutationField ) where @@ -252,7 +253,7 @@ mkUpdMutFld mCustomName tn cols = {- update_table_by_pk( - pk_columns: table_pk_columns_input! + columns: table_pk_columns_input! _set : table_set_input _inc : table_inc_input _concat: table_concat_input @@ -262,6 +263,30 @@ update_table_by_pk( ) -} +{- +input table_pk_columns_input { + col1: col-ty1! + col2: col-ty2! +} + +where col1, col2 are primary key columns +-} + +mkPKeyColumnsInpTy :: QualifiedTable -> G.NamedType +mkPKeyColumnsInpTy qt = + G.NamedType $ qualObjectToName qt <> "_pk_columns_input" + +mkPKeyColumnsInpObj :: QualifiedTable -> PrimaryKey PGColumnInfo -> InpObjTyInfo +mkPKeyColumnsInpObj qt primaryKey = + mkHsraInpTyInfo (Just description) (mkPKeyColumnsInpTy qt) $ + fromInpValL $ map mkColumnInputVal $ toList $ _pkColumns primaryKey + where + description = G.Description $ "primary key columns input for table: " <>> qt + +primaryKeyColumnsInp :: QualifiedTable -> InpValInfo +primaryKeyColumnsInp qt = + InpValInfo Nothing "columns" Nothing $ G.toGT $ G.toNT $ mkPKeyColumnsInpTy qt + mkUpdateByPkMutationField :: Maybe G.Name -> QualifiedTable From b2de9c0dd9778cb6d26cb1896bdd964eeebe8a1a Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Mon, 20 Jan 2020 17:20:58 +0530 Subject: [PATCH 38/62] use only REST semantics to resolve the webhook response --- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 20 ++----------------- 1 file changed, 2 insertions(+), 18 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index a659760ef428b..94327962ca582 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -206,11 +206,6 @@ data ActionWebhookPayload } deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookPayload) -newtype ActionWebhookSuccess - = ActionWebhookSuccess {_awsData :: Maybe J.Value} - deriving (Show, Eq) -$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookSuccess) - data ActionWebhookErrorResponse = ActionWebhookErrorResponse { _awerMessage :: !Text @@ -218,12 +213,6 @@ data ActionWebhookErrorResponse } deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''ActionWebhookErrorResponse) -newtype ActionWebhookError - = ActionWebhookError {_aweErrors :: Maybe ActionWebhookErrorResponse} - deriving (Show, Eq) -$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookError) - - data ResolvePlan = ResolveReturn | ResolvePostgres [(PGCol, PGScalarType)] ![(Text, OutputFieldResolved)] @@ -323,16 +312,11 @@ callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook let responseValue = responseWreq ^. Wreq.responseBody responseStatus = responseWreq ^. Wreq.responseStatus - if | HTTP.statusIsSuccessful responseStatus -> do - maybeData <- _awsData <$> decodeValue responseValue - onNothing maybeData $ throw500WithDetail "internal error" $ - "webhook response does not have 'data' key for 2xx response status" + if | HTTP.statusIsSuccessful responseStatus -> pure responseValue | HTTP.statusIsClientError responseStatus -> do - maybeError <- _aweErrors <$> decodeValue responseValue ActionWebhookErrorResponse message maybeCode <- - onNothing maybeError $ throw500WithDetail "internal error" $ - "webhook response does not have 'errors' key for 4xx response status" + modifyErr ("webhook response: " <>) $ decodeValue responseValue let code = maybe Unexpected ActionWebhookCode maybeCode qErr = QErr [] responseStatus message code Nothing throwError qErr From 116ac5bfdbd74b41cc081692bb6d15ea4da651f4 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Tue, 21 Jan 2020 17:57:42 +0530 Subject: [PATCH 39/62] remove warnings --- server/src-lib/Hasura/GraphQL/Resolve.hs | 18 ----------------- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 20 ++++++------------- .../src-lib/Hasura/GraphQL/Validate/Types.hs | 4 ++-- server/src-lib/Hasura/RQL/DDL/Action.hs | 2 +- 4 files changed, 9 insertions(+), 35 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 4435afe74e268..ae731b69ea358 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -26,7 +26,6 @@ import qualified Network.HTTP.Types as HTTP import Hasura.GraphQL.Resolve.Context import Hasura.Prelude -import Hasura.RQL.DML.Internal (currentSession, sessVarFromCurrentSetting) import Hasura.RQL.Types import Hasura.SQL.Types @@ -104,23 +103,6 @@ queryFldToPGAST fld = do QCActionFetch ctx -> QRFActionSelect <$> RA.resolveAsyncResponse ctx fld -queryFldToSQL - :: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r, Has UserInfo r - , Has QueryCtxMap r - ) - => PrepFn m - -> V.Field - -> m Q.Query -queryFldToSQL fn fld = do - pgAST <- queryFldToPGAST fld - resolvedAST <- flip traverseQueryRootFldAST pgAST $ \case - UVPG annPGVal -> fn annPGVal - UVSQL sqlExp -> return sqlExp - UVSessVar colTy sessVar -> sessVarFromCurrentSetting colTy sessVar - UVSession -> pure currentSession - return $ toPGQuery resolvedAST - mutFldToTx :: ( MonadReusability m , MonadError QErr m diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 94327962ca582..8a5aad538110e 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -71,9 +71,7 @@ data ResponseFieldResolved deriving (Show, Eq) resolveOutputSelectionSet - :: ( MonadError QErr m, MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r - ) + :: (MonadError QErr m) => G.NamedType -> SelSet -> m [(Text, OutputFieldResolved)] @@ -83,9 +81,7 @@ resolveOutputSelectionSet ty selSet = G.Name t -> return $ OutputFieldSimple t resolveResponseSelectionSet - :: ( MonadError QErr m, MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r - ) + :: (MonadError QErr m) => G.NamedType -> SelSet -> m [(Text, ResponseFieldResolved)] @@ -128,7 +124,7 @@ type ActionSelectResolved = ActionSelect S.SQLExp type ActionSelectUnresolved = ActionSelect UnresolvedVal actionSelectToSql :: ActionSelectResolved -> Q.Query -actionSelectToSql (ActionSelect actionIdExp selection actionFilter) = +actionSelectToSql (ActionSelect actionIdExp selection _) = Q.fromBuilder $ toSQL selectAST where selectAST = @@ -175,10 +171,6 @@ actionSelectToSql (ActionSelect actionIdExp selection actionFilter) = resolveActionSelect :: ( MonadReusability m , MonadError QErr m - , MonadReader r m - , Has FieldMap r - , Has OrdByCtx r - , Has SQLGenCtx r ) => ActionSelectOpContext -> Field @@ -456,15 +448,15 @@ resolveActionInsert field executionContext sessionVariables = resolveActionInsertAsync field actionFilter sessionVariables resolveActionInsertAsync - :: ( MonadError QErr m, MonadReader r m, Has FieldMap r - , Has OrdByCtx r, Has SQLGenCtx r, Has [HTTP.Header] r + :: ( MonadError QErr m, MonadReader r m + , Has [HTTP.Header] r ) => Field -> AnnBoolExpPartialSQL -- We need the sesion variables for column presets -> UserVars -> m RespTx -resolveActionInsertAsync field actionFilter sessionVariables = do +resolveActionInsertAsync field _ sessionVariables = do responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ _fSelSet field reqHeaders <- asks getter diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index c0f21037a3e90..99cd5aadd1a7b 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -406,10 +406,10 @@ data TypeInfo deriving (Show, Eq, TH.Lift) instance J.ToJSON TypeInfo where - toJSON typeInfo = J.String "toJSON not implemented for TypeInfo" + toJSON _ = J.String "toJSON not implemented for TypeInfo" instance J.FromJSON TypeInfo where - parseJSON value = fail "FromJSON not implemented for TypeInfo" + parseJSON _ = fail "FromJSON not implemented for TypeInfo" -- $(J.deriveJSON -- J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 2 diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index ff99e3a834681..b9782ce166fa7 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -238,7 +238,7 @@ buildActionFilter :: (QErrM m) => ActionPermissionSelect -> m AnnBoolExpPartialSQL -buildActionFilter permission = +buildActionFilter _ = return annBoolExpTrue runCreateActionPermission From 487ee82282050471c06e526d06584856ee08b20f Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 22 Jan 2020 13:00:07 +0530 Subject: [PATCH 40/62] use 'pk_columns' instead of 'columns' for update_by_pk input --- server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs | 2 +- server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs | 8 +++----- 2 files changed, 4 insertions(+), 6 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index ef448b577f80d..018c24e3a7367 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -234,7 +234,7 @@ convertUpdateByPk opCtx field = do response <- responseTx RM.withSingleTableRow response where - boolExpParser args = withArg args "columns" $ \inpVal -> do + boolExpParser args = withArg args "pk_columns" $ \inpVal -> do obj <- asObject inpVal pgColValToBoolExp (_uocAllCols opCtx) $ Map.fromList $ OMap.toList obj diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs index dfd6ebdf2f2ba..634ba2d1359b6 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Update.hs @@ -283,10 +283,6 @@ mkPKeyColumnsInpObj qt primaryKey = where description = G.Description $ "primary key columns input for table: " <>> qt -primaryKeyColumnsInp :: QualifiedTable -> InpValInfo -primaryKeyColumnsInp qt = - InpValInfo Nothing "columns" Nothing $ G.toGT $ G.toNT $ mkPKeyColumnsInpTy qt - mkUpdateByPkMutationField :: Maybe G.Name -> QualifiedTable @@ -300,4 +296,6 @@ mkUpdateByPkMutationField mCustomName qt cols _ = description = G.Description $ "update single row of the table: " <>> qt fieldName = flip fromMaybe mCustomName $ "update_" <> qualObjectToName qt <> "_by_pk" - inputArgs = pure (primaryKeyColumnsInp qt) <> mkUpdateOpInputs qt cols + inputArgs = pure primaryKeyColumnsInp <> mkUpdateOpInputs qt cols + primaryKeyColumnsInp = + InpValInfo Nothing "pk_columns" Nothing $ G.toGT $ G.toNT $ mkPKeyColumnsInpTy qt From 73687485878532ecdcccad0bc7740017f3be11fb Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 22 Jan 2020 16:15:35 +0530 Subject: [PATCH 41/62] add python basic tests for single row mutations --- server/src-lib/Data/URL/Template.hs | 6 +-- .../delete/basic/article_by_pk.yaml | 25 ++++++++++++ .../delete/basic/article_by_pk_null.yaml | 20 ++++++++++ .../insert/nested/author_one.yaml | 21 ++++++++++ .../nested/author_upsert_one_no_update.yaml | 24 ++++++++++++ .../nested/author_upsert_one_update.yaml | 26 +++++++++++++ .../nested/author_with_articles_one.yaml | 39 +++++++++++++++++++ .../update/basic/author_by_pk.yaml | 23 +++++++++++ .../update/basic/author_by_pk_null.yaml | 19 +++++++++ server/tests-py/test_graphql_mutations.py | 27 +++++++++++++ 10 files changed, 227 insertions(+), 3 deletions(-) create mode 100644 server/tests-py/queries/graphql_mutation/delete/basic/article_by_pk.yaml create mode 100644 server/tests-py/queries/graphql_mutation/delete/basic/article_by_pk_null.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/author_one.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_one_no_update.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_one_update.yaml create mode 100644 server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_one.yaml create mode 100644 server/tests-py/queries/graphql_mutation/update/basic/author_by_pk.yaml create mode 100644 server/tests-py/queries/graphql_mutation/update/basic/author_by_pk_null.yaml diff --git a/server/src-lib/Data/URL/Template.hs b/server/src-lib/Data/URL/Template.hs index f8c662a8255da..eed41c98eec62 100644 --- a/server/src-lib/Data/URL/Template.hs +++ b/server/src-lib/Data/URL/Template.hs @@ -46,8 +46,8 @@ parseURLTemplate = parseOnly parseTemplate renderURLTemplate :: MonadIO m => URLTemplate -> m (Either String Text) renderURLTemplate (URLTemplate preVar var postVar) = do maybeEnvValue <- liftIO $ lookupEnv variableString - case maybeEnvValue of - Nothing -> pure $ Left $ "Value for environment variable " <> variableString <> " not found" - Just value -> pure $ Right $ preVar <> T.pack value <> postVar + pure $ case maybeEnvValue of + Nothing -> Left $ "Value for environment variable " <> variableString <> " not found" + Just value -> Right $ preVar <> T.pack value <> postVar where variableString = T.unpack $ unVariable var diff --git a/server/tests-py/queries/graphql_mutation/delete/basic/article_by_pk.yaml b/server/tests-py/queries/graphql_mutation/delete/basic/article_by_pk.yaml new file mode 100644 index 0000000000000..f24b2ccaf896f --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/delete/basic/article_by_pk.yaml @@ -0,0 +1,25 @@ +description: Delete a row in article table by primary key +url: /v1/graphql +status: 200 +query: + query: | + mutation { + delete_article_by_pk(id: 1){ + id + title + content + author{ + id + name + } + } + } +response: + data: + delete_article_by_pk: + id: 1 + title: Article 1 + content: Sample article content 1 + author: + id: 1 + name: Author 1 diff --git a/server/tests-py/queries/graphql_mutation/delete/basic/article_by_pk_null.yaml b/server/tests-py/queries/graphql_mutation/delete/basic/article_by_pk_null.yaml new file mode 100644 index 0000000000000..1bd2c56f98efc --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/delete/basic/article_by_pk_null.yaml @@ -0,0 +1,20 @@ +description: Delete a row in article table by primary key +url: /v1/graphql +status: 200 +query: + query: | + mutation { + delete_article_by_pk(id: 6){ + id + title + content + author{ + id + name + } + } + } + +response: + data: + delete_article_by_pk: null diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_one.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_one.yaml new file mode 100644 index 0000000000000..7edc19645eb29 --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_one.yaml @@ -0,0 +1,21 @@ +description: Insert a single row in author table +url: /v1/graphql +status: 200 +query: + query: | + mutation { + insert_author_one( + object: { + name: "Author 3" + is_registered: true + } + ){ + id + name + } + } +response: + data: + insert_author_one: + id: 3 + name: Author 3 diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_one_no_update.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_one_no_update.yaml new file mode 100644 index 0000000000000..a463b166c3b86 --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_one_no_update.yaml @@ -0,0 +1,24 @@ +description: Insert a single row in author table with a conflict clause without update_columns +url: /v1/graphql +status: 200 +query: + query: | + mutation { + insert_author_one( + object: { + name: "Author 1" + is_registered: true + } + on_conflict: { + constraint:author_name_key + update_columns: [] + } + ){ + id + name + } + } + +response: + data: + insert_author_one: null diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_one_update.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_one_update.yaml new file mode 100644 index 0000000000000..6145d0e6ee7d7 --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_upsert_one_update.yaml @@ -0,0 +1,26 @@ +description: Insert a single row in author table with a conflict clause with update_columns +url: /v1/graphql +status: 200 +query: + query: | + mutation { + insert_author_one( + object: { + name: "Author 1" + is_registered: true + } + on_conflict: { + constraint:author_name_key + update_columns: [name] + } + ){ + id + name + } + } + +response: + data: + insert_author_one: + id: 1 + name: Author 1 diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_one.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_one.yaml new file mode 100644 index 0000000000000..5ec715a828e22 --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_one.yaml @@ -0,0 +1,39 @@ +description: Insert a single row with articles into author table +url: /v1/graphql +status: 200 +query: + query: | + mutation { + insert_author_one( + object: { + name: "Author 3" + is_registered: true + articles: { + data: [ + { + title: "Article 4" + content: "Article by Author 3" + } + ] + } + } + ){ + id + name + articles{ + id + title + content + } + } + } + +response: + data: + insert_author_one: + name: Author 3 + articles: + - content: Article by Author 3 + id: 4 + title: Article 4 + id: 3 diff --git a/server/tests-py/queries/graphql_mutation/update/basic/author_by_pk.yaml b/server/tests-py/queries/graphql_mutation/update/basic/author_by_pk.yaml new file mode 100644 index 0000000000000..936cb59001c3c --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/update/basic/author_by_pk.yaml @@ -0,0 +1,23 @@ +description: Update a row of author by primary key +url: /v1/graphql +status: 200 +query: + query: | + mutation { + update_author_by_pk( + pk_columns: {id: 1} + _set: {emails: "{author1@hasura.io}"} + ){ + id + name + emails + } + } + +response: + data: + update_author_by_pk: + id: 1 + name: Author 1 + emails: + - author1@hasura.io diff --git a/server/tests-py/queries/graphql_mutation/update/basic/author_by_pk_null.yaml b/server/tests-py/queries/graphql_mutation/update/basic/author_by_pk_null.yaml new file mode 100644 index 0000000000000..ba717b4e92750 --- /dev/null +++ b/server/tests-py/queries/graphql_mutation/update/basic/author_by_pk_null.yaml @@ -0,0 +1,19 @@ +description: Update a row of author by primary key +url: /v1/graphql +status: 200 +query: + query: | + mutation { + update_author_by_pk( + pk_columns: {id: 3} + _set: {emails: "{author1@hasura.io}"} + ){ + id + name + emails + } + } + +response: + data: + update_author_by_pk: null diff --git a/server/tests-py/test_graphql_mutations.py b/server/tests-py/test_graphql_mutations.py index 506d125360f46..56cbb1437b0c4 100644 --- a/server/tests-py/test_graphql_mutations.py +++ b/server/tests-py/test_graphql_mutations.py @@ -250,6 +250,18 @@ def test_articles_author_upsert_fail(self, hge_ctx, transport): def test_articles_with_author_returning(self, hge_ctx, transport): check_query_f(hge_ctx, self.dir() + "/articles_with_author_returning.yaml") + def test_author_one(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/author_one.yaml") + + def test_author_with_articles_one(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/author_with_articles_one.yaml") + + def test_author_upsert_one_update(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/author_upsert_one_update.yaml") + + def test_author_upsert_one_no_update(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/author_upsert_one_no_update.yaml") + @classmethod def dir(cls): return "queries/graphql_mutation/insert/nested" @@ -297,6 +309,15 @@ def test_no_operator_err(self, hge_ctx, transport): def test_column_in_multiple_operators(self, hge_ctx, transport): check_query_f(hge_ctx, self.dir() + "/article_column_multiple_operators.yaml") + def test_column_in_multiple_operators(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/article_column_multiple_operators.yaml") + + def test_author_by_pk(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/author_by_pk.yaml") + + def test_author_by_pk_null(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/author_by_pk_null.yaml") + @classmethod def dir(cls): return "queries/graphql_mutation/update/basic" @@ -374,6 +395,12 @@ def test_article_delete_returning_author(self, hge_ctx, transport): def test_author_returning_empty_articles(self, hge_ctx, transport): check_query_f(hge_ctx, self.dir() + "/author_returning_empty_articles.yaml", transport) + def test_article_by_pk(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/article_by_pk.yaml", transport) + + def test_article_by_pk_null(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + "/article_by_pk_null.yaml", transport) + @classmethod def dir(cls): return "queries/graphql_mutation/delete/basic" From be07e0424444d1e16620c99b46a71c265585e633 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 22 Jan 2020 18:53:21 +0530 Subject: [PATCH 42/62] refactor code building actions' cache & validate presence of actions and action permission --- server/src-lib/Hasura/RQL/DDL/Action.hs | 14 +++- server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs | 81 ++++++++++--------- 2 files changed, 56 insertions(+), 39 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index b9782ce166fa7..150428fcba8bb 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -72,9 +72,16 @@ runCreateAction :: (QErrM m , CacheRWM m, MonadTx m) => CreateAction -> m EncJSON runCreateAction createAction = do + -- check if action with same name exists already + actionMap <- scActions <$> askSchemaCache + void $ onJust (Map.lookup actionName actionMap) $ const $ + throw400 AlreadyExists $ + "action with name " <> actionName <<> " already exists" persistCreateAction createAction - buildSchemaCacheFor $ MOAction $ _caName createAction + buildSchemaCacheFor $ MOAction actionName pure successMsg + where + actionName = _caName createAction persistCreateAction :: (MonadTx m) => CreateAction -> m () persistCreateAction (CreateAction actionName actionDefinition comment) = do @@ -144,7 +151,6 @@ runUpdateAction :: forall m. ( QErrM m , CacheRWM m, MonadTx m) => UpdateAction -> m EncJSON runUpdateAction (UpdateAction actionName actionDefinition) = do - -- adminOnly sc <- askSchemaCache let actionsMap = scActions sc void $ onNothing (Map.lookup actionName actionsMap) $ @@ -245,6 +251,10 @@ runCreateActionPermission :: (QErrM m , CacheRWM m, MonadTx m) => CreateActionPermission -> m EncJSON runCreateActionPermission createActionPermission = do + actionInfo <- getActionInfo actionName + void $ onJust (Map.lookup role $ _aiPermissions actionInfo) $ const $ + throw400 AlreadyExists $ "permission for role: " <> role + <<> "is already defined on " <>> actionName persistCreateActionPermission createActionPermission buildSchemaCacheFor $ MOActionPermission actionName role pure successMsg diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index ec29123f7a859..22216ba0a050e 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -229,39 +229,23 @@ buildSchemaCacheRule = proc inputs -> do -- custom types resolvedCustomTypes <- bindA -< resolveCustomTypes tableCache customTypes - actionCache <- (\infos -> (M.catMaybes . M.catMaybes) infos >- returnA) <-< - (| Inc.keyed (\_ duplicateActions -> do - maybeAction <- noDuplicates mkActionMetadataObj -< duplicateActions - (| traverseA (\action -> do - let CreateAction name def _ = action - metadataObj = mkActionMetadataObj action - addActionContext e = "in action " <> name <<> "; " <> e - - (| withRecordInconsistency ( - (| modifyErrA (do - resolvedDef <- bindErrorA -< resolveAction resolvedCustomTypes def - returnA -< resolvedDef) - |) addActionContext) - |) metadataObj - >-> (\maybeResolvedDef -> - (| traverseA (\resolvedDef -> do - actionPerms <- (\info -> M.catMaybes info >- returnA) <-< - (| Inc.keyed (\_ duplicatePerms -> do - maybePerm <- noDuplicates mkActionPermissionObj -< duplicatePerms - (| traverseA (\perm -> do - let role = _capRole perm - permDef = _capDefinition perm - selFilter <- bindA -< buildActionFilter (_apdSelect permDef) - returnA -< ActionPermissionInfo role selFilter) - |) maybePerm) - |) (M.groupOn _capRole $ filter (\perm -> _capAction perm == name) actionPermissions) - returnA -< ActionInfo name resolvedDef actionPerms - ) - |) maybeResolvedDef - )) - |) maybeAction) - |) (M.groupOn _caName actions) + -- actions + resolvedActionDefs <- (mapFromL _caName actions >- returnA) + >-> (| Inc.keyed (\_ action -> do + let CreateAction name def _ = action + metadataObj = mkActionMetadataObj action + addActionContext e = "in action " <> name <<> "; " <> e + (| withRecordInconsistency ( + (| modifyErrA ( do + resolvedDef <- bindErrorA -< resolveAction resolvedCustomTypes def + returnA -< resolvedDef) + |) addActionContext) + |) metadataObj) + |) + >-> (\actionMap -> returnA -< M.catMaybes actionMap) + + actionCache <- buildActionCache -< (resolvedActionDefs, M.groupOn _capAction actionPermissions) -- build GraphQL context with tables and functions baseGQLSchema <- bindA -< GS.mkGCtxMap (snd resolvedCustomTypes) tableCache functionCache actionCache @@ -294,11 +278,6 @@ buildSchemaCacheRule = proc inputs -> do mkActionMetadataObj ca = MetadataObject (MOAction $ _caName ca) $ toJSON ca - mkActionPermissionObj p = - let role = _capRole p - name = _capAction p - in MetadataObject (MOActionPermission name role) $ toJSON p - -- Given a map of table info, “folds in” another map of information, accumulating inconsistent -- metadata objects for any entries in the second map that don’t appear in the first map. This -- is used to “line up” the metadata for relationships, computed fields, permissions, etc. with @@ -379,6 +358,34 @@ buildSchemaCacheRule = proc inputs -> do pure (M.insert name rsCtx remoteSchemas, mergedGCtxMap, mergedDefGCtx)) |) (MetadataObject (MORemoteSchema name) (toJSON remoteSchema)) + buildActionCache + :: ( ArrowChoice arr, Inc.ArrowDistribute arr, ArrowWriter (Seq CollectedInfo) arr + , Inc.ArrowCache m arr, MonadError QErr m + ) + => ( M.HashMap ActionName ResolvedActionDefinition + , M.HashMap ActionName [CreateActionPermission] + ) `arr` M.HashMap ActionName ActionInfo + buildActionCache = proc (definitions, permissions) -> do + let combinedMap = M.fromList $ flip map (M.toList definitions) $ + \(name, def) -> (name, (def, M.lookupDefault [] name permissions)) + (| Inc.keyed (\actionName (def, perms) -> do + permissionInfo <- (\maybeMap -> returnA -< M.catMaybes maybeMap) <-< + (| Inc.keyed (\role perm -> + (| withRecordInconsistency (do + selectFilter <- bindA -< buildActionFilter (_apdSelect $ _capDefinition perm) + returnA -< ActionPermissionInfo role selectFilter + ) + |) (mkActionPermMetaObj actionName perm) + ) + |) (mapFromL _capRole perms) + returnA -< ActionInfo actionName def permissionInfo + ) + |) combinedMap + where + mkActionPermMetaObj actionName perm = + let objId = MOActionPermission actionName $ _capRole perm + in MetadataObject objId $ toJSON perm + -- | @'withMetadataCheck' cascade action@ runs @action@ and checks if the schema changed as a -- result. If it did, it checks to ensure the changes do not violate any integrity constraints, and -- if not, incorporates them into the schema cache. From 4e5837258ea9afeeb8db74914c84c9e22185e781 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 23 Jan 2020 15:26:51 +0530 Subject: [PATCH 43/62] add action context (name) in webhook payload --- server/src-lib/Hasura/GraphQL/Resolve/Action.hs | 16 ++++++++++++---- server/src-lib/Hasura/GraphQL/Resolve/Types.hs | 3 ++- server/src-lib/Hasura/GraphQL/Schema/Action.hs | 2 +- 3 files changed, 15 insertions(+), 6 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 8a5aad538110e..8feab5499df2b 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -191,9 +191,15 @@ actionSelectToTx :: ActionSelectResolved -> RespTx actionSelectToTx actionSelect = asSingleRowJsonResp (actionSelectToSql actionSelect) [] +newtype ActionContext + = ActionContext {_acName :: ActionName} + deriving (Show, Eq) +$(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''ActionContext) + data ActionWebhookPayload = ActionWebhookPayload - { _awpSessionVariables :: !UserVars + { _awpAction :: !ActionContext + , _awpSessionVariables :: !UserVars , _awpInput :: !J.Value } deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionWebhookPayload) @@ -244,7 +250,8 @@ resolveActionInsertSync -> m RespTx resolveActionInsertSync field executionContext sessionVariables = do let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field - handlerPayload = ActionWebhookPayload sessionVariables inputArgs + actionContext = ActionContext actionName + handlerPayload = ActionWebhookPayload actionContext sessionVariables inputArgs manager <- asks getter reqHeaders <- asks getter webhookRes <- callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook handlerPayload @@ -260,7 +267,7 @@ resolveActionInsertSync field executionContext sessionVariables = do astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] where - SyncActionExecutionContext returnStrategy resolvedWebhook confHeaders + SyncActionExecutionContext actionName returnStrategy resolvedWebhook confHeaders forwardClientHeaders = executionContext mkJsonToRecordFromExpression definitionList webhookResponseExpression = @@ -355,8 +362,9 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do let webhookUrl = _adHandler definition forwardClientHeaders = _adForwardClientHeaders definition confHeaders = _adHeaders definition + actionContext = ActionContext actionName res <- runExceptT $ callWebhook httpManager reqHeaders confHeaders forwardClientHeaders webhookUrl $ - ActionWebhookPayload sessionVariables inputPayload + ActionWebhookPayload actionContext sessionVariables inputPayload case res of Left e -> setError actionId e Right responsePayload -> setCompleted actionId responsePayload diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 99eddb007483b..c13d99e0459bc 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -108,7 +108,8 @@ data SyncReturnStrategy data SyncActionExecutionContext = SyncActionExecutionContext - { _saecStrategy :: !SyncReturnStrategy + { _saecName :: !ActionName + , _saecStrategy :: !SyncReturnStrategy , _saecWebhook :: !ResolvedWebhook , _saecHeaders :: ![HeaderConf] , _saecForwardClientHeaders :: !Bool diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 8f5d05394d05b..cb6aa15869986 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -69,7 +69,7 @@ mkMutationField actionName actionInfo permission definitionList = actionExecutionContext = case _adKind definition of ActionSynchronous -> - ActionExecutionSyncWebhook $ SyncActionExecutionContext + ActionExecutionSyncWebhook $ SyncActionExecutionContext actionName -- TODO: only covers object types (ExecOnPostgres definitionList) (_adHandler definition) From b02474b405a160ba2cbd43daf46db0681bba6feb Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 5 Feb 2020 15:23:17 +0530 Subject: [PATCH 44/62] avoid '_0_root.base' hack & add async result accessible check * Async action response is accessible for non admin roles only if the request session vars equals to action's --- server/src-lib/Hasura/GraphQL/Resolve.hs | 2 +- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 83 +++++++++---------- .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 5 +- .../src-lib/Hasura/RQL/DML/Select/Internal.hs | 5 +- server/src-lib/Hasura/RQL/DML/Select/Types.hs | 2 +- 5 files changed, 45 insertions(+), 52 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index d388f61795e25..03bb40867c3ac 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -102,7 +102,7 @@ queryFldToPGAST fld = do validateHdrs userInfo (_fqocHeaders ctx) QRFAgg <$> RS.convertFuncQueryAgg ctx fld QCActionFetch ctx -> - QRFActionSelect <$> RA.resolveAsyncResponse ctx fld + QRFActionSelect <$> RA.resolveAsyncResponse userInfo ctx fld mutFldToTx :: ( HasVersion diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 0e0c4122c7694..cee01f48d7ea4 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -61,7 +61,6 @@ data InputFieldResolved data OutputFieldResolved = OutputFieldSimple !Text - | OutputFieldRelationship | OutputFieldTypename !G.NamedType deriving (Show, Eq) @@ -158,7 +157,6 @@ actionSelectToSql (ActionSelect actionIdExp selection _) = outputFieldToSQLExp = \case OutputFieldSimple fieldName -> S.SEOpApp (S.SQLOp "->>") [outputColumn, S.SELit fieldName] - OutputFieldRelationship -> undefined OutputFieldTypename ty -> S.SELit $ G.unName $ G.unNamedType ty where outputColumn = S.SEIden $ toIden $ unsafePGCol "response_payload" @@ -225,14 +223,19 @@ processOutputSelectionSet , Has OrdByCtx r , Has SQLGenCtx r ) - => RS.SelectFromG UnresolvedVal + => RS.ArgumentExp UnresolvedVal + -> [(PGCol, PGScalarType)] -> G.NamedType -> SelSet -> m GRS.AnnSimpleSelect -processOutputSelectionSet selectFrom fldTy flds = do +processOutputSelectionSet tableRowInput definitionList fldTy flds = do stringifyNumerics <- stringifyNum <$> asks getter annotatedFields <- processTableSelectionSet fldTy flds - let selectAst = RS.AnnSelG annotatedFields selectFrom + let annSel = RS.AnnSelG annotatedFields selectFrom RS.noTablePermissions RS.noTableArgs stringifyNumerics - return selectAst + pure annSel + where + jsonbToRecordFunction = QualifiedObject (SchemaName "pg_catalog") $ FunctionName "jsonb_to_record" + functionArgs = RS.FunctionArgsExp [tableRowInput] mempty + selectFrom = RS.FromFunction jsonbToRecordFunction functionArgs $ Just definitionList resolveActionInsertSync :: ( HasVersion @@ -260,11 +263,10 @@ resolveActionInsertSync field executionContext sessionVariables = do case returnStrategy of ReturnJson -> return $ return $ encJFromJValue webhookRes ExecOnPostgres definitionList -> do - let webhookResponseExpression = - toTxtValue $ WithScalarType PGJSON $ PGValJSON $ Q.JSON webhookRes + let webhookResponseExpression = RS.AEInput $ UVSQL $ + toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB webhookRes selectAstUnresolved <- - processOutputSelectionSet - (mkJsonToRecordFromExpression definitionList webhookResponseExpression) + processOutputSelectionSet webhookResponseExpression definitionList (_fType field) $ _fSelSet field astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] @@ -272,15 +274,6 @@ resolveActionInsertSync field executionContext sessionVariables = do SyncActionExecutionContext actionName returnStrategy resolvedWebhook confHeaders forwardClientHeaders = executionContext - mkJsonToRecordFromExpression definitionList webhookResponseExpression = - let functionName = QualifiedObject (SchemaName "pg_catalog") $ - FunctionName "json_to_record" - functionArgs = RS.FunctionArgsExp - (pure $ UVSQL webhookResponseExpression) - mempty - in RS.FromFunction functionName (RS.AEInput <$> functionArgs) - (Just definitionList) - callWebhook :: (HasVersion, MonadIO m, MonadError QErr m) => HTTP.Manager @@ -537,31 +530,29 @@ resolveAsyncResponse , Has OrdByCtx r , Has SQLGenCtx r ) - => ActionSelectOpContext + => UserInfo + -> ActionSelectOpContext -> Field -> m GRS.AnnSimpleSelect -resolveAsyncResponse selectContext field = do +resolveAsyncResponse userInfo selectContext field = do actionId <- withArg (_fArguments field) "id" parseActionId stringifyNumerics <- stringifyNum <$> asks getter - annotatedFields <- forM (toList $ _fSelSet field) $ \fld -> do - let fldName = _fName fld - let rqlFldName = FieldName $ G.unName $ G.unAlias $ _fAlias fld - (rqlFldName,) <$> case fldName of - "__typename" -> return $ RS.FExp $ G.unName $ G.unNamedType $ _fType field + + annotatedFields <- fmap (map (first FieldName)) $ withSelSet (_fSelSet field) $ \fld -> + case _fName fld of + "__typename" -> return $ RS.FExp $ G.unName $ G.unNamedType $ _fType fld "output" -> do - let relationshipFromExp = - mkJsonToRecordFromExpression (_asocDefinitionList selectContext) $ - -- TODO: An absolute hack, please fix this - RS.AEInput $ UVSQL $ S.mkQIdenExp (Iden "_0_root.base") (Iden "response_payload") - outputSelect <- processOutputSelectionSet relationshipFromExp (_fType fld) - (_fSelSet fld) - return $ RS.FObj $ RS.AnnRelG outputRelName mempty outputSelect + -- Treating "output" as a computed field to "hdb_action_log" table with "jsonb_to_record" SQL function + let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload" + definitionList = _asocDefinitionList selectContext + (RS.FComputedField . RS.CFSTable) <$> processOutputSelectionSet inputTableArgument definitionList (_fType fld) (_fSelSet fld) -- the metadata columns "id" -> return $ mkAnnFldFromPGCol "id" PGUUID "created_at" -> return $ mkAnnFldFromPGCol "created_at" PGTimeStampTZ - -- "status" -> return $ mkAnnFldFromPGCol "status" "errors" -> return $ mkAnnFldFromPGCol "errors" PGJSONB + -- "status" -> return $ mkAnnFldFromPGCol "status" G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t + let tableFromExp = RS.FromTable actionLogTable tableArguments = RS.noTableArgs { RS._taWhere = Just $ mkTableBoolExpression actionId} @@ -573,7 +564,7 @@ resolveAsyncResponse selectContext field = do -- astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved -- return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] where - outputRelName = RelName $ mkNonEmptyTextUnsafe "output" + -- outputRelName = RelName $ mkNonEmptyTextUnsafe "output" actionLogTable = QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log") mkAnnFldFromPGCol column columnType = @@ -585,14 +576,14 @@ resolveAsyncResponse selectContext field = do parseActionId annInpValue = do mkParameterizablePGValue <$> asPGColumnValue annInpValue mkTableBoolExpression actionId = - BoolFld $ AVCol - (PGColumnInfo (unsafePGCol "id") "id" (PGColumnScalar PGUUID) False Nothing) $ - pure $ AEQ True actionId - mkJsonToRecordFromExpression definitionList webhookResponseExpression = - let functionName = QualifiedObject (SchemaName "pg_catalog") $ - FunctionName "jsonb_to_record" - functionArgs = RS.FunctionArgsExp - (pure webhookResponseExpression) - mempty - in RS.FromFunction functionName functionArgs - (Just definitionList) + let actionIdColumnInfo = PGColumnInfo (unsafePGCol "id") "id" (PGColumnScalar PGUUID) False Nothing + actionIdColumnEq = BoolFld $ AVCol actionIdColumnInfo [AEQ True actionId] + sessionVarsColumnInfo = PGColumnInfo (unsafePGCol "session_variables") "session_variables" + (PGColumnScalar PGJSONB) False Nothing + sessionVarValue = UVPG $ AnnPGVal Nothing False $ WithScalarType PGJSONB + $ PGValJSONB $ Q.JSONB $ J.toJSON $ userVars userInfo + sessionVarsColumnEq = BoolFld $ AVCol sessionVarsColumnInfo [AEQ True sessionVarValue] + in if isAdmin (userRole userInfo) then actionIdColumnEq + -- For non-admin roles, the async result is accessible only if the request session variables + -- equals to action's session variables + else BoolAnd [actionIdColumnEq, sessionVarsColumnEq] diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 9de29075a6b73..5d8278c34caf9 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -74,11 +74,12 @@ resolveComputedField computedField fld = fieldAsPath fld $ do argFn = IFAUnknown withTableArgument resolvedArgs = let argsExp@(RS.FunctionArgsExp positional named) = RS.AEInput <$> resolvedArgs + tableRowArg = RS.AETableRow Nothing in case tableArg of FTAFirst -> - RS.FunctionArgsExp (RS.AETableRow:positional) named + RS.FunctionArgsExp (tableRowArg:positional) named FTANamed argName index -> - RS.insertFunctionArg argName index RS.AETableRow argsExp + RS.insertFunctionArg argName index tableRowArg argsExp processTableSelectionSet :: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r diff --git a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs index 37b457f7d31ef..83b5c26eb2c69 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs @@ -190,8 +190,9 @@ fromTableRowArgs pfx = toFunctionArgs . fmap toSQLExp where toFunctionArgs (FunctionArgsExp positional named) = S.FunctionArgs positional named - toSQLExp AETableRow = S.SERowIden $ mkBaseTableAls pfx - toSQLExp (AEInput s) = s + toSQLExp (AETableRow Nothing) = S.SERowIden $ mkBaseTableAls pfx + toSQLExp (AETableRow (Just acc)) = S.mkQIdenExp (mkBaseTableAls pfx) acc + toSQLExp (AEInput s) = s -- posttgres ignores anything beyond 63 chars for an iden -- in this case, we'll need to use json_build_object function diff --git a/server/src-lib/Hasura/RQL/DML/Select/Types.hs b/server/src-lib/Hasura/RQL/DML/Select/Types.hs index 0381ca2406d5d..d912e82ae94f1 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Types.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Types.hs @@ -250,7 +250,7 @@ type TableAggFldsG v = Fields (TableAggFldG v) type TableAggFlds = TableAggFldsG S.SQLExp data ArgumentExp a - = AETableRow + = AETableRow !(Maybe Iden) -- ^ table row accessor | AEInput !a deriving (Show, Eq, Functor, Foldable, Traversable) From e5b49c597a58262c33ba1a8aa61a1c4acf3ca5d5 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 5 Feb 2020 17:33:28 +0530 Subject: [PATCH 45/62] small no-op refactor in schema/cache.hs --- server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs | 20 +++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index eab5642904934..40c93abf54b2e 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -238,9 +238,7 @@ buildSchemaCacheRule = proc inputs -> do metadataObj = mkActionMetadataObj action addActionContext e = "in action " <> name <<> "; " <> e (| withRecordInconsistency ( - (| modifyErrA ( do - resolvedDef <- bindErrorA -< resolveAction resolvedCustomTypes def - returnA -< resolvedDef) + (| modifyErrA (bindErrorA -< resolveAction resolvedCustomTypes def) |) addActionContext) |) metadataObj) |) @@ -248,18 +246,20 @@ buildSchemaCacheRule = proc inputs -> do actionCache <- buildActionCache -< (resolvedActionDefs, M.groupOn _capAction actionPermissions) - -- build GraphQL context with tables and functions + -- build GraphQL context with tables, functions and actions baseGQLSchema <- bindA -< GS.mkGCtxMap (snd resolvedCustomTypes) tableCache functionCache actionCache -- remote schemas let invalidatedRemoteSchemas = flip map remoteSchemas \remoteSchema -> (M.lookup (_arsqName remoteSchema) invalidationMap, remoteSchema) + (remoteSchemaMap, gqlSchema, remoteGQLSchema) <- (| foldlA' (\schemas schema -> (schemas, schema) >- addRemoteSchema) |) (M.empty, baseGQLSchema, GC.emptyGCtx) invalidatedRemoteSchemas - >-> (\(remoteSchemaMap, gqlSchema, remoteGQLSchema) -> do - (gqlSchema', defGqlSchema') <- bindA -< mergeCustomTypes gqlSchema remoteGQLSchema resolvedCustomTypes - returnA -< (remoteSchemaMap, gqlSchema', defGqlSchema')) + + -- merge custom types + (finalGQLSchema, finalRemoteGQLSchema) <- + bindA -< mergeCustomTypes gqlSchema remoteGQLSchema resolvedCustomTypes returnA -< BuildOutputs { _boTables = tableCache @@ -268,8 +268,8 @@ buildSchemaCacheRule = proc inputs -> do , _boRemoteSchemas = remoteSchemaMap , _boAllowlist = allowList , _boCustomTypes = resolvedCustomTypes - , _boGCtxMap = gqlSchema - , _boDefaultRemoteGCtx = remoteGQLSchema + , _boGCtxMap = finalGQLSchema + , _boDefaultRemoteGCtx = finalRemoteGQLSchema } mkEventTriggerMetadataObject (CatalogEventTrigger qt trn configuration) = @@ -373,7 +373,7 @@ buildSchemaCacheRule = proc inputs -> do permissionInfo <- (\maybeMap -> returnA -< M.catMaybes maybeMap) <-< (| Inc.keyed (\role perm -> (| withRecordInconsistency (do - selectFilter <- bindA -< buildActionFilter (_apdSelect $ _capDefinition perm) + selectFilter <- bindErrorA -< buildActionFilter (_apdSelect $ _capDefinition perm) returnA -< ActionPermissionInfo role selectFilter ) |) (mkActionPermMetaObj actionName perm) From 82346267f71f28dd84371c9e5d94cce23f38d9a0 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 5 Feb 2020 20:05:43 +0530 Subject: [PATCH 46/62] clean nulls, empty arrays for actions, custom types in export metadata --- .../src-lib/Hasura/RQL/DDL/Metadata/Types.hs | 80 +++++++++++++++++-- server/src-test/Hasura/RQL/MetadataSpec.hs | 2 +- 2 files changed, 75 insertions(+), 7 deletions(-) diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs b/server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs index 64a7f0d3c3de3..4365fb0fc27a8 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs @@ -42,6 +42,7 @@ import Language.Haskell.TH.Syntax (Lift) import qualified Data.Aeson.Ordered as AO import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS +import qualified Language.GraphQL.Draft.Syntax as G import Hasura.RQL.Types import Hasura.SQL.Types @@ -282,8 +283,8 @@ replaceMetadataToOrdJSON ( ReplaceMetadata , remoteSchemasPair , queryCollectionsPair , allowlistPair - , customTypesPair , actionsPair + , customTypesPair ] where versionPair = ("version", AO.toOrdered version) @@ -447,21 +448,84 @@ replaceMetadataToOrdJSON ( ReplaceMetadata customTypesToOrdJSON :: CustomTypes -> AO.Value customTypesToOrdJSON (CustomTypes inpObjs objs scalars enums) = - AO.object . catMaybes $ [ listToMaybeOrdPair "input_objects" AO.toOrdered =<< inpObjs - , listToMaybeOrdPair "objects" AO.toOrdered =<< objs - , listToMaybeOrdPair "scalars" AO.toOrdered =<< scalars - , listToMaybeOrdPair "enums" AO.toOrdered =<< enums] + AO.object . catMaybes $ [ listToMaybeOrdPair "input_objects" inputObjectToOrdJSON =<< inpObjs + , listToMaybeOrdPair "objects" objectTypeToOrdJSON =<< objs + , listToMaybeOrdPair "scalars" scalarTypeToOrdJSON =<< scalars + , listToMaybeOrdPair "enums" enumTypeToOrdJSON =<< enums + ] + where + inputObjectToOrdJSON :: InputObjectTypeDefinition -> AO.Value + inputObjectToOrdJSON (InputObjectTypeDefinition tyName descM fields) = + AO.object $ [ ("name", AO.toOrdered tyName) + , ("fields", AO.array $ map fieldDefinitionToOrdJSON $ toList fields) + ] + <> catMaybes [maybeDescriptionToMaybeOrdPair descM] + where + fieldDefinitionToOrdJSON :: InputObjectFieldDefinition -> AO.Value + fieldDefinitionToOrdJSON (InputObjectFieldDefinition fieldName fieldDescM ty) = + AO.object $ [ ("name", AO.toOrdered fieldName) + , ("type", AO.toOrdered ty) + ] + <> catMaybes [maybeDescriptionToMaybeOrdPair fieldDescM] + + objectTypeToOrdJSON :: ObjectTypeDefinition -> AO.Value + objectTypeToOrdJSON (ObjectTypeDefinition tyName descM fields rels) = + AO.object $ [ ("name", AO.toOrdered tyName) + , ("fields", AO.array $ map fieldDefinitionToOrdJSON $ toList fields) + ] + <> catMaybes [ maybeDescriptionToMaybeOrdPair descM + , listToMaybeOrdPair "relationships" AO.toOrdered =<< rels + ] + where + fieldDefinitionToOrdJSON :: ObjectFieldDefinition -> AO.Value + fieldDefinitionToOrdJSON (ObjectFieldDefinition fieldName argsValM fieldDescM ty) = + AO.object $ [ ("name", AO.toOrdered fieldName) + , ("type", AO.toOrdered ty) + ] + <> catMaybes [ (("arguments", ) . AO.toOrdered) <$> argsValM + , maybeDescriptionToMaybeOrdPair fieldDescM + ] + + scalarTypeToOrdJSON :: ScalarTypeDefinition -> AO.Value + scalarTypeToOrdJSON (ScalarTypeDefinition tyName descM) = + AO.object $ [("name", AO.toOrdered tyName)] + <> catMaybes [maybeDescriptionToMaybeOrdPair descM] + + enumTypeToOrdJSON :: EnumTypeDefinition -> AO.Value + enumTypeToOrdJSON (EnumTypeDefinition tyName descM values) = + AO.object $ [ ("name", AO.toOrdered tyName) + , ("values", AO.toOrdered values) + ] + <> catMaybes [maybeDescriptionToMaybeOrdPair descM] actionMetadataToOrdJSON :: ActionMetadata -> AO.Value actionMetadataToOrdJSON (ActionMetadata name comment definition permissions) = AO.object $ [ ("name", AO.toOrdered name) - , ("definition", AO.toOrdered definition) + , ("definition", actionDefinitionToOrdJSON definition) ] <> catMaybes [ maybeCommentToMaybeOrdPair comment , listToMaybeOrdPair "permissions" permToOrdJSON permissions ] where + actionDefinitionToOrdJSON :: ActionDefinitionInput -> AO.Value + actionDefinitionToOrdJSON (ActionDefinition args outputType kind headers frwrdClientHdrs handler) = + AO.object $ [ ("kind", AO.toOrdered kind) + , ("handler", AO.toOrdered handler) + , ("arguments", AO.array $ map argDefinitionToOrdJSON args) + , ("output_type", AO.toOrdered outputType) + ] + <> [("forward_client_headers", AO.toOrdered frwrdClientHdrs) | frwrdClientHdrs] + <> catMaybes [ listToMaybeOrdPair "headers" AO.toOrdered headers + ] + where + argDefinitionToOrdJSON :: ArgumentDefinition -> AO.Value + argDefinitionToOrdJSON (ArgumentDefinition argName ty descM) = + AO.object $ [ ("name", AO.toOrdered argName) + , ("type", AO.toOrdered ty) + ] + <> catMaybes [maybeAnyToMaybeOrdPair "description" AO.toOrdered descM] + permToOrdJSON :: ActionPermissionMetadata -> AO.Value permToOrdJSON (ActionPermissionMetadata role permComment permDef) = AO.object $ [ ("role", AO.toOrdered role) @@ -479,6 +543,10 @@ replaceMetadataToOrdJSON ( ReplaceMetadata maybeSetToMaybeOrdPair set = set >>= \colVals -> if colVals == HM.empty then Nothing else Just ("set", AO.toOrdered colVals) + + maybeDescriptionToMaybeOrdPair :: Maybe G.Description -> Maybe (Text, AO.Value) + maybeDescriptionToMaybeOrdPair = maybeAnyToMaybeOrdPair "description" AO.toOrdered + maybeCommentToMaybeOrdPair :: Maybe Text -> Maybe (Text, AO.Value) maybeCommentToMaybeOrdPair = maybeAnyToMaybeOrdPair "comment" AO.toOrdered diff --git a/server/src-test/Hasura/RQL/MetadataSpec.hs b/server/src-test/Hasura/RQL/MetadataSpec.hs index be31a0f56b94d..3063f60cfcfbd 100644 --- a/server/src-test/Hasura/RQL/MetadataSpec.hs +++ b/server/src-test/Hasura/RQL/MetadataSpec.hs @@ -15,7 +15,7 @@ import Hasura.RQL.DDL.Metadata.Types (ReplaceMetadata, replaceMeta spec :: Spec spec = describe "replaceMetadataToOrdJSON" $ do it "produces JSON that can be parsed by the ToJSON instance for ReplaceMetadata" $ - withMaxSuccess 50 $ + withMaxSuccess 30 $ forAll (resize 3 genReplaceMetadata) $ \metadata -> let encodedString = encJToBS $ AO.toEncJSON $ replaceMetadataToOrdJSON metadata in case eitherDecodeStrict @ReplaceMetadata encodedString of From 7c2be6d0c0d573d80a4b3bb24d2ec5959861bf31 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 6 Feb 2020 10:47:51 +0530 Subject: [PATCH 47/62] async action mutation returns only the UUID of the action The mutation field of async action look like action_name(arg: SampleInput!): uuid! --- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 20 +++++----- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 39 ++++++++----------- 2 files changed, 28 insertions(+), 31 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 777179ff26e9a..8b011d186918d 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -184,9 +184,9 @@ resolveActionSelect selectContext field = do parseActionId annInpValue = do mkParameterizablePGValue <$> asPGColumnValue annInpValue -actionSelectToTx :: ActionSelectResolved -> RespTx -actionSelectToTx actionSelect = - asSingleRowJsonResp (actionSelectToSql actionSelect) [] +-- actionSelectToTx :: ActionSelectResolved -> RespTx +-- actionSelectToTx actionSelect = +-- asSingleRowJsonResp (actionSelectToSql actionSelect) [] newtype ActionContext = ActionContext {_acName :: ActionName} @@ -450,6 +450,7 @@ resolveActionInsert field executionContext sessionVariables = ActionExecutionAsync actionFilter -> resolveActionInsertAsync field actionFilter sessionVariables +-- | Resolve asynchronous action mutation which returns only the action uuid resolveActionInsertAsync :: ( MonadError QErr m, MonadReader r m , Has [HTTP.Header] r @@ -461,7 +462,7 @@ resolveActionInsertAsync -> m RespTx resolveActionInsertAsync field _ sessionVariables = do - responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ _fSelSet field + -- responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ _fSelSet field reqHeaders <- asks getter let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field @@ -472,9 +473,9 @@ resolveActionInsertAsync field _ sessionVariables = do -- let actionInput = OMap.union inputArgs resolvedPresetFields -- resolvedFilter <- resolveFilter - let resolvedFilter = annBoolExpTrue + -- let resolvedFilter = annBoolExpTrue - return $ do + pure $ do actionId <- runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler [Q.sql| INSERT INTO "hdb_catalog"."hdb_action_log" @@ -485,9 +486,10 @@ resolveActionInsertAsync field _ sessionVariables = do |] (actionName, Q.AltJ sessionVariables, Q.AltJ $ toHeadersMap reqHeaders, Q.AltJ inputArgs, "created"::Text) False - actionSelectToTx $ - ActionSelect (S.SELit $ UUID.toText actionId) - responseSelectionSet resolvedFilter + pure $ encJFromJValue $ UUID.toText actionId + -- actionSelectToTx $ + -- ActionSelect (S.SELit $ UUID.toText actionId) + -- responseSelectionSet resolvedFilter where actionName = G.unName $ _fName field toHeadersMap = Map.fromList . map ((bsToTxt . CI.original) *** bsToTxt) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index e4b041def411b..271359e9f308f 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -15,20 +15,19 @@ import Hasura.Prelude import Hasura.RQL.Types import Hasura.SQL.Types -mkActionSelectionType :: ActionName -> G.NamedType -mkActionSelectionType = - G.NamedType . unActionName +mkAsyncActionSelectionType :: ActionName -> G.NamedType +mkAsyncActionSelectionType = G.NamedType . unActionName -mkActionResponseTypeInfo +mkAsyncActionQueryResponseObj :: ActionName -- Name of the action -> GraphQLType -- output type -> ObjTyInfo -mkActionResponseTypeInfo actionName outputType = +mkAsyncActionQueryResponseObj actionName outputType = mkHsraObjTyInfo (Just description) - (mkActionSelectionType actionName) -- "(action_name)_input" + (mkAsyncActionSelectionType actionName) -- "(action_name)" mempty -- no arguments (mapFromL _fiName fieldDefinitions) where @@ -85,18 +84,17 @@ mkMutationField actionName actionInfo permission definitionList = mkHsraObjFldInfo (Just description) (unActionName actionName) - (mapFromL _iviName $ map mkActionArgument $ _adArguments definition) $ - actionFieldResponseType actionName definition + (mapFromL _iviName $ map mkActionArgument $ _adArguments definition) + actionFieldResponseType mkActionArgument argument = InpValInfo (_argDescription argument) (unArgumentName $ _argName argument) Nothing $ unGraphQLType $ _argType argument -actionFieldResponseType :: ActionName -> ActionDefinition a -> G.GType -actionFieldResponseType actionName definition = - case _adKind definition of - ActionSynchronous -> unGraphQLType $ _adOutputType definition - ActionAsynchronous -> G.toGT $ G.toGT $ mkActionSelectionType actionName + actionFieldResponseType = + case _adKind definition of + ActionSynchronous -> unGraphQLType $ _adOutputType definition + ActionAsynchronous -> G.toGT $ G.toNT $ mkScalarTy PGUUID mkQueryField :: ActionName @@ -108,8 +106,12 @@ mkQueryField actionName definition permission definitionList = case _adKind definition of ActionAsynchronous -> Just ( ActionSelectOpContext (_apiFilter permission) definitionList - , fieldInfo - , TIObj $ mkActionResponseTypeInfo actionName $ + + , mkHsraObjFldInfo (Just description) (unActionName actionName) + (mapFromL _iviName [idArgument]) + (G.toGT $ G.toGT $ mkAsyncActionSelectionType actionName) + + , TIObj $ mkAsyncActionQueryResponseObj actionName $ _adOutputType definition ) ActionSynchronous -> Nothing @@ -123,13 +125,6 @@ mkQueryField actionName definition permission definitionList = where idDescription = G.Description $ "id of the action: " <>> actionName - fieldInfo = - mkHsraObjFldInfo - (Just description) - (unActionName actionName) - (mapFromL _iviName [idArgument]) - (actionFieldResponseType actionName definition) - mkActionFieldsAndTypes :: (QErrM m) => ActionInfo From a9ef56911c480879e07ce9c2d7ee4a8721168a76 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 6 Feb 2020 11:51:05 +0530 Subject: [PATCH 48/62] unit tests for URL template parser --- server/graphql-engine.cabal | 3 ++- server/src-lib/Data/URL/Template.hs | 13 +++++++++++++ server/src-test/Data/Parser/URLTemplate.hs | 16 ++++++++++++++++ server/src-test/Hasura/RQL/MetadataSpec.hs | 2 +- server/src-test/Main.hs | 17 +++++++++-------- 5 files changed, 41 insertions(+), 10 deletions(-) create mode 100644 server/src-test/Data/Parser/URLTemplate.hs diff --git a/server/graphql-engine.cabal b/server/graphql-engine.cabal index 8f2a1431b8fb6..7e8c4c75e6f28 100644 --- a/server/graphql-engine.cabal +++ b/server/graphql-engine.cabal @@ -200,6 +200,7 @@ library -- exposed for tests , Data.Parser.CacheControl + , Data.URL.Template , Hasura.Prelude , Hasura.App @@ -364,7 +365,6 @@ library , Control.Concurrent.Extended , Control.Lens.Extended , Data.Aeson.Extended - , Data.URL.Template , Data.List.Extended , Data.HashMap.Strict.Extended , Data.HashMap.Strict.InsOrd.Extended @@ -420,6 +420,7 @@ test-suite graphql-engine-tests main-is: Main.hs other-modules: Data.Parser.CacheControlSpec + Data.Parser.URLTemplate Data.TimeSpec Hasura.IncrementalSpec Hasura.RQL.MetadataSpec diff --git a/server/src-lib/Data/URL/Template.hs b/server/src-lib/Data/URL/Template.hs index eed41c98eec62..6b1af77f175e2 100644 --- a/server/src-lib/Data/URL/Template.hs +++ b/server/src-lib/Data/URL/Template.hs @@ -6,6 +6,7 @@ module Data.URL.Template , printURLTemplate , parseURLTemplate , renderURLTemplate + , genURLTemplate ) where @@ -17,6 +18,7 @@ import Data.Attoparsec.Text import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) import System.Environment (lookupEnv) +import Test.QuickCheck newtype Variable = Variable {unVariable :: Text} deriving (Show, Eq, Lift, Generic) @@ -51,3 +53,14 @@ renderURLTemplate (URLTemplate preVar var postVar) = do Just value -> Right $ preVar <> T.pack value <> postVar where variableString = T.unpack $ unVariable var + +-- | QuickCheck generator +genURLTemplate :: Gen URLTemplate +genURLTemplate = + URLTemplate <$> genText <*> genVariable <*> genText + where + genText :: Gen Text + genText = T.pack <$> listOf (elements $ alphaNumerics <> "://") + + genVariable :: Gen Variable + genVariable = (Variable . T.pack) <$> listOf1 (elements $ alphaNumerics <> "-_") diff --git a/server/src-test/Data/Parser/URLTemplate.hs b/server/src-test/Data/Parser/URLTemplate.hs new file mode 100644 index 0000000000000..21517718adff3 --- /dev/null +++ b/server/src-test/Data/Parser/URLTemplate.hs @@ -0,0 +1,16 @@ +module Data.Parser.URLTemplate (spec) where + +import Hasura.Prelude + +import Data.URL.Template +import Test.Hspec +import Test.QuickCheck + +spec :: Spec +spec = describe "parseURLTemplate" $ + it "parse URL templates generated by printURLTemplate" $ + withMaxSuccess 50 $ + forAll (resize 10 genURLTemplate) $ \urlTemplate -> + case parseURLTemplate (printURLTemplate urlTemplate) of + Left err -> counterexample err False + Right r -> property $ r == urlTemplate diff --git a/server/src-test/Hasura/RQL/MetadataSpec.hs b/server/src-test/Hasura/RQL/MetadataSpec.hs index 3063f60cfcfbd..d661670a36c7a 100644 --- a/server/src-test/Hasura/RQL/MetadataSpec.hs +++ b/server/src-test/Hasura/RQL/MetadataSpec.hs @@ -14,7 +14,7 @@ import Hasura.RQL.DDL.Metadata.Types (ReplaceMetadata, replaceMeta spec :: Spec spec = describe "replaceMetadataToOrdJSON" $ do - it "produces JSON that can be parsed by the ToJSON instance for ReplaceMetadata" $ + it "produces JSON that can be parsed by the FromJSON instance for ReplaceMetadata" $ withMaxSuccess 30 $ forAll (resize 3 genReplaceMetadata) $ \metadata -> let encodedString = encJToBS $ AO.toEncJSON $ replaceMetadataToOrdJSON metadata diff --git a/server/src-test/Main.hs b/server/src-test/Main.hs index aa77e43267f95..05d3ee6ce1670 100644 --- a/server/src-test/Main.hs +++ b/server/src-test/Main.hs @@ -20,22 +20,22 @@ import qualified Test.Hspec.Runner as Hspec import Hasura.Db (PGExecCtx (..)) import Hasura.RQL.Types (SQLGenCtx (..), adminUserInfo) import Hasura.RQL.Types.Run -import Hasura.Server.Init (RawConnInfo, mkConnInfo, - mkRawConnInfo, parseRawConnInfo, - runWithEnv) +import Hasura.Server.Init (RawConnInfo, mkConnInfo, mkRawConnInfo, + parseRawConnInfo, runWithEnv) import Hasura.Server.Migrate import Hasura.Server.Version import qualified Data.Parser.CacheControlSpec as CacheControlParser +import qualified Data.Parser.URLTemplate as URLTemplate +import qualified Data.TimeSpec as TimeSpec import qualified Hasura.IncrementalSpec as IncrementalSpec import qualified Hasura.RQL.MetadataSpec as MetadataSpec import qualified Hasura.Server.MigrateSpec as MigrateSpec -import qualified Data.TimeSpec as TimeSpec -import qualified Hasura.Server.TelemetrySpec as TelemetrySpec +import qualified Hasura.Server.TelemetrySpec as TelemetrySpec data TestSuites = AllSuites !RawConnInfo - -- ^ Run all test suites. It probably doesn't make sense to be able to specify additional + -- ^ Run all test suites. It probably doesn't make sense to be able to specify additional -- hspec args here. | SingleSuite ![String] !TestSuite -- ^ Args to pass through to hspec (as if from 'getArgs'), and the specific suite to run. @@ -56,6 +56,7 @@ main = withVersion $$(getVersionFromEnvironment) $ parseArgs >>= \case unitSpecs :: Spec unitSpecs = do describe "Data.Parser.CacheControl" CacheControlParser.spec + describe "Data.Parser.URLTemplate" URLTemplate.spec describe "Hasura.Incremental" IncrementalSpec.spec describe "Hasura.RQL.Metadata" MetadataSpec.spec describe "Data.Time" TimeSpec.spec @@ -93,8 +94,8 @@ parseArgs = execParser $ info (helper <*> (parseNoCommand <|> parseSubCommand)) fullDesc <> header "Hasura GraphQL Engine test suite" where parseNoCommand = AllSuites <$> parseRawConnInfo - parseSubCommand = SingleSuite <$> parseHspecPassThroughArgs <*> subCmd - where + parseSubCommand = SingleSuite <$> parseHspecPassThroughArgs <*> subCmd + where subCmd = subparser $ mconcat [ command "unit" $ info (pure UnitSuite) $ progDesc "Only run unit tests" From ecbd40ba45f44800d65b9c6e4cc8a162c01092e2 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 6 Feb 2020 15:08:15 +0530 Subject: [PATCH 49/62] Basic sync actions python tests --- server/tests-py/conftest.py | 12 ++- server/tests-py/context.py | 79 ++++++++++++++++++- .../actions/sync/create_user_fail.yaml | 17 ++++ .../actions/sync/create_user_success.yaml | 14 ++++ .../tests-py/queries/actions/sync/setup.yaml | 43 ++++++++++ .../queries/actions/sync/teardown.yaml | 15 ++++ .../nested/author_with_articles_one.yaml | 6 +- server/tests-py/test_actions.py | 25 ++++++ 8 files changed, 206 insertions(+), 5 deletions(-) create mode 100644 server/tests-py/queries/actions/sync/create_user_fail.yaml create mode 100644 server/tests-py/queries/actions/sync/create_user_success.yaml create mode 100644 server/tests-py/queries/actions/sync/setup.yaml create mode 100644 server/tests-py/queries/actions/sync/teardown.yaml create mode 100644 server/tests-py/test_actions.py diff --git a/server/tests-py/conftest.py b/server/tests-py/conftest.py index e7e83c489a910..7dcb6ad3c2cf8 100644 --- a/server/tests-py/conftest.py +++ b/server/tests-py/conftest.py @@ -1,6 +1,6 @@ import pytest import time -from context import HGECtx, HGECtxError, EvtsWebhookServer, HGECtxGQLServer, GQLWsClient, PytestConf +from context import HGECtx, HGECtxError, ActionsWebhookServer, EvtsWebhookServer, HGECtxGQLServer, GQLWsClient, PytestConf import threading import random from datetime import datetime @@ -191,6 +191,16 @@ def evts_webhook(request): webhook_httpd.server_close() web_server.join() +@pytest.fixture(scope='module') +def actions_webhook(hge_ctx): + webhook_httpd = ActionsWebhookServer(hge_ctx, server_address=('127.0.0.1', 5593)) + web_server = threading.Thread(target=webhook_httpd.serve_forever) + web_server.start() + yield webhook_httpd + webhook_httpd.shutdown() + webhook_httpd.server_close() + web_server.join() + @pytest.fixture(scope='class') def ws_client(request, hge_ctx): client = GQLWsClient(hge_ctx, '/v1/graphql') diff --git a/server/tests-py/context.py b/server/tests-py/context.py index 225ef9e643f20..ce785c0f08e99 100644 --- a/server/tests-py/context.py +++ b/server/tests-py/context.py @@ -2,7 +2,7 @@ from http import HTTPStatus from urllib.parse import urlparse -from ruamel.yaml.comments import CommentedMap as OrderedDict # to avoid '!!omap' in yaml +from ruamel.yaml.comments import CommentedMap as OrderedDict # to avoid '!!omap' in yaml import threading import http.server import json @@ -13,6 +13,7 @@ import string import random import os +import re import ruamel.yaml as yaml import requests @@ -158,6 +159,82 @@ def teardown(self): self._ws.close() self.wst.join() + +class ActionsWebhookHandler(http.server.BaseHTTPRequestHandler): + + def do_GET(self): + self.send_response(HTTPStatus.OK) + self.end_headers() + + def do_POST(self): + content_len = self.headers.get('Content-Length') + req_body = self.rfile.read(int(content_len)).decode("utf-8") + req_json = json.loads(req_body) + req_headers = self.headers + req_path = self.path + self.log_message(json.dumps(req_json)) + if req_path == "/create-user": + email_address = req_json['input']['email'] + name = req_json['input']['name'] + resp, status = self.create_user(email_address, name) + self.send_response(status) + self.send_header('Content-Type', 'application/json') + self.end_headers() + self.wfile.write(json.dumps(resp).encode("utf-8")) + else: + self.send_response(HTTPStatus.NO_CONTENT) + self.end_headers() + + def create_user(self, email_address, name): + if self.check_email(email_address): + gql_query = ''' + mutation ($email: String! $name: String!) { + insert_user_one(object: {email: $email, name: $name}){ + id + } + } + ''' + variables = { + 'email': email_address, + 'name': name + } + query = { + 'query': gql_query, + 'variables': variables + } + headers = {} + admin_secret = self.hge_ctx.hge_key + if admin_secret is not None: + headers['X-Hasura-Admin-Secret'] = admin_secret + code, resp, resp_hdrs = self.hge_ctx.anyq('/v1/graphql', query, headers) + self.log_message(json.dumps(resp)) + user_id = resp['data']['insert_user_one']['id'] + response = { + 'id': user_id + } + return response, HTTPStatus.OK + else: + response = { + 'message': 'Given email address is not valid', + 'code': 'invalid-email' + } + return response, HTTPStatus.BAD_REQUEST + + def check_email(self, email): + regex = '^\w+([\.-]?\w+)*@\w+([\.-]?\w+)*(\.\w{2,3})+$' + return re.search(regex,email) + + +class ActionsWebhookServer(http.server.HTTPServer): + def __init__(self, hge_ctx, server_address): + handler = ActionsWebhookHandler + handler.hge_ctx = hge_ctx + super().__init__(server_address, handler) + + def server_bind(self): + self.socket.setsockopt(socket.SOL_SOCKET, socket.SO_REUSEADDR, 1) + self.socket.bind(self.server_address) + class EvtsWebhookHandler(http.server.BaseHTTPRequestHandler): def do_GET(self): self.send_response(HTTPStatus.OK) diff --git a/server/tests-py/queries/actions/sync/create_user_fail.yaml b/server/tests-py/queries/actions/sync/create_user_fail.yaml new file mode 100644 index 0000000000000..625d5a6f044bb --- /dev/null +++ b/server/tests-py/queries/actions/sync/create_user_fail.yaml @@ -0,0 +1,17 @@ +description: Run create_user sync action mutation with invalid email +url: /v1/graphql +status: 200 +query: + query: | + mutation { + create_user(email: "random-email", name: "Clarke"){ + id + } + } + +response: + errors: + - extensions: + path: $ + code: invalid-email + message: Given email address is not valid diff --git a/server/tests-py/queries/actions/sync/create_user_success.yaml b/server/tests-py/queries/actions/sync/create_user_success.yaml new file mode 100644 index 0000000000000..0b911800a5d3c --- /dev/null +++ b/server/tests-py/queries/actions/sync/create_user_success.yaml @@ -0,0 +1,14 @@ +description: Run create_user sync action mutation with valid email +url: /v1/graphql +status: 200 +query: + query: | + mutation { + create_user(email: "clarke@gmail.com", name: "Clarke"){ + id + } + } +response: + data: + create_user: + id: 1 diff --git a/server/tests-py/queries/actions/sync/setup.yaml b/server/tests-py/queries/actions/sync/setup.yaml new file mode 100644 index 0000000000000..21be07e31b4c5 --- /dev/null +++ b/server/tests-py/queries/actions/sync/setup.yaml @@ -0,0 +1,43 @@ +type: bulk +args: +- type: run_sql + args: + sql: | + CREATE TABLE "user"( + id SERIAL PRIMARY KEY, + name TEXT NOT NULL, + email TEXT NOT NULL, + is_admin BOOLEAN NOT NULL DEFAULT false + ); + +- type: track_table + args: + name: user + schema: public + +- type: set_custom_types + args: + objects: + - name: UserId + fields: + - name: id + type: Int! + relationships: + - name: user + type: object + remote_table: user + field_mapping: + id: id + +- type: create_action + args: + name: create_user + definition: + kind: synchronous + arguments: + - name: email + type: String! + - name: name + type: String! + output_type: UserId + handler: http://127.0.0.1:5593/create-user diff --git a/server/tests-py/queries/actions/sync/teardown.yaml b/server/tests-py/queries/actions/sync/teardown.yaml new file mode 100644 index 0000000000000..5b4bfc6d4a39a --- /dev/null +++ b/server/tests-py/queries/actions/sync/teardown.yaml @@ -0,0 +1,15 @@ +type: bulk +args: +- type: drop_action + args: + name: create_user + clear_data: true +# clear custom types +- type: set_custom_types + args: {} + +- type: run_sql + args: + cascade: true + sql: | + DROP TABLE "user"; diff --git a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_one.yaml b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_one.yaml index 5ec715a828e22..bf8604ca84816 100644 --- a/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_one.yaml +++ b/server/tests-py/queries/graphql_mutation/insert/nested/author_with_articles_one.yaml @@ -31,9 +31,9 @@ query: response: data: insert_author_one: + id: 3 name: Author 3 articles: - - content: Article by Author 3 - id: 4 + - id: 4 title: Article 4 - id: 3 + content: Article by Author 3 diff --git a/server/tests-py/test_actions.py b/server/tests-py/test_actions.py new file mode 100644 index 0000000000000..dfe4a61f010ed --- /dev/null +++ b/server/tests-py/test_actions.py @@ -0,0 +1,25 @@ +#!/usr/bin/env python3 + +import pytest + +from validate import check_query_f +from super_classes import DefaultTestQueries + +""" +TODO:- +1. Actions metadata +2. Actions Asynchronous (query with action_id of an action created by other user) +3. Actions Permissions +""" + +class TestActionsSync(DefaultTestQueries): + + @classmethod + def dir(cls): + return 'queries/actions/sync' + + def test_create_user_fail(self, hge_ctx, actions_webhook): + check_query_f(hge_ctx, self.dir() + '/create_user_fail.yaml') + + def test_create_user_success(self, hge_ctx, actions_webhook): + check_query_f(hge_ctx, self.dir() + '/create_user_success.yaml') From 2e439c2d7a03b5631858203129e92438978bb0c4 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 6 Feb 2020 15:53:04 +0530 Subject: [PATCH 50/62] no-op refactor --- server/src-lib/Data/URL/Template.hs | 2 +- .../Hasura/GraphQL/Schema/Mutation/Delete.hs | 3 ++- server/src-lib/Hasura/RQL/DDL/Action.hs | 1 + server/src-lib/Hasura/RQL/DDL/Metadata.hs | 4 ++-- server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs | 13 ++++++------- server/src-lib/Hasura/RQL/Types.hs | 5 ----- server/src-rsr/migrations/25_to_26.sql | 1 + 7 files changed, 13 insertions(+), 16 deletions(-) diff --git a/server/src-lib/Data/URL/Template.hs b/server/src-lib/Data/URL/Template.hs index 6b1af77f175e2..02b7b7f0776b4 100644 --- a/server/src-lib/Data/URL/Template.hs +++ b/server/src-lib/Data/URL/Template.hs @@ -1,4 +1,4 @@ --- | Simple URL templating language enables interpolating environment variables +-- | A simple URL templating that enables interpolating an environment variable module Data.URL.Template ( URLTemplate diff --git a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs index 1e1c9282929a2..89e1bd72473af 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Mutation/Delete.hs @@ -38,7 +38,8 @@ mkDelMutFld mCustomName tn = {- delete_table_by_pk( -pk_columns: table_pk_columns_input! + col1: col-ty1! + col2: col-ty2! ): table -} diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 150428fcba8bb..82a9ece50e299 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -230,6 +230,7 @@ fetchActions = [Q.sql| SELECT action_name, action_defn, comment FROM hdb_catalog.hdb_action + ORDER BY action_name ASC |] () True where fromRow (actionName, Q.AltJ definition, comment) = diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index 176b10ecbb84d..ee811b00192bb 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -406,7 +406,7 @@ fetchMetadata = do 'definition', a.action_defn, 'comment', a.comment, 'permissions', ap.permissions - ) + ) order by a.action_name asc ), '[]' ) @@ -420,7 +420,7 @@ fetchMetadata = do 'role', ap.role_name, 'definition', ap.definition, 'comment', ap.comment - ) + ) order by ap.role_name asc ), '[]' ) as permissions diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index 20ff83ad8cd88..d8ebb6dfae98f 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -169,13 +169,12 @@ buildSchemaCacheRule = proc (catalogMetadata, invalidationKeys) -> do -- Step 3: Build the GraphQL schema. ((remoteSchemaMap, gqlSchema, remoteGQLSchema), gqlSchemaInconsistentObjects) - <- runWriterA buildGQLSchema - -< ( _boTables resolvedOutputs - , _boFunctions resolvedOutputs - , _boRemoteSchemas resolvedOutputs - , _boCustomTypes resolvedOutputs - , _boActions resolvedOutputs - ) + <- runWriterA buildGQLSchema -< ( _boTables resolvedOutputs + , _boFunctions resolvedOutputs + , _boRemoteSchemas resolvedOutputs + , _boCustomTypes resolvedOutputs + , _boActions resolvedOutputs + ) returnA -< SchemaCache { scTables = _boTables resolvedOutputs diff --git a/server/src-lib/Hasura/RQL/Types.hs b/server/src-lib/Hasura/RQL/Types.hs index 109deb4b6f3dc..990d64abc62ba 100644 --- a/server/src-lib/Hasura/RQL/Types.hs +++ b/server/src-lib/Hasura/RQL/Types.hs @@ -174,11 +174,6 @@ newtype HasSystemDefinedT m a = HasSystemDefinedT { unHasSystemDefinedT :: ReaderT SystemDefined m a } deriving ( Functor, Applicative, Monad, MonadTrans, MonadIO, MonadError e, MonadTx , HasHttpManager, HasSQLGenCtx, TableCoreInfoRM, CacheRM, CacheRWM, UserInfoM ) --- instance (CacheRM m) => CacheRM (HasSystemDefinedT m) where --- askSchemaCache = HasSystemDefinedT $ lift askSchemaCache - --- instance (CacheRWM m) => CacheRWM (HasSystemDefinedT m) where --- writeSchemaCache = HasSystemDefinedT . lift . writeSchemaCache runHasSystemDefinedT :: SystemDefined -> HasSystemDefinedT m a -> m a runHasSystemDefinedT systemDefined = flip runReaderT systemDefined . unHasSystemDefinedT diff --git a/server/src-rsr/migrations/25_to_26.sql b/server/src-rsr/migrations/25_to_26.sql index 3b56ab45eb617..8efb36611c0d0 100644 --- a/server/src-rsr/migrations/25_to_26.sql +++ b/server/src-rsr/migrations/25_to_26.sql @@ -103,3 +103,4 @@ WHERE ((pg_aggregate.aggfnoid) :: oid = p.oid) ) ) +); From d3ffcef154aa0fa506055157fbcafc50cc86b421 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 6 Feb 2020 18:50:44 +0530 Subject: [PATCH 51/62] fix output in async query & add async tests --- server/src-lib/Hasura/GraphQL/Resolve.hs | 4 +- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 133 ++++++------ .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 2 +- server/src-lib/Hasura/RQL/DML/Mutation.hs | 1 + .../src-lib/Hasura/RQL/DML/Select/Internal.hs | 16 +- server/src-lib/Hasura/RQL/DML/Select/Types.hs | 25 ++- .../tests-py/queries/actions/async/setup.yaml | 51 +++++ .../queries/actions/async/teardown.yaml | 15 ++ .../actions/sync/create_user_success.yaml | 9 + server/tests-py/test_actions.py | 202 +++++++++++++++++- 10 files changed, 370 insertions(+), 88 deletions(-) create mode 100644 server/tests-py/queries/actions/async/setup.yaml create mode 100644 server/tests-py/queries/actions/async/teardown.yaml diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 03bb40867c3ac..78d949871b2a4 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -102,7 +102,7 @@ queryFldToPGAST fld = do validateHdrs userInfo (_fqocHeaders ctx) QRFAgg <$> RS.convertFuncQueryAgg ctx fld QCActionFetch ctx -> - QRFActionSelect <$> RA.resolveAsyncResponse userInfo ctx fld + QRFActionSelect <$> RA.resolveAsyncActionQuery userInfo ctx fld mutFldToTx :: ( HasVersion @@ -144,7 +144,7 @@ mutFldToTx fld = do validateHdrs userInfo (_docHeaders ctx) RM.convertDeleteByPk ctx fld MCAction ctx -> - RA.resolveActionInsert fld ctx (userVars userInfo) + RA.resolveActionMutation fld ctx (userVars userInfo) getOpCtx :: ( MonadReusability m diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 8b011d186918d..bbb07b040e287 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -1,8 +1,8 @@ module Hasura.GraphQL.Resolve.Action - ( resolveActionSelect - , resolveActionInsert + ( resolveActionMutation + , resolveAsyncActionQuery , asyncActionsProcessor - , resolveAsyncResponse + --, resolveActionSelect -- , resolveResponseSelectionSet , ActionSelect(..) @@ -70,39 +70,39 @@ data ResponseFieldResolved | ResponseFieldTypename !G.NamedType deriving (Show, Eq) -resolveOutputSelectionSet - :: (MonadError QErr m) - => G.NamedType - -> SelSet - -> m [(Text, OutputFieldResolved)] -resolveOutputSelectionSet ty selSet = - withSelSet selSet $ \fld -> case _fName fld of - "__typename" -> return $ OutputFieldTypename ty - G.Name t -> return $ OutputFieldSimple t - -resolveResponseSelectionSet - :: (MonadError QErr m) - => G.NamedType - -> SelSet - -> m [(Text, ResponseFieldResolved)] -resolveResponseSelectionSet ty selSet = - withSelSet selSet $ \fld -> case _fName fld of - "__typename" -> return $ ResponseFieldTypename ty - - "output" -> - ResponseFieldOutput <$> - resolveOutputSelectionSet (_fType fld) (_fSelSet fld) - - -- the metadata columns - "id" -> return $ mkMetadataField "id" - "created_at" -> return $ mkMetadataField "created_at" - "status" -> return $ mkMetadataField "status" - "errors" -> return $ mkMetadataField "errors" - - G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t - - where - mkMetadataField = ResponseFieldMetadata . FieldName +-- resolveOutputSelectionSet +-- :: (MonadError QErr m) +-- => G.NamedType +-- -> SelSet +-- -> m [(Text, OutputFieldResolved)] +-- resolveOutputSelectionSet ty selSet = +-- withSelSet selSet $ \fld -> case _fName fld of +-- "__typename" -> return $ OutputFieldTypename ty +-- G.Name t -> return $ OutputFieldSimple t + +-- resolveResponseSelectionSet +-- :: (MonadError QErr m) +-- => G.NamedType +-- -> SelSet +-- -> m [(Text, ResponseFieldResolved)] +-- resolveResponseSelectionSet ty selSet = +-- withSelSet selSet $ \fld -> case _fName fld of +-- "__typename" -> return $ ResponseFieldTypename ty + +-- "output" -> +-- ResponseFieldOutput <$> +-- resolveOutputSelectionSet (_fType fld) (_fSelSet fld) + +-- -- the metadata columns +-- "id" -> return $ mkMetadataField "id" +-- "created_at" -> return $ mkMetadataField "created_at" +-- "status" -> return $ mkMetadataField "status" +-- "errors" -> return $ mkMetadataField "errors" + +-- G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t + +-- where +-- mkMetadataField = ResponseFieldMetadata . FieldName data ActionSelect v @@ -121,7 +121,7 @@ traverseActionSelect f (ActionSelect idText selection rowFilter) = ActionSelect <$> f idText <*> pure selection <*> traverseAnnBoolExp f rowFilter type ActionSelectResolved = ActionSelect S.SQLExp -type ActionSelectUnresolved = ActionSelect UnresolvedVal +-- type ActionSelectUnresolved = ActionSelect UnresolvedVal actionSelectToSql :: ActionSelectResolved -> Q.Query actionSelectToSql (ActionSelect actionIdExp selection _) = @@ -165,24 +165,24 @@ actionSelectToSql (ActionSelect actionIdExp selection _) = \(alias, field) -> [S.SELit alias, f field] -resolveActionSelect - :: ( MonadReusability m - , MonadError QErr m - ) - => ActionSelectOpContext - -> Field - -> m ActionSelectUnresolved -resolveActionSelect selectContext field = do - actionId <- withArg (_fArguments field) "id" parseActionId - responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ - _fSelSet field - return $ ActionSelect actionId responseSelectionSet unresolvedFilter - where - unresolvedFilter = - fmapAnnBoolExp partialSQLExpToUnresolvedVal $ - _asocFilter selectContext - parseActionId annInpValue = do - mkParameterizablePGValue <$> asPGColumnValue annInpValue +-- resolveActionSelect +-- :: ( MonadReusability m +-- , MonadError QErr m +-- ) +-- => ActionSelectOpContext +-- -> Field +-- -> m ActionSelectUnresolved +-- resolveActionSelect selectContext field = do +-- actionId <- withArg (_fArguments field) "id" parseActionId +-- responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ +-- _fSelSet field +-- return $ ActionSelect actionId responseSelectionSet unresolvedFilter +-- where +-- unresolvedFilter = +-- fmapAnnBoolExp partialSQLExpToUnresolvedVal $ +-- _asocFilter selectContext +-- parseActionId annInpValue = do +-- mkParameterizablePGValue <$> asPGColumnValue annInpValue -- actionSelectToTx :: ActionSelectResolved -> RespTx -- actionSelectToTx actionSelect = @@ -235,7 +235,7 @@ processOutputSelectionSet tableRowInput definitionList fldTy flds = do functionArgs = RS.FunctionArgsExp [tableRowInput] mempty selectFrom = RS.FromFunction jsonbToRecordFunction functionArgs $ Just definitionList -resolveActionInsertSync +resolveActionMutationSync :: ( HasVersion , MonadReusability m , MonadError QErr m @@ -251,7 +251,7 @@ resolveActionInsertSync -> SyncActionExecutionContext -> UserVars -> m RespTx -resolveActionInsertSync field executionContext sessionVariables = do +resolveActionMutationSync field executionContext sessionVariables = do let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field actionContext = ActionContext actionName handlerPayload = ActionWebhookPayload actionContext sessionVariables inputArgs @@ -426,7 +426,7 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do -resolveActionInsert +resolveActionMutation :: ( HasVersion , MonadReusability m , MonadError QErr m @@ -443,15 +443,15 @@ resolveActionInsert -- We need the sesion variables for column presets -> UserVars -> m RespTx -resolveActionInsert field executionContext sessionVariables = +resolveActionMutation field executionContext sessionVariables = case executionContext of ActionExecutionSyncWebhook executionContextSync -> - resolveActionInsertSync field executionContextSync sessionVariables + resolveActionMutationSync field executionContextSync sessionVariables ActionExecutionAsync actionFilter -> - resolveActionInsertAsync field actionFilter sessionVariables + resolveActionMutationAsync field actionFilter sessionVariables -- | Resolve asynchronous action mutation which returns only the action uuid -resolveActionInsertAsync +resolveActionMutationAsync :: ( MonadError QErr m, MonadReader r m , Has [HTTP.Header] r ) @@ -460,7 +460,7 @@ resolveActionInsertAsync -- We need the sesion variables for column presets -> UserVars -> m RespTx -resolveActionInsertAsync field _ sessionVariables = do +resolveActionMutationAsync field _ sessionVariables = do -- responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ _fSelSet field reqHeaders <- asks getter @@ -522,7 +522,7 @@ annInpValueToJson annInpValue = AGObject _ objectM -> J.toJSON $ fmap (fmap annInpValueToJson) objectM AGArray _ valuesM -> J.toJSON $ fmap (fmap annInpValueToJson) valuesM -resolveAsyncResponse +resolveAsyncActionQuery :: ( MonadReusability m , MonadError QErr m , MonadReader r m @@ -534,7 +534,7 @@ resolveAsyncResponse -> ActionSelectOpContext -> Field -> m GRS.AnnSimpleSelect -resolveAsyncResponse userInfo selectContext field = do +resolveAsyncActionQuery userInfo selectContext field = do actionId <- withArg (_fArguments field) "id" parseActionId stringifyNumerics <- stringifyNum <$> asks getter @@ -545,7 +545,8 @@ resolveAsyncResponse userInfo selectContext field = do -- Treating "output" as a computed field to "hdb_action_log" table with "jsonb_to_record" SQL function let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload" definitionList = _asocDefinitionList selectContext - (RS.FComputedField . RS.CFSTable) <$> processOutputSelectionSet inputTableArgument definitionList (_fType fld) (_fSelSet fld) + (RS.FComputedField . RS.CFSTable True) -- The output of action is always a single object + <$> processOutputSelectionSet inputTableArgument definitionList (_fType fld) (_fSelSet fld) -- the metadata columns "id" -> return $ mkAnnFldFromPGCol "id" PGUUID "created_at" -> return $ mkAnnFldFromPGCol "created_at" PGTimeStampTZ diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 5d8278c34caf9..63302287a6183 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -67,7 +67,7 @@ resolveComputedField computedField fld = fieldAsPath fld $ do RS.ComputedFieldScalarSel qf argsWithTableArgument scalarTy colOpM CFTTable (ComputedFieldTable _ cols permFilter permLimit) -> do let functionFrom = RS.FromFunction qf argsWithTableArgument Nothing - RS.CFSTable <$> fromField functionFrom cols permFilter permLimit fld + RS.CFSTable False <$> fromField functionFrom cols permFilter permLimit fld where ComputedField _ function argSeq fieldType = computedField ComputedFieldFunction qf _ tableArg _ = function diff --git a/server/src-lib/Hasura/RQL/DML/Mutation.hs b/server/src-lib/Hasura/RQL/DML/Mutation.hs index 42dca7f10ea4d..e8aa8ae44d450 100644 --- a/server/src-lib/Hasura/RQL/DML/Mutation.hs +++ b/server/src-lib/Hasura/RQL/DML/Mutation.hs @@ -132,6 +132,7 @@ mkSelCTEFromColVals qt allCols colVals = S.withTyAnn (unsafePGColumnToRepresentation colTy) $ S.SELit textValue -- | Note: Expecting '{"returning": [{}]}' encoded JSON +-- FIXME:- If possible, move this logic to SQL withSingleTableRow :: MonadError QErr m => EncJSON -> m EncJSON withSingleTableRow response = diff --git a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs index 2b98c8748bb25..55784b52b620b 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs @@ -229,7 +229,7 @@ buildJsonObject pfx parAls arrRelCtx strfyNum flds = in S.mkQIdenExp arrPfx fldAls FComputedField (CFSScalar computedFieldScalar) -> fromScalarComputedField computedFieldScalar - FComputedField (CFSTable _) -> + FComputedField (CFSTable _ _) -> let ccPfx = mkComputedFieldTableAls pfx fldAls in S.mkQIdenExp ccPfx fldAls @@ -646,10 +646,10 @@ mkBaseNode subQueryReq pfxs fldAls annSelFlds selectFrom in (arrAls, arrNode) -- process a computed field, which returns a table - mkComputedFieldTable (fld, sel) = + mkComputedFieldTable (fld, asObject, sel) = let prefixes = Prefixes (mkComputedFieldTableAls thisPfx fld) thisPfx baseNode = annSelToBaseNode False prefixes fld sel - in (fld, baseNode) + in (fld, CFTableNode asObject baseNode) getAnnObj (f, annFld) = case annFld of FObj ob -> Just (f, ob) @@ -660,8 +660,8 @@ mkBaseNode subQueryReq pfxs fldAls annSelFlds selectFrom _ -> Nothing getComputedFieldTable (f, annFld) = case annFld of - FComputedField (CFSTable sel) -> Just (f, sel) - _ -> Nothing + FComputedField (CFSTable b sel) -> Just (f, b, sel) + _ -> Nothing annSelToBaseNode :: Bool -> Prefixes -> FieldName -> AnnSimpleSel -> BaseNode annSelToBaseNode subQueryReq pfxs fldAls annSel = @@ -742,11 +742,11 @@ baseNodeToSel joinCond baseNode = als = S.Alias $ _bnPrefix bn in S.mkLateralFromItem sel als - computedFieldNodeToFromItem :: (FieldName, BaseNode) -> S.FromItem - computedFieldNodeToFromItem (fld, bn) = + computedFieldNodeToFromItem :: (FieldName, CFTableNode) -> S.FromItem + computedFieldNodeToFromItem (fld, CFTableNode asObject bn) = let internalSel = baseNodeToSel (S.BELit True) bn als = S.Alias $ _bnPrefix bn - extr = asJsonAggExtr False (S.toAlias fld) False Nothing $ + extr = asJsonAggExtr asObject (S.toAlias fld) False Nothing $ _bnOrderBy bn internalSelFrom = S.mkSelFromItem internalSel als sel = S.mkSelect diff --git a/server/src-lib/Hasura/RQL/DML/Select/Types.hs b/server/src-lib/Hasura/RQL/DML/Select/Types.hs index d912e82ae94f1..d8aaa4ce4f43b 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Types.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Types.hs @@ -105,7 +105,7 @@ data ComputedFieldScalarSel v data ComputedFieldSel v = CFSScalar !(ComputedFieldScalarSel v) - | CFSTable !(AnnSimpleSelG v) + | CFSTable !Bool !(AnnSimpleSelG v) deriving (Show, Eq) traverseComputedFieldSel @@ -114,7 +114,7 @@ traverseComputedFieldSel -> ComputedFieldSel v -> f (ComputedFieldSel w) traverseComputedFieldSel fv = \case CFSScalar scalarSel -> CFSScalar <$> traverse fv scalarSel - CFSTable tableSel -> CFSTable <$> traverseAnnSimpleSel fv tableSel + CFSTable b tableSel -> CFSTable b <$> traverseAnnSimpleSel fv tableSel type Fields a = [(FieldName, a)] @@ -372,7 +372,7 @@ data BaseNode , _bnExtrs :: !(HM.HashMap S.Alias S.SQLExp) , _bnObjs :: !(HM.HashMap RelName ObjNode) , _bnArrs :: !(HM.HashMap S.Alias ArrNode) - , _bnComputedFieldTables :: !(HM.HashMap FieldName BaseNode) + , _bnComputedFieldTables :: !(HM.HashMap FieldName CFTableNode) } deriving (Show, Eq) mergeBaseNodes :: BaseNode -> BaseNode -> BaseNode @@ -381,11 +381,11 @@ mergeBaseNodes lNodeDet rNodeDet = (HM.union lExtrs rExtrs) (HM.unionWith mergeObjNodes lObjs rObjs) (HM.unionWith mergeArrNodes lArrs rArrs) - (HM.unionWith mergeBaseNodes lCompCols rCompCols) + (HM.unionWith mergeCFTableNodes lCFTables rCFTables) where - BaseNode pfx dExp f whr ordBy limit offset lExtrs lObjs lArrs lCompCols + BaseNode pfx dExp f whr ordBy limit offset lExtrs lObjs lArrs lCFTables = lNodeDet - BaseNode _ _ _ _ _ _ _ rExtrs rObjs rArrs rCompCols + BaseNode _ _ _ _ _ _ _ rExtrs rObjs rArrs rCFTables = rNodeDet data OrderByNode @@ -449,6 +449,19 @@ data ArrNodeInfo , _aniSubQueryRequired :: !Bool } deriving (Show, Eq) +-- | Node for computed field returning setof +data CFTableNode + = CFTableNode + { _ctnAsSingleObject :: !Bool + , _ctnNode :: !BaseNode + } deriving (Show, Eq) + +mergeCFTableNodes :: CFTableNode -> CFTableNode -> CFTableNode +mergeCFTableNodes lNode rNode = + CFTableNode + (_ctnAsSingleObject lNode && _ctnAsSingleObject rNode) + (mergeBaseNodes (_ctnNode lNode) (_ctnNode rNode)) + data Prefixes = Prefixes { _pfThis :: !Iden -- Current node prefix diff --git a/server/tests-py/queries/actions/async/setup.yaml b/server/tests-py/queries/actions/async/setup.yaml new file mode 100644 index 0000000000000..163f9d81dde6e --- /dev/null +++ b/server/tests-py/queries/actions/async/setup.yaml @@ -0,0 +1,51 @@ +type: bulk +args: +- type: run_sql + args: + sql: | + CREATE TABLE "user"( + id SERIAL PRIMARY KEY, + name TEXT NOT NULL, + email TEXT NOT NULL, + is_admin BOOLEAN NOT NULL DEFAULT false + ); + +- type: track_table + args: + name: user + schema: public + +- type: set_custom_types + args: + objects: + - name: UserId + fields: + - name: id + type: Int! + relationships: + - name: user + type: object + remote_table: user + field_mapping: + id: id + +- type: create_action + args: + name: create_user + definition: + kind: asynchronous + arguments: + - name: email + type: String! + - name: name + type: String! + output_type: UserId + handler: http://127.0.0.1:5593/create-user + +- type: create_action_permission + args: + action: create_user + role: user + definition: + select: + filter: {} diff --git a/server/tests-py/queries/actions/async/teardown.yaml b/server/tests-py/queries/actions/async/teardown.yaml new file mode 100644 index 0000000000000..27638828d7804 --- /dev/null +++ b/server/tests-py/queries/actions/async/teardown.yaml @@ -0,0 +1,15 @@ +type: bulk +args: +- type: drop_action # also drops the permissions + args: + name: create_user + clear_data: true +# clear custom types +- type: set_custom_types + args: {} + +- type: run_sql + args: + cascade: true + sql: | + DROP TABLE "user"; diff --git a/server/tests-py/queries/actions/sync/create_user_success.yaml b/server/tests-py/queries/actions/sync/create_user_success.yaml index 0b911800a5d3c..f4687f68f2bd4 100644 --- a/server/tests-py/queries/actions/sync/create_user_success.yaml +++ b/server/tests-py/queries/actions/sync/create_user_success.yaml @@ -6,9 +6,18 @@ query: mutation { create_user(email: "clarke@gmail.com", name: "Clarke"){ id + user { + name + email + is_admin + } } } response: data: create_user: id: 1 + user: + name: Clarke + email: clarke@gmail.com + is_admin: false diff --git a/server/tests-py/test_actions.py b/server/tests-py/test_actions.py index dfe4a61f010ed..a3b575c9684f7 100644 --- a/server/tests-py/test_actions.py +++ b/server/tests-py/test_actions.py @@ -1,15 +1,13 @@ #!/usr/bin/env python3 import pytest +import time -from validate import check_query_f +from validate import check_query_f, check_query from super_classes import DefaultTestQueries """ -TODO:- -1. Actions metadata -2. Actions Asynchronous (query with action_id of an action created by other user) -3. Actions Permissions +TODO:- Test Actions metadata """ class TestActionsSync(DefaultTestQueries): @@ -23,3 +21,197 @@ def test_create_user_fail(self, hge_ctx, actions_webhook): def test_create_user_success(self, hge_ctx, actions_webhook): check_query_f(hge_ctx, self.dir() + '/create_user_success.yaml') + +class TestActionsAsync(DefaultTestQueries): + @classmethod + def dir(cls): + return 'queries/actions/async' + + def test_create_user_fail(self, hge_ctx, actions_webhook): + graphql_mutation = ''' + mutation { + create_user(email: "random-email", name: "Clarke") + } + ''' + query = { + 'query': graphql_mutation, + 'variables': {} + } + status, resp, headers = hge_ctx.anyq('/v1/graphql', query, {}) + assert status == 200, resp + assert 'data' in resp + action_id = resp['data']['create_user'] + time.sleep(2) + + query_async = ''' + query ($action_id: uuid!){ + create_user(id: $action_id){ + id + errors + } + } + ''' + query = { + 'query': query_async, + 'variables': { + 'action_id': action_id + } + } + response = { + 'data': { + 'create_user': { + 'id': action_id, + 'errors': { + 'code': 'invalid-email', + 'path': '$', + 'error': 'Given email address is not valid' + } + } + } + } + conf = { + 'url': '/v1/graphql', + 'headers': {}, + 'query': query, + 'status': 200, + 'response': response + } + check_query(hge_ctx, conf) + + def test_create_user_success(self, hge_ctx, actions_webhook): + graphql_mutation = ''' + mutation { + create_user(email: "clarke@hasura.io", name: "Clarke") + } + ''' + query = { + 'query': graphql_mutation, + 'variables': {} + } + status, resp, headers = hge_ctx.anyq('/v1/graphql', query, {}) + assert status == 200, resp + assert 'data' in resp + action_id = resp['data']['create_user'] + time.sleep(2) + + query_async = ''' + query ($action_id: uuid!){ + create_user(id: $action_id){ + id + output { + id + user { + name + email + is_admin + } + } + } + } + ''' + query = { + 'query': query_async, + 'variables': { + 'action_id': action_id + } + } + response = { + 'data': { + 'create_user': { + 'id': action_id, + 'output': { + 'id': 1, + 'user': { + 'name': 'Clarke', + 'email': 'clarke@hasura.io', + 'is_admin': False + } + } + } + } + } + conf = { + 'url': '/v1/graphql', + 'headers': {}, + 'query': query, + 'status': 200, + 'response': response + } + check_query(hge_ctx, conf) + + def test_create_user_roles(self, hge_ctx, actions_webhook): + graphql_mutation = ''' + mutation { + create_user(email: "blake@hasura.io", name: "Blake") + } + ''' + query = { + 'query': graphql_mutation, + 'variables': {} + } + headers = { + 'X-Hasura-Role': 'user', + 'X-Hasura-User-Id': '1' + } + # create action with user-id 1 + status, resp, headers = hge_ctx.anyq('/v1/graphql', query, headers) + assert status == 200, resp + assert 'data' in resp + action_id = resp['data']['create_user'] + time.sleep(2) + + query_async = ''' + query ($action_id: uuid!){ + create_user(id: $action_id){ + id + output { + id + } + } + } + ''' + query = { + 'query': query_async, + 'variables': { + 'action_id': action_id + } + } + + conf_user_2 = { + 'url': '/v1/graphql', + 'headers': { + 'X-Hasura-Role': 'user', + 'X-Hasura-User-Id': '2' + }, + 'query': query, + 'status': 200, + 'response': { + 'data': { + 'create_user': None # User 2 shouldn't able to access the action + } + } + } + # Query the action as user-id 2 + check_query(hge_ctx, conf_user_2) + + conf_user_1 = { + 'url': '/v1/graphql', + 'headers': { + 'X-Hasura-Role': 'user', + 'X-Hasura-User-Id': '1' + }, + 'query': query, + 'status': 200, + 'response': { + 'data': { + 'create_user': { + 'id': action_id, + 'output': { + 'id': 1 + } + } + } + } + } + # Query the action as user-id 1 + check_query(hge_ctx, conf_user_1) From 5268b2a66073f56bfe3f3edbd2e377503b13a1ee Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Fri, 7 Feb 2020 11:19:00 +0530 Subject: [PATCH 52/62] add admin secret header in async actions python test --- server/tests-py/test_actions.py | 37 ++++++++++++++++++++------------- 1 file changed, 22 insertions(+), 15 deletions(-) diff --git a/server/tests-py/test_actions.py b/server/tests-py/test_actions.py index a3b575c9684f7..3ddfff0454f19 100644 --- a/server/tests-py/test_actions.py +++ b/server/tests-py/test_actions.py @@ -27,6 +27,13 @@ class TestActionsAsync(DefaultTestQueries): def dir(cls): return 'queries/actions/async' + def mk_headers_with_secret(self, hge_ctx, headers={}): + admin_secret = hge_ctx.hge_key + if admin_secret: + headers['X-Hasura-Admin-Secret'] = admin_secret + return headers + + def test_create_user_fail(self, hge_ctx, actions_webhook): graphql_mutation = ''' mutation { @@ -37,7 +44,7 @@ def test_create_user_fail(self, hge_ctx, actions_webhook): 'query': graphql_mutation, 'variables': {} } - status, resp, headers = hge_ctx.anyq('/v1/graphql', query, {}) + status, resp, _ = hge_ctx.anyq('/v1/graphql', query, self.mk_headers_with_secret(hge_ctx)) assert status == 200, resp assert 'data' in resp action_id = resp['data']['create_user'] @@ -88,7 +95,7 @@ def test_create_user_success(self, hge_ctx, actions_webhook): 'query': graphql_mutation, 'variables': {} } - status, resp, headers = hge_ctx.anyq('/v1/graphql', query, {}) + status, resp, _ = hge_ctx.anyq('/v1/graphql', query, self.mk_headers_with_secret(hge_ctx)) assert status == 200, resp assert 'data' in resp action_id = resp['data']['create_user'] @@ -149,12 +156,12 @@ def test_create_user_roles(self, hge_ctx, actions_webhook): 'query': graphql_mutation, 'variables': {} } - headers = { + headers_user_1 = self.mk_headers_with_secret(hge_ctx, { 'X-Hasura-Role': 'user', 'X-Hasura-User-Id': '1' - } + }) # create action with user-id 1 - status, resp, headers = hge_ctx.anyq('/v1/graphql', query, headers) + status, resp, headers = hge_ctx.anyq('/v1/graphql', query, headers_user_1) assert status == 200, resp assert 'data' in resp action_id = resp['data']['create_user'] @@ -177,12 +184,13 @@ def test_create_user_roles(self, hge_ctx, actions_webhook): } } + headers_user_2 = self.mk_headers_with_secret(hge_ctx, { + 'X-Hasura-Role': 'user', + 'X-Hasura-User-Id': '2' + }) conf_user_2 = { 'url': '/v1/graphql', - 'headers': { - 'X-Hasura-Role': 'user', - 'X-Hasura-User-Id': '2' - }, + 'headers': headers_user_2, 'query': query, 'status': 200, 'response': { @@ -192,14 +200,12 @@ def test_create_user_roles(self, hge_ctx, actions_webhook): } } # Query the action as user-id 2 - check_query(hge_ctx, conf_user_2) + # Make request without auth using admin_secret + check_query(hge_ctx, conf_user_2, add_auth = False) conf_user_1 = { 'url': '/v1/graphql', - 'headers': { - 'X-Hasura-Role': 'user', - 'X-Hasura-User-Id': '1' - }, + 'headers': headers_user_1, 'query': query, 'status': 200, 'response': { @@ -214,4 +220,5 @@ def test_create_user_roles(self, hge_ctx, actions_webhook): } } # Query the action as user-id 1 - check_query(hge_ctx, conf_user_1) + # Make request without auth using admin_secret + check_query(hge_ctx, conf_user_1, add_auth = False) From baf40ff6e8796cf45a3ffc01b01c204d904b4b9c Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Fri, 7 Feb 2020 14:20:01 +0530 Subject: [PATCH 53/62] remove comments in resolve/action.hs --- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 184 +----------------- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 7 +- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 2 +- 3 files changed, 11 insertions(+), 182 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index bbb07b040e287..4bfa61039bfb8 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -2,12 +2,9 @@ module Hasura.GraphQL.Resolve.Action ( resolveActionMutation , resolveAsyncActionQuery , asyncActionsProcessor - --, resolveActionSelect - -- , resolveResponseSelectionSet , ActionSelect(..) , traverseActionSelect - , actionSelectToSql ) where import Hasura.Prelude @@ -34,7 +31,6 @@ import qualified Network.Wreq as Wreq import qualified Hasura.GraphQL.Resolve.Select as GRS import qualified Hasura.RQL.DML.Select as RS -import qualified Hasura.SQL.DML as S import Hasura.EncJSON import Hasura.GraphQL.Resolve.Context @@ -54,11 +50,6 @@ import Hasura.SQL.Types import Hasura.SQL.Value (PGScalarValue (..), pgScalarValueToJson, toTxtValue) -data InputFieldResolved - = InputFieldSimple !Text - | InputFieldTypename !G.NamedType - deriving (Show, Eq) - data OutputFieldResolved = OutputFieldSimple !Text | OutputFieldTypename !G.NamedType @@ -70,41 +61,6 @@ data ResponseFieldResolved | ResponseFieldTypename !G.NamedType deriving (Show, Eq) --- resolveOutputSelectionSet --- :: (MonadError QErr m) --- => G.NamedType --- -> SelSet --- -> m [(Text, OutputFieldResolved)] --- resolveOutputSelectionSet ty selSet = --- withSelSet selSet $ \fld -> case _fName fld of --- "__typename" -> return $ OutputFieldTypename ty --- G.Name t -> return $ OutputFieldSimple t - --- resolveResponseSelectionSet --- :: (MonadError QErr m) --- => G.NamedType --- -> SelSet --- -> m [(Text, ResponseFieldResolved)] --- resolveResponseSelectionSet ty selSet = --- withSelSet selSet $ \fld -> case _fName fld of --- "__typename" -> return $ ResponseFieldTypename ty - --- "output" -> --- ResponseFieldOutput <$> --- resolveOutputSelectionSet (_fType fld) (_fSelSet fld) - --- -- the metadata columns --- "id" -> return $ mkMetadataField "id" --- "created_at" -> return $ mkMetadataField "created_at" --- "status" -> return $ mkMetadataField "status" --- "errors" -> return $ mkMetadataField "errors" - --- G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t - --- where --- mkMetadataField = ResponseFieldMetadata . FieldName - - data ActionSelect v = ActionSelect { _asId :: !v @@ -120,74 +76,6 @@ traverseActionSelect traverseActionSelect f (ActionSelect idText selection rowFilter) = ActionSelect <$> f idText <*> pure selection <*> traverseAnnBoolExp f rowFilter -type ActionSelectResolved = ActionSelect S.SQLExp --- type ActionSelectUnresolved = ActionSelect UnresolvedVal - -actionSelectToSql :: ActionSelectResolved -> Q.Query -actionSelectToSql (ActionSelect actionIdExp selection _) = - Q.fromBuilder $ toSQL selectAST - where - selectAST = - S.mkSelect - { S.selFrom = Just $ S.FromExp $ pure $ S.FISimple actionLogTable Nothing - , S.selExtr = pure $ S.Extractor - (usingJsonBuildObj selection responseFieldToSQLExp) - -- we need the root alias because subscription refers - -- to this particular field - (Just $ S.toAlias $ Iden "root") - , S.selWhere = Just $ S.WhereFrag whereExpression - } - - whereExpression = - S.BECompare S.SEQ (S.mkSIdenExp $ Iden "id") actionIdExp - -- we need this annotation because ID is mapped to text - -- and hence the prepared value will be a PGText - -- S.SETyAnn actionIdExp $ S.TypeAnn "uuid" - - actionLogTable = - QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log") - - responseFieldToSQLExp = \case - ResponseFieldOutput fields -> usingJsonBuildObj fields outputFieldToSQLExp - ResponseFieldMetadata columnName -> S.SEIden $ toIden columnName - ResponseFieldTypename ty -> S.SELit $ G.unName $ G.unNamedType ty - - outputFieldToSQLExp = \case - OutputFieldSimple fieldName -> - S.SEOpApp (S.SQLOp "->>") [outputColumn, S.SELit fieldName] - OutputFieldTypename ty -> S.SELit $ G.unName $ G.unNamedType ty - where - outputColumn = S.SEIden $ Iden "response_payload" - - usingJsonBuildObj :: [(Text, a)] -> (a -> S.SQLExp) -> S.SQLExp - usingJsonBuildObj l f = - S.applyJsonBuildObj $ flip concatMap l $ - \(alias, field) -> [S.SELit alias, f field] - - --- resolveActionSelect --- :: ( MonadReusability m --- , MonadError QErr m --- ) --- => ActionSelectOpContext --- -> Field --- -> m ActionSelectUnresolved --- resolveActionSelect selectContext field = do --- actionId <- withArg (_fArguments field) "id" parseActionId --- responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ --- _fSelSet field --- return $ ActionSelect actionId responseSelectionSet unresolvedFilter --- where --- unresolvedFilter = --- fmapAnnBoolExp partialSQLExpToUnresolvedVal $ --- _asocFilter selectContext --- parseActionId annInpValue = do --- mkParameterizablePGValue <$> asPGColumnValue annInpValue - --- actionSelectToTx :: ActionSelectResolved -> RespTx --- actionSelectToTx actionSelect = --- asSingleRowJsonResp (actionSelectToSql actionSelect) [] - newtype ActionContext = ActionContext {_acName :: ActionName} deriving (Show, Eq) @@ -258,18 +146,15 @@ resolveActionMutationSync field executionContext sessionVariables = do manager <- asks getter reqHeaders <- asks getter webhookRes <- callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook handlerPayload - case returnStrategy of - ReturnJson -> return $ return $ encJFromJValue webhookRes - ExecOnPostgres definitionList -> do - let webhookResponseExpression = RS.AEInput $ UVSQL $ - toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB webhookRes - selectAstUnresolved <- - processOutputSelectionSet webhookResponseExpression definitionList - (_fType field) $ _fSelSet field - astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved - return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] + let webhookResponseExpression = RS.AEInput $ UVSQL $ + toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB webhookRes + selectAstUnresolved <- + processOutputSelectionSet webhookResponseExpression definitionList + (_fType field) $ _fSelSet field + astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved + return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] where - SyncActionExecutionContext actionName returnStrategy resolvedWebhook confHeaders + SyncActionExecutionContext actionName definitionList resolvedWebhook confHeaders forwardClientHeaders = executionContext callWebhook @@ -412,20 +297,6 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do getUndeliveredEvents = runTx undeliveredEventsQuery - -- map uncurryEvent <$> - -- Q.listQE defaultTxErrorHandler [Q.sql| - -- update hdb_catalog.hdb_action_log set status = 'processing' - -- where - -- id in ( - -- select id from hdb_catalog.hdb_action_log - -- where status = 'created' - -- for update skip locked limit 10 - -- ) returning action_name, session_variables, input_payload - -- |] - - - - resolveActionMutation :: ( HasVersion , MonadReusability m @@ -461,20 +332,8 @@ resolveActionMutationAsync -> UserVars -> m RespTx resolveActionMutationAsync field _ sessionVariables = do - - -- responseSelectionSet <- resolveResponseSelectionSet (_fType field) $ _fSelSet field reqHeaders <- asks getter let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field - - -- resolvedPresetFields <- resolvePresetFields - - -- The order of the union doesn't matter as the allowed input - -- and the present fields are mutually exclusive - -- let actionInput = OMap.union inputArgs resolvedPresetFields - - -- resolvedFilter <- resolveFilter - -- let resolvedFilter = annBoolExpTrue - pure $ do actionId <- runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler [Q.sql| INSERT INTO @@ -487,31 +346,10 @@ resolveActionMutationAsync field _ sessionVariables = do (actionName, Q.AltJ sessionVariables, Q.AltJ $ toHeadersMap reqHeaders, Q.AltJ inputArgs, "created"::Text) False pure $ encJFromJValue $ UUID.toText actionId - -- actionSelectToTx $ - -- ActionSelect (S.SELit $ UUID.toText actionId) - -- responseSelectionSet resolvedFilter where actionName = G.unName $ _fName field toHeadersMap = Map.fromList . map ((bsToTxt . CI.original) *** bsToTxt) - -- resolveFilter = - -- flip traverseAnnBoolExp (_aiocSelectFilter insertContext) $ \case - -- PSESQLExp e -> return e - -- PSESessVar variableTy sessVar -> do - -- sessionVariableValueExp <- S.SELit <$> fetchSessionVariableValue sessVar - -- return $ undefined variableTy sessionVariableValueExp - - -- fetchSessionVariableValue sessionVariable = - -- onNothing (getVarVal sessionVariable sessionVariables) $ - -- throw500 $ "missing required session variable: " <> sessionVariable - - -- resolvePresetFields = - -- fmap OMap.fromList $ forM (Map.toList $ _aiocPresetFields insertContext) $ - -- \(k, v) -> (unActionInputField k,) <$> case v of - -- Left sessVariable -> J.toJSON <$> fetchSessionVariableValue sessVariable - -- Right scalarValue -> return scalarValue - - annInpValueToJson :: AnnInpVal -> J.Value annInpValueToJson annInpValue = case _aivValue annInpValue of @@ -551,7 +389,6 @@ resolveAsyncActionQuery userInfo selectContext field = do "id" -> return $ mkAnnFldFromPGCol "id" PGUUID "created_at" -> return $ mkAnnFldFromPGCol "created_at" PGTimeStampTZ "errors" -> return $ mkAnnFldFromPGCol "errors" PGJSONB - -- "status" -> return $ mkAnnFldFromPGCol "status" G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t let tableFromExp = RS.FromTable actionLogTable @@ -561,13 +398,10 @@ resolveAsyncActionQuery userInfo selectContext field = do selectAstUnresolved = RS.AnnSelG annotatedFields tableFromExp tablePermissions tableArguments stringifyNumerics return selectAstUnresolved - - -- astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved - -- return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] where - -- outputRelName = RelName $ mkNonEmptyTextUnsafe "output" actionLogTable = QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log") + -- TODO:- Avoid using PGColumnInfo mkAnnFldFromPGCol column columnType = flip RS.mkAnnColField Nothing $ PGColumnInfo (unsafePGCol column) (G.Name column) 0 (PGColumnScalar columnType) True Nothing diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index c13d99e0459bc..47e66721f417d 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -101,15 +101,10 @@ data DelOpCtx , _docFilter :: !AnnBoolExpPartialSQL } deriving (Show, Eq) -data SyncReturnStrategy - = ReturnJson - | ExecOnPostgres [(PGCol, PGScalarType)] - deriving (Show, Eq) - data SyncActionExecutionContext = SyncActionExecutionContext { _saecName :: !ActionName - , _saecStrategy :: !SyncReturnStrategy + , _saecDefinitionList :: ![(PGCol, PGScalarType)] , _saecWebhook :: !ResolvedWebhook , _saecHeaders :: ![HeaderConf] , _saecForwardClientHeaders :: !Bool diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 271359e9f308f..3d71891017bd1 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -70,7 +70,7 @@ mkMutationField actionName actionInfo permission definitionList = ActionSynchronous -> ActionExecutionSyncWebhook $ SyncActionExecutionContext actionName -- TODO: only covers object types - (ExecOnPostgres definitionList) + definitionList (_adHandler definition) (_adHeaders definition) (_adForwardClientHeaders definition) From a0771e0a2f55f3a6dbac562adc37beaf8c9e7d37 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Sun, 9 Feb 2020 18:19:42 +0530 Subject: [PATCH 54/62] incorporate review suggestion by @0x777 --- server/src-lib/Data/URL/Template.hs | 92 +++++++++++------- server/src-lib/Hasura/GraphQL/Resolve.hs | 6 +- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 15 ++- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 38 ++++---- .../Hasura/GraphQL/Resolve/Mutation.hs | 57 +++++------ .../src-lib/Hasura/GraphQL/Resolve/Select.hs | 2 +- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 33 +------ server/src-lib/Hasura/GraphQL/Schema.hs | 2 +- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 35 +++---- .../src-lib/Hasura/GraphQL/Schema/Common.hs | 1 - .../src-lib/Hasura/GraphQL/Validate/Types.hs | 10 +- .../Hasura/Incremental/Internal/Dependency.hs | 1 + server/src-lib/Hasura/RQL/DDL/Action.hs | 42 +-------- server/src-lib/Hasura/RQL/DDL/CustomTypes.hs | 68 +++++++++++--- server/src-lib/Hasura/RQL/DDL/Metadata.hs | 3 +- .../Hasura/RQL/DDL/Metadata/Generator.hs | 13 --- .../src-lib/Hasura/RQL/DDL/Metadata/Types.hs | 36 +------ server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs | 49 +++------- server/src-lib/Hasura/RQL/DML/Delete.hs | 8 +- server/src-lib/Hasura/RQL/DML/Insert.hs | 46 ++++----- server/src-lib/Hasura/RQL/DML/Mutation.hs | 41 ++------ server/src-lib/Hasura/RQL/DML/Returning.hs | 63 +++++++++---- server/src-lib/Hasura/RQL/DML/Select.hs | 14 +-- .../src-lib/Hasura/RQL/DML/Select/Internal.hs | 33 ++++--- server/src-lib/Hasura/RQL/DML/Select/Types.hs | 25 +++-- server/src-lib/Hasura/RQL/DML/Update.hs | 8 +- server/src-lib/Hasura/RQL/Instances.hs | 1 + server/src-lib/Hasura/RQL/Types/Action.hs | 94 +++++++++---------- server/src-lib/Hasura/RQL/Types/Catalog.hs | 5 +- server/src-lib/Hasura/RQL/Types/Common.hs | 5 +- .../src-lib/Hasura/RQL/Types/CustomTypes.hs | 12 +-- server/src-lib/Hasura/RQL/Types/Metadata.hs | 2 +- .../src-lib/Hasura/RQL/Types/SchemaCache.hs | 6 -- server/src-lib/Hasura/SQL/Types.hs | 12 ++- server/src-rsr/catalog_metadata.sql | 48 +++++----- server/src-test/Data/Parser/URLTemplate.hs | 13 +-- 36 files changed, 429 insertions(+), 510 deletions(-) diff --git a/server/src-lib/Data/URL/Template.hs b/server/src-lib/Data/URL/Template.hs index 02b7b7f0776b4..e9fba28113bfa 100644 --- a/server/src-lib/Data/URL/Template.hs +++ b/server/src-lib/Data/URL/Template.hs @@ -1,7 +1,7 @@ --- | A simple URL templating that enables interpolating an environment variable - +-- | A simple URL templating that enables interpolating environment variables module Data.URL.Template ( URLTemplate + , TemplateItem , Variable , printURLTemplate , parseURLTemplate @@ -14,6 +14,7 @@ import Hasura.Prelude import qualified Data.Text as T +import Data.Attoparsec.Combinator (lookAhead) import Data.Attoparsec.Text import Instances.TH.Lift () import Language.Haskell.TH.Syntax (Lift) @@ -23,44 +24,71 @@ import Test.QuickCheck newtype Variable = Variable {unVariable :: Text} deriving (Show, Eq, Lift, Generic) --- | A String with single environment variable enclosed in '{{' and '}}' --- http://{{APP_HOST}}/v1/api -data URLTemplate - = URLTemplate - { _utPreVarText :: !Text - , _utVariable :: !Variable - , _utPostVarText :: !Text - } deriving (Show, Eq, Lift, Generic) +printVariable :: Variable -> Text +printVariable var = "{{" <> unVariable var <> "}}" + +data TemplateItem + = TIText !Text + | TIVariable !Variable + deriving (Show, Eq, Lift, Generic) + +printTemplateItem :: TemplateItem -> Text +printTemplateItem = \case + TIText t -> t + TIVariable v -> printVariable v + +-- | A String with environment variables enclosed in '{{' and '}}' +-- http://{{APP_HOST}}:{{APP_PORT}}/v1/api +newtype URLTemplate = URLTemplate {unURLTemplate :: [TemplateItem]} + deriving (Show, Eq, Lift, Generic) printURLTemplate :: URLTemplate -> Text -printURLTemplate (URLTemplate preVar var postVar) = - preVar <> "{{" <> unVariable var <> "}}" <> postVar +printURLTemplate = T.concat . map printTemplateItem . unURLTemplate parseURLTemplate :: Text -> Either String URLTemplate -parseURLTemplate = parseOnly parseTemplate +parseURLTemplate t = parseOnly parseTemplate t where parseTemplate :: Parser URLTemplate - parseTemplate = URLTemplate - <$> (T.pack <$> manyTill anyChar (string "{{")) - <*> (Variable . T.pack <$> manyTill anyChar (string "}}")) - <*> takeText + parseTemplate = do + items <- many parseTemplateItem + lastItem <- TIText <$> takeText + pure $ URLTemplate $ items <> [lastItem] + + parseTemplateItem :: Parser TemplateItem + parseTemplateItem = + (TIVariable <$> parseVariable) + <|> (TIText . T.pack <$> manyTill anyChar (lookAhead $ string "{{")) + + parseVariable :: Parser Variable + parseVariable = + string "{{" *> (Variable . T.pack <$> manyTill anyChar (string "}}")) renderURLTemplate :: MonadIO m => URLTemplate -> m (Either String Text) -renderURLTemplate (URLTemplate preVar var postVar) = do - maybeEnvValue <- liftIO $ lookupEnv variableString - pure $ case maybeEnvValue of - Nothing -> Left $ "Value for environment variable " <> variableString <> " not found" - Just value -> Right $ preVar <> T.pack value <> postVar +renderURLTemplate template = do + eitherResults <- mapM renderTemplateItem $ unURLTemplate template + let errorVariables = lefts eitherResults + pure $ case errorVariables of + [] -> Right $ T.concat $ rights eitherResults + _ -> Left $ T.unpack $ "Value for environment variables not found: " + <> T.intercalate ", " errorVariables where - variableString = T.unpack $ unVariable var + renderTemplateItem = \case + TIText t -> pure $ Right t + TIVariable (Variable var) -> do + maybeEnvValue <- liftIO $ lookupEnv $ T.unpack var + pure $ case maybeEnvValue of + Nothing -> Left var + Just value -> Right $ T.pack value --- | QuickCheck generator -genURLTemplate :: Gen URLTemplate -genURLTemplate = - URLTemplate <$> genText <*> genVariable <*> genText - where - genText :: Gen Text - genText = T.pack <$> listOf (elements $ alphaNumerics <> "://") +-- QuickCheck generators +instance Arbitrary Variable where + arbitrary = Variable . T.pack <$> listOf1 (elements $ alphaNumerics <> "-_") + +instance Arbitrary URLTemplate where + arbitrary = URLTemplate <$> listOf (oneof [genText, genVariable]) + where + genText = (TIText . T.pack) <$> listOf1 (elements $ alphaNumerics <> "://") + genVariable = TIVariable <$> arbitrary - genVariable :: Gen Variable - genVariable = (Variable . T.pack) <$> listOf1 (elements $ alphaNumerics <> "-_") +genURLTemplate :: Gen URLTemplate +genURLTemplate = arbitrary diff --git a/server/src-lib/Hasura/GraphQL/Resolve.hs b/server/src-lib/Hasura/GraphQL/Resolve.hs index 78d949871b2a4..88f62801d447b 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve.hs @@ -62,10 +62,10 @@ traverseQueryRootFldAST f = \case toPGQuery :: QueryRootFldResolved -> Q.Query toPGQuery = \case - QRFPk s -> DS.selectQuerySQL True s - QRFSimple s -> DS.selectQuerySQL False s + QRFPk s -> DS.selectQuerySQL DS.JASSingleObject s + QRFSimple s -> DS.selectQuerySQL DS.JASMultipleRows s QRFAgg s -> DS.selectAggQuerySQL s - QRFActionSelect s -> DS.selectQuerySQL True s + QRFActionSelect s -> DS.selectQuerySQL DS.JASSingleObject s validateHdrs :: (Foldable t, QErrM m) => UserInfo -> t Text -> m () diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 4bfa61039bfb8..806a2ca127ca5 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -152,7 +152,7 @@ resolveActionMutationSync field executionContext sessionVariables = do processOutputSelectionSet webhookResponseExpression definitionList (_fType field) $ _fSelSet field astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved - return $ asSingleRowJsonResp (RS.selectQuerySQL True astResolved) [] + return $ asSingleRowJsonResp (RS.selectQuerySQL RS.JASSingleObject astResolved) [] where SyncActionExecutionContext actionName definitionList resolvedWebhook confHeaders forwardClientHeaders = executionContext @@ -318,8 +318,8 @@ resolveActionMutation field executionContext sessionVariables = case executionContext of ActionExecutionSyncWebhook executionContextSync -> resolveActionMutationSync field executionContextSync sessionVariables - ActionExecutionAsync actionFilter -> - resolveActionMutationAsync field actionFilter sessionVariables + ActionExecutionAsync -> + resolveActionMutationAsync field sessionVariables -- | Resolve asynchronous action mutation which returns only the action uuid resolveActionMutationAsync @@ -327,11 +327,10 @@ resolveActionMutationAsync , Has [HTTP.Header] r ) => Field - -> AnnBoolExpPartialSQL -- We need the sesion variables for column presets -> UserVars -> m RespTx -resolveActionMutationAsync field _ sessionVariables = do +resolveActionMutationAsync field sessionVariables = do reqHeaders <- asks getter let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field pure $ do @@ -383,7 +382,7 @@ resolveAsyncActionQuery userInfo selectContext field = do -- Treating "output" as a computed field to "hdb_action_log" table with "jsonb_to_record" SQL function let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload" definitionList = _asocDefinitionList selectContext - (RS.FComputedField . RS.CFSTable True) -- The output of action is always a single object + (RS.FComputedField . RS.CFSTable RS.JASSingleObject) -- The output of action is always a single object <$> processOutputSelectionSet inputTableArgument definitionList (_fType fld) (_fSelSet fld) -- the metadata columns "id" -> return $ mkAnnFldFromPGCol "id" PGUUID @@ -394,7 +393,7 @@ resolveAsyncActionQuery userInfo selectContext field = do let tableFromExp = RS.FromTable actionLogTable tableArguments = RS.noTableArgs { RS._taWhere = Just $ mkTableBoolExpression actionId} - tablePermissions = RS.TablePerm unresolvedFilter Nothing + tablePermissions = RS.TablePerm annBoolExpTrue Nothing selectAstUnresolved = RS.AnnSelG annotatedFields tableFromExp tablePermissions tableArguments stringifyNumerics return selectAstUnresolved @@ -406,8 +405,6 @@ resolveAsyncActionQuery userInfo selectContext field = do flip RS.mkAnnColField Nothing $ PGColumnInfo (unsafePGCol column) (G.Name column) 0 (PGColumnScalar columnType) True Nothing - unresolvedFilter = fmapAnnBoolExp partialSQLExpToUnresolvedVal $ _asocFilter selectContext - parseActionId annInpValue = mkParameterizablePGValue <$> asPGColumnValue annInpValue mkTableBoolExpression actionId = diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index 898daeead3fe2..53ad765ebb606 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -335,7 +335,7 @@ insertArrRel strfyNum role resCols arrRelIns = (\(col, _) (lCol, _) -> col == lCol) (\(_, colVal) (_, rCol) -> (rCol, colVal)) - resBS <- insertMultipleObjects strfyNum role tn multiObjIns addCols mutFlds "data" + resBS <- insertMultipleObjects strfyNum role tn multiObjIns addCols mutOutput "data" resObj <- decodeEncJSON resBS onNothing (Map.lookup ("affected_rows" :: T.Text) resObj) $ throw500 "affected_rows not returned in array rel insert" @@ -344,7 +344,7 @@ insertArrRel strfyNum role resCols arrRelIns = colMapping = riMapping relInfo tn = riRTable relInfo relNameTxt = relNameToTxt $ riName relInfo - mutFlds = [("affected_rows", RR.MCount)] + mutOutput = RR.MTOFields [("affected_rows", RR.MCount)] -- | insert an object with object and array relationships insertObj @@ -408,10 +408,10 @@ insertMultipleObjects -> QualifiedTable -> MultiObjIns -> [PGColWithValue] -- ^ additional fields - -> RR.MutFlds + -> RR.MutationOutput -> T.Text -- ^ error path -> Q.TxE QErr EncJSON -insertMultipleObjects strfyNum role tn multiObjIns addCols mutFlds errP = +insertMultipleObjects strfyNum role tn multiObjIns addCols mutOutput errP = bool withoutRelsInsert withRelsInsert anyRelsToInsert where AnnIns insObjs onConflictM checkCond tableColInfos defVals = multiObjIns @@ -438,7 +438,7 @@ insertMultipleObjects strfyNum role tn multiObjIns addCols mutFlds errP = checkExpr <- convAnnBoolExpPartialSQL sessVarFromCurrentSetting checkCond let insQP1 = RI.InsertQueryP1 tn tableCols sqlRows onConflictM - (Just checkExpr) mutFlds tableColInfos + (Just checkExpr) mutOutput tableColInfos p1 = (insQP1, prepArgs) RI.insertP2 strfyNum p1 @@ -450,7 +450,7 @@ insertMultipleObjects strfyNum role tn multiObjIns addCols mutFlds errP = let affRows = sum $ map fst insResps columnValues = catMaybes $ map snd insResps cteExp <- mkSelCTEFromColVals tn tableColInfos columnValues - let sql = toSQL $ RR.mkMutationOutputExp tn (Just affRows) cteExp mutFlds strfyNum + let sql = toSQL $ RR.mkMutationOutputExp tn (Just affRows) cteExp mutOutput strfyNum runIdentity . Q.getRow <$> Q.rawQE dmlTxErrorHandler (Q.fromBuilder sql) [] False @@ -467,15 +467,15 @@ convertInsert -> Field -- the mutation field -> m RespTx convertInsert role tn fld = prefixErrPath fld $ do - mutFldsUnres <- convertMutResp (_fType fld) $ _fSelSet fld - mutFldsRes <- RR.traverseMutFlds resolveValTxt mutFldsUnres + mutOutputUnres <- RR.MTOFields <$> resolveMutationFields (_fType fld) (_fSelSet fld) + mutOutputRes <- RR.traverseMutationOutput resolveValTxt mutOutputUnres annVals <- withArg arguments "objects" asArray -- if insert input objects is empty array then -- do not perform insert and return mutation response - bool (withNonEmptyObjs annVals mutFldsRes) - (withEmptyObjs mutFldsRes) $ null annVals + bool (withNonEmptyObjs annVals mutOutputRes) + (withEmptyObjs mutOutputRes) $ null annVals where - withNonEmptyObjs annVals mutFlds = do + withNonEmptyObjs annVals mutOutput = do InsCtx tableColMap checkCond defValMap relInfoMap updPerm <- getInsCtx tn annObjs <- mapM asObject annVals annInsObjs <- forM annObjs $ mkAnnInsObj relInfoMap tableColMap @@ -487,9 +487,9 @@ convertInsert role tn fld = prefixErrPath fld $ do tableCols = Map.elems tableColMap strfyNum <- stringifyNum <$> asks getter return $ prefixErrPath fld $ insertMultipleObjects strfyNum role tn - multiObjIns [] mutFlds "objects" - withEmptyObjs mutFlds = - return $ return $ buildEmptyMutResp mutFlds + multiObjIns [] mutOutput "objects" + withEmptyObjs mutOutput = + return $ return $ buildEmptyMutResp mutOutput arguments = _fArguments fld onConflictM = Map.lookup "on_conflict" arguments @@ -503,8 +503,8 @@ convertInsertOne -> m RespTx convertInsertOne role qt field = prefixErrPath field $ do tableSelFields <- processTableSelectionSet (_fType field) $ _fSelSet field - let mutationFieldsUnResolved = RR.onlyReturningMutFld tableSelFields - mutationFieldsResolved <- RR.traverseMutFlds resolveValTxt mutationFieldsUnResolved + let mutationOutputUnresolved = RR.MTOObject tableSelFields + mutationOutputResolved <- RR.traverseMutationOutput resolveValTxt mutationOutputUnresolved annInputObj <- withArg arguments "object" asObject InsCtx tableColMap check defValMap relInfoMap updPerm <- getInsCtx qt annInsertObj <- mkAnnInsObj relInfoMap tableColMap annInputObj @@ -513,10 +513,8 @@ convertInsertOne role qt field = prefixErrPath field $ do let multiObjIns = AnnIns [annInsertObj] conflictClauseM check tableCols defValMapRes tableCols = Map.elems tableColMap strfyNum <- stringifyNum <$> asks getter - pure $ do - response <- prefixErrPath field $ insertMultipleObjects strfyNum role qt - multiObjIns [] mutationFieldsResolved "object" - withSingleTableRow response + pure $ prefixErrPath field $ insertMultipleObjects strfyNum role qt + multiObjIns [] mutationOutputResolved "object" where arguments = _fArguments field diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index 018c24e3a7367..72fb8b23419b9 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -3,7 +3,7 @@ module Hasura.GraphQL.Resolve.Mutation , convertUpdateByPk , convertDelete , convertDeleteByPk - , convertMutResp + , resolveMutationFields , buildEmptyMutResp ) where @@ -20,7 +20,6 @@ import qualified Data.Text as T import qualified Language.GraphQL.Draft.Syntax as G import qualified Hasura.RQL.DML.Delete as RD -import qualified Hasura.RQL.DML.Mutation as RM import qualified Hasura.RQL.DML.Returning as RR import qualified Hasura.RQL.DML.Update as RU @@ -39,12 +38,12 @@ import Hasura.RQL.Types import Hasura.SQL.Types import Hasura.SQL.Value -convertMutResp +resolveMutationFields :: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) => G.NamedType -> SelSet -> m (RR.MutFldsG UnresolvedVal) -convertMutResp ty selSet = +resolveMutationFields ty selSet = fmap (map (first FieldName)) $ withSelSet selSet $ \fld -> case _fName fld of "__typename" -> return $ RR.MExp $ G.unName $ G.unNamedType ty "affected_rows" -> return RR.MCount @@ -117,7 +116,7 @@ convertUpdateP1 :: (MonadReusability m, MonadError QErr m) => UpdOpCtx -- the update context -> (ArgsMap -> m AnnBoolExpUnresolved) -- the bool expression parser - -> (Field -> m (RR.MutFldsG UnresolvedVal)) -- the selection set resolver + -> (Field -> m (RR.MutationOutputG UnresolvedVal)) -- the selection set resolver -> Field -- the mutation field -> m (RU.AnnUpdG UnresolvedVal) convertUpdateP1 opCtx boolExpParser selectionResolver fld = do @@ -149,9 +148,9 @@ convertUpdateP1 opCtx boolExpParser selectionResolver fld = do , deleteKeyExpM, deleteElemExpM, deleteAtPathExpM ] - mutFlds <- selectionResolver fld + mutOutput <- selectionResolver fld - pure $ RU.AnnUpd tn updateItems (unresolvedPermFilter, whereExp) mutFlds allCols + pure $ RU.AnnUpd tn updateItems (unresolvedPermFilter, whereExp) mutOutput allCols where convObjWithOp' = convObjWithOp colGNameMap allCols = Map.elems colGNameMap @@ -193,7 +192,7 @@ convertUpdateGeneric ) => UpdOpCtx -- the update context -> (ArgsMap -> m AnnBoolExpUnresolved) -- the bool exp parser - -> (Field -> m (RR.MutFldsG UnresolvedVal)) -- the selection set resolver + -> (Field -> m (RR.MutationOutputG UnresolvedVal)) -- the selection set resolver -> Field -> m RespTx convertUpdateGeneric opCtx boolExpParser selectionResolver fld = do @@ -204,7 +203,7 @@ convertUpdateGeneric opCtx boolExpParser selectionResolver fld = do let whenNonEmptyItems = return $ RU.updateQueryToTx strfyNum (annUpdResolved, prepArgs) whenEmptyItems = return $ return $ - buildEmptyMutResp $ RU.uqp1MutFlds annUpdResolved + buildEmptyMutResp $ RU.uqp1Output annUpdResolved -- if there are not set items then do not perform -- update and return empty mutation response bool whenNonEmptyItems whenEmptyItems $ null $ RU.uqp1SetExps annUpdResolved @@ -228,11 +227,8 @@ convertUpdateByPk => UpdOpCtx -- the update context -> Field -- the mutation field -> m RespTx -convertUpdateByPk opCtx field = do - responseTx <- convertUpdateGeneric opCtx boolExpParser tableSelectionAsMutationFields field - pure $ do - response <- responseTx - RM.withSingleTableRow response +convertUpdateByPk opCtx field = + convertUpdateGeneric opCtx boolExpParser tableSelectionAsMutationOutput field where boolExpParser args = withArg args "pk_columns" $ \inpVal -> do obj <- asObject inpVal @@ -246,16 +242,16 @@ convertDeleteGeneric ) => DelOpCtx -- the delete context -> (ArgsMap -> m AnnBoolExpUnresolved) -- the bool exp parser - -> (Field -> m (RR.MutFldsG UnresolvedVal)) -- the selection set resolver + -> (Field -> m (RR.MutationOutputG UnresolvedVal)) -- the selection set resolver -> Field -- the mutation field -> m RespTx convertDeleteGeneric opCtx boolExpParser selectionResolver fld = do whereExp <- boolExpParser $ _fArguments fld - mutFlds <- selectionResolver fld + mutOutput <- selectionResolver fld let unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal filterExp annDelUnresolved = RD.AnnDel tn (unresolvedPermFltr, whereExp) - mutFlds allCols + mutOutput allCols (annDelResolved, prepArgs) <- withPrepArgs $ RD.traverseAnnDel resolveValPrep annDelUnresolved strfyNum <- stringifyNum <$> asks getter @@ -283,11 +279,8 @@ convertDeleteByPk => DelOpCtx -- the delete context -> Field -- the mutation field -> m RespTx -convertDeleteByPk opCtx field = do - responseTx <- convertDeleteGeneric opCtx boolExpParser tableSelectionAsMutationFields field - pure $ do - response <- responseTx - RM.withSingleTableRow response +convertDeleteByPk opCtx field = + convertDeleteGeneric opCtx boolExpParser tableSelectionAsMutationOutput field where boolExpParser = pgColValToBoolExp (_docAllCols opCtx) @@ -303,24 +296,26 @@ mutationFieldsResolver , MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => Field -> m (RR.MutFldsG UnresolvedVal) -mutationFieldsResolver field = convertMutResp (_fType field) $ _fSelSet field + => Field -> m (RR.MutationOutputG UnresolvedVal) +mutationFieldsResolver field = + RR.MTOFields <$> resolveMutationFields (_fType field) (_fSelSet field) -tableSelectionAsMutationFields +tableSelectionAsMutationOutput :: ( MonadReusability m, MonadError QErr m , MonadReader r m, Has FieldMap r , Has OrdByCtx r, Has SQLGenCtx r ) - => Field -> m (RR.MutFldsG UnresolvedVal) -tableSelectionAsMutationFields field = do - annFlds <- processTableSelectionSet (_fType field) $ _fSelSet field - pure $ RR.onlyReturningMutFld annFlds + => Field -> m (RR.MutationOutputG UnresolvedVal) +tableSelectionAsMutationOutput field = + RR.MTOObject <$> processTableSelectionSet (_fType field) (_fSelSet field) -- | build mutation response for empty objects -buildEmptyMutResp :: RR.MutFlds -> EncJSON +buildEmptyMutResp :: RR.MutationOutput -> EncJSON buildEmptyMutResp = mkTx where - mkTx = encJFromJValue . OMap.fromList . map (second convMutFld) + mkTx = \case + RR.MTOFields mutFlds -> encJFromJValue $ OMap.fromList $ map (second convMutFld) mutFlds + RR.MTOObject _ -> encJFromJValue $ J.Object mempty -- generate empty mutation response convMutFld = \case RR.MCount -> J.toJSON (0 :: Int) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs index 63302287a6183..704fc543f2eb5 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Select.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Select.hs @@ -67,7 +67,7 @@ resolveComputedField computedField fld = fieldAsPath fld $ do RS.ComputedFieldScalarSel qf argsWithTableArgument scalarTy colOpM CFTTable (ComputedFieldTable _ cols permFilter permLimit) -> do let functionFrom = RS.FromFunction qf argsWithTableArgument Nothing - RS.CFSTable False <$> fromField functionFrom cols permFilter permLimit fld + RS.CFSTable RS.JASMultipleRows <$> fromField functionFrom cols permFilter permLimit fld where ComputedField _ function argSeq fieldType = computedField ComputedFieldFunction qf _ tableArg _ = function diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 47e66721f417d..63054ac7a0c61 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -112,13 +112,12 @@ data SyncActionExecutionContext data ActionExecutionContext = ActionExecutionSyncWebhook !SyncActionExecutionContext - | ActionExecutionAsync !AnnBoolExpPartialSQL + | ActionExecutionAsync deriving (Show, Eq) data ActionSelectOpContext = ActionSelectOpContext - { _asocFilter :: AnnBoolExpPartialSQL - , _asocDefinitionList :: [(PGCol, PGScalarType)] + { _asocDefinitionList :: ![(PGCol, PGScalarType)] } deriving (Show, Eq) -- (custom name | generated name) -> PG column info @@ -239,34 +238,6 @@ data InputFunctionArgument | IFAUnknown !FunctionArgItem -- ^ Unknown value, need to be parsed deriving (Show, Eq) --- instance Semigroup QueryReusability where --- Reusable a <> Reusable b = Reusable (a <> b) --- _ <> _ = NotReusable --- instance Monoid QueryReusability where --- mempty = Reusable mempty - --- class (MonadError QErr m) => MonadResolve m where --- recordVariableUse :: G.Variable -> PGColumnType -> m () --- markNotReusable :: m () - --- newtype ResolveT m a = ResolveT { unResolveT :: StateT QueryReusability m a } --- deriving (Functor, Applicative, Monad, MonadError e, MonadReader r, MonadIO) - --- instance (MonadError QErr m) => MonadResolve (ResolveT m) where --- recordVariableUse varName varType = ResolveT $ --- modify' (<> Reusable (ReusableVariableTypes $ Map.singleton varName varType)) --- markNotReusable = ResolveT $ put NotReusable - --- runResolveT :: (Functor m) => ResolveT m a -> m (a, Maybe ReusableVariableTypes) --- runResolveT = fmap (fmap getVarTypes) . flip runStateT mempty . unResolveT --- where --- getVarTypes = \case --- Reusable varTypes -> Just varTypes --- NotReusable -> Nothing - --- evalResolveT :: (Monad m) => ResolveT m a -> m a --- evalResolveT = flip evalStateT mempty . unResolveT - -- template haskell related $(makePrisms ''ResolveField) $(makeLenses ''ComputedField) diff --git a/server/src-lib/Hasura/GraphQL/Schema.hs b/server/src-lib/Hasura/GraphQL/Schema.hs index c145132c38433..79a34c69c171a 100644 --- a/server/src-lib/Hasura/GraphQL/Schema.hs +++ b/server/src-lib/Hasura/GraphQL/Schema.hs @@ -725,7 +725,6 @@ mkGCtxMap annotatedObjects tableCache functionCache actionCache = do filter (tableFltr . _tiCoreInfo) $ Map.elems tableCache actionsSchema <- mkActionsSchema annotatedObjects actionCache typesMap <- combineTypes actionsSchema typesMapL - -- TODO: clean this up let gCtxMap = flip Map.map typesMap $ \(ty, flds, insCtxMap) -> mkGCtx ty flds insCtxMap return gCtxMap @@ -753,6 +752,7 @@ mkGCtxMap annotatedObjects tableCache functionCache actionCache = do duplicateMutationFields = duplicates $ concatMap (Map.keys . _rootMutationFields) rootFields + -- TODO: The following exception should result in inconsistency when (not $ null duplicateQueryFields) $ throw400 Unexpected $ "following query root fields are duplicated: " <> showNames duplicateQueryFields diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 3d71891017bd1..eb55dd868218a 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -8,6 +8,7 @@ import qualified Language.GraphQL.Draft.Syntax as G import Data.Coerce (coerce) import Hasura.GraphQL.Schema.Builder +import Hasura.GraphQL.Schema.Common (mkDescriptionWith) import Hasura.GraphQL.Resolve.Types import Hasura.GraphQL.Validate.Types @@ -56,10 +57,9 @@ mkAsyncActionQueryResponseObj actionName outputType = mkMutationField :: ActionName -> ActionInfo - -> ActionPermissionInfo -> [(PGCol, PGScalarType)] -> (ActionExecutionContext, ObjFldInfo) -mkMutationField actionName actionInfo permission definitionList = +mkMutationField actionName actionInfo definitionList = ( actionExecutionContext , fieldInfo ) @@ -69,16 +69,14 @@ mkMutationField actionName actionInfo permission definitionList = case _adKind definition of ActionSynchronous -> ActionExecutionSyncWebhook $ SyncActionExecutionContext actionName - -- TODO: only covers object types definitionList (_adHandler definition) (_adHeaders definition) (_adForwardClientHeaders definition) - ActionAsynchronous -> ActionExecutionAsync $ _apiFilter permission + ActionAsynchronous -> ActionExecutionAsync - -- TODO: we need to capture the comment from action definition - description = - G.Description $ "perform the action: " <>> actionName + description = mkDescriptionWith (PGDescription <$> (_aiComment actionInfo)) $ + "perform the action: " <>> actionName fieldInfo = mkHsraObjFldInfo @@ -98,14 +96,14 @@ mkMutationField actionName actionInfo permission definitionList = mkQueryField :: ActionName + -> Maybe Text -> ResolvedActionDefinition - -> ActionPermissionInfo -> [(PGCol, PGScalarType)] -> Maybe (ActionSelectOpContext, ObjFldInfo, TypeInfo) -mkQueryField actionName definition permission definitionList = +mkQueryField actionName comment definition definitionList = case _adKind definition of ActionAsynchronous -> - Just ( ActionSelectOpContext (_apiFilter permission) definitionList + Just ( ActionSelectOpContext definitionList , mkHsraObjFldInfo (Just description) (unActionName actionName) (mapFromL _iviName [idArgument]) @@ -116,9 +114,8 @@ mkQueryField actionName definition permission definitionList = ) ActionSynchronous -> Nothing where - -- TODO: we need to capture the comment from action definition - description = - G.Description $ "retrieve the result of action: " <>> actionName + description = mkDescriptionWith (PGDescription <$> comment) $ + "retrieve the result of action: " <>> actionName idArgument = InpValInfo (Just idDescription) "id" Nothing $ G.toNT $ mkScalarTy PGUUID @@ -136,15 +133,15 @@ mkActionFieldsAndTypes , FieldMap ) mkActionFieldsAndTypes actionInfo annotatedOutputType permission = - return ( mkQueryField actionName definition permission definitionList - , mkMutationField actionName actionInfo permission definitionList - -- , maybe mempty mkFieldMap annotatedOutputTypeM + return ( mkQueryField actionName comment definition definitionList + , mkMutationField actionName actionInfo definitionList , fieldMap ) where actionName = _aiName actionInfo definition = _aiDefinition actionInfo roleName = _apiRole permission + comment = _aiComment actionInfo -- all the possible field references fieldReferences = @@ -231,17 +228,13 @@ mkActionSchemaOne ) ) mkActionSchemaOne annotatedObjects actionInfo = do - -- annotatedOutputTypeM <- case _aiOutputTypeInfo actionInfo of - -- ActionOutputObject _ -> - -- annotatedOutputTypeM <- fmap Just $ onNothing annotatedOutputType <- onNothing (Map.lookup (ObjectTypeName actionOutputBaseType) annotatedObjects) $ throw500 $ "missing annotated type for: " <> showNamedTy actionOutputBaseType - -- _ -> return Nothing forM permissions $ \permission -> mkActionFieldsAndTypes actionInfo annotatedOutputType permission where - adminPermission = ActionPermissionInfo adminRole annBoolExpTrue + adminPermission = ActionPermissionInfo adminRole permissions = Map.insert adminRole adminPermission $ _aiPermissions actionInfo actionOutputBaseType = G.getBaseType $ unGraphQLType $ _adOutputType $ _aiDefinition actionInfo diff --git a/server/src-lib/Hasura/GraphQL/Schema/Common.hs b/server/src-lib/Hasura/GraphQL/Schema/Common.hs index df51b9c725a6a..31dcab5f16c68 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Common.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Common.hs @@ -22,7 +22,6 @@ module Hasura.GraphQL.Schema.Common , mkColumnEnumVal , mkColumnInputVal , mkDescriptionWith - , mkDescription , mkFuncArgsTy ) where diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index 99cd5aadd1a7b..94548e122f55a 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -631,8 +631,8 @@ mkTyInfoMap :: [TypeInfo] -> TypeMap mkTyInfoMap tyInfos = Map.fromList [(getNamedTy tyInfo, tyInfo) | tyInfo <- tyInfos] -fromTyDef :: G.TypeDefinition -> TypeLoc -> Either Text TypeInfo -fromTyDef tyDef loc = pure $ case tyDef of +fromTyDef :: G.TypeDefinition -> TypeLoc -> TypeInfo +fromTyDef tyDef loc = case tyDef of G.TypeDefinitionScalar t -> TIScalar $ fromScalarTyDef t loc G.TypeDefinitionObject t -> TIObj $ fromObjTyDef t loc G.TypeDefinitionInterface t -> TIIFace $ fromIFaceDef t loc @@ -642,7 +642,7 @@ fromTyDef tyDef loc = pure $ case tyDef of fromSchemaDoc :: G.SchemaDocument -> TypeLoc -> Either Text TypeMap fromSchemaDoc (G.SchemaDocument tyDefs) loc = do - tyMap <- fmap mkTyInfoMap $ mapM (flip fromTyDef loc) tyDefs + let tyMap = mkTyInfoMap $ map (flip fromTyDef loc) tyDefs validateTypeMap tyMap return tyMap @@ -655,9 +655,7 @@ validateTypeMap tyMap = mapM_ validateTy $ Map.elems tyMap validateTy _ = return () fromTyDefQ :: G.TypeDefinition -> TypeLoc -> TH.Q TH.Exp -fromTyDefQ tyDef loc = case fromTyDef tyDef loc of - Left e -> fail $ T.unpack e - Right t -> TH.lift t +fromTyDefQ tyDef loc = TH.lift $ fromTyDef tyDef loc fromSchemaDocQ :: G.SchemaDocument -> TypeLoc -> TH.Q TH.Exp fromSchemaDocQ sd loc = case fromSchemaDoc sd loc of diff --git a/server/src-lib/Hasura/Incremental/Internal/Dependency.hs b/server/src-lib/Hasura/Incremental/Internal/Dependency.hs index 88fc6419ef33d..dbefec25830ea 100644 --- a/server/src-lib/Hasura/Incremental/Internal/Dependency.hs +++ b/server/src-lib/Hasura/Incremental/Internal/Dependency.hs @@ -197,6 +197,7 @@ instance Cacheable G.ValueConst instance Cacheable G.VariableDefinition instance Cacheable N.URI instance Cacheable UT.Variable +instance Cacheable UT.TemplateItem instance Cacheable UT.URLTemplate instance (Cacheable a) => Cacheable (Maybe a) instance (Cacheable a, Cacheable b) => Cacheable (Either a b) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 82a9ece50e299..a5263af52de22 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -4,7 +4,6 @@ module Hasura.RQL.DDL.Action , runCreateAction , persistCreateAction , resolveAction - , buildActionFilter , UpdateAction , runUpdateAction @@ -43,19 +42,6 @@ import qualified Language.GraphQL.Draft.Syntax as G import Data.URL.Template (renderURLTemplate) import Language.Haskell.TH.Syntax (Lift) --- data RetryConf --- = RetryConf --- { _rcNumRetries :: !Word64 --- , _rcIntervalSec :: !Word64 --- , _rcTimeoutSec :: !(Maybe Word64) --- } deriving (Show, Eq, Lift) - --- data WebhookConf --- = WebhookConf --- { _wcUrl :: !Text --- , _wcTimeout :: !Word64 --- , _wcRetry :: !RetryConf --- } deriving (Show, Eq) getActionInfo :: (QErrM m, CacheRM m) @@ -112,16 +98,8 @@ resolveAction customTypes actionDefinition = do when (hasList responseType) $ throw400 InvalidParams $ "the output type: " <> G.showGT responseType <> " cannot be a list" + -- Check if the response type is an object getObjectTypeInfo responseBaseType - -- TODO: validate the output type - -- responseTypeInfo <- getNonObjectTypeInfo responseBaseType - -- case responseTypeInfo of - -- VT.TIScalar typeInfo -> return $ ActionOutputScalar typeInfo - -- VT.TIEnum typeInfo -> return $ ActionOutputEnum typeInfo - -- VT.TIObj typeInfo -> return $ ActionOutputObject typeInfo - -- _ -> throw400 InvalidParams $ "the output type: " <> - -- showNamedTy responseBaseType <> - -- " should be a scalar/enum/object" traverse resolveWebhook actionDefinition where getNonObjectTypeInfo typeName = do @@ -131,11 +109,9 @@ resolveAction customTypes actionDefinition = do throw400 NotExists $ "the type: " <> showNamedTy typeName <> " is not defined in custom types" - resolveWebhook = \case - IWPlain t -> pure $ ResolvedWebhook t - IWTemplate template -> do - eitherRenderedTemplate <- renderURLTemplate template - either (throw400 Unexpected . T.pack) (pure . ResolvedWebhook) eitherRenderedTemplate + resolveWebhook (InputWebhook urlTemplate) = do + eitherRenderedTemplate <- renderURLTemplate urlTemplate + either (throw400 Unexpected . T.pack) (pure . ResolvedWebhook) eitherRenderedTemplate getObjectTypeInfo typeName = onNothing (Map.lookup (ObjectTypeName typeName) (snd customTypes)) $ @@ -240,14 +216,6 @@ newtype ActionMetadataField = ActionMetadataField { unActionMetadataField :: Text } deriving (Show, Eq, J.FromJSON, J.ToJSON) --- TODO -buildActionFilter - :: (QErrM m) - => ActionPermissionSelect - -> m AnnBoolExpPartialSQL -buildActionFilter _ = - return annBoolExpTrue - runCreateActionPermission :: (QErrM m , CacheRWM m, MonadTx m) => CreateActionPermission -> m EncJSON @@ -269,7 +237,7 @@ persistCreateActionPermission CreateActionPermission{..}= do INSERT into hdb_catalog.hdb_action_permission (action_name, role_name, definition, comment) VALUES ($1, $2, $3, $4) - |] (_capAction, _capRole, Q.AltJ _capDefinition, _capComment) True + |] (_capAction, _capRole, Q.AltJ J.Null, _capComment) True data DropActionPermission = DropActionPermission diff --git a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs index 254726c3a1c2b..ae1193049985b 100644 --- a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs @@ -167,41 +167,81 @@ isListType = \case G.TypeNamed _ _ -> False data CustomTypeValidationError - -- ^ type names have to be unique across all types = DuplicateTypeNames !(Set.HashSet G.NamedType) - -- ^ field name and the field's base type + -- ^ type names have to be unique across all types | InputObjectFieldTypeDoesNotExist !InputObjectTypeName !InputObjectFieldName !G.NamedType - -- ^ duplicate field declaration in input objects + -- ^ field name and the field's base type | InputObjectDuplicateFields !InputObjectTypeName !(Set.HashSet InputObjectFieldName) - -- ^ field name and the field's base type + -- ^ duplicate field declaration in input objects | ObjectFieldTypeDoesNotExist !ObjectTypeName !ObjectFieldName !G.NamedType - -- ^ duplicate field declaration in objects + -- ^ field name and the field's base type | ObjectDuplicateFields !ObjectTypeName !(Set.HashSet G.Name) - -- ^ object fields can't have arguments + -- ^ duplicate field declaration in objects | ObjectFieldArgumentsNotAllowed !ObjectTypeName !ObjectFieldName - -- ^ object fields can't have object types as base types + -- ^ object fields can't have arguments | ObjectFieldObjectBaseType !ObjectTypeName !ObjectFieldName !G.NamedType - -- ^ The table specified in the relationship does not exist + -- ^ object fields can't have object types as base types | ObjectRelationshipTableDoesNotExist !ObjectTypeName !RelationshipName !QualifiedTable - -- ^ The field specified in the relationship mapping does not exist + -- ^ The table specified in the relationship does not exist | ObjectRelationshipFieldDoesNotExist !ObjectTypeName !RelationshipName !ObjectFieldName - -- ^ The column specified in the relationship mapping does not exist + -- ^ The field specified in the relationship mapping does not exist | ObjectRelationshipColumnDoesNotExist !ObjectTypeName !RelationshipName !QualifiedTable !PGCol - -- ^ duplicate enum values + -- ^ The column specified in the relationship mapping does not exist | DuplicateEnumValues !EnumTypeName !(Set.HashSet G.EnumValue) + -- ^ duplicate enum values deriving (Show, Eq) showCustomTypeValidationError :: CustomTypeValidationError -> T.Text -showCustomTypeValidationError = - -- TODO - T.pack . show +showCustomTypeValidationError = \case + DuplicateTypeNames types -> + "duplicate type names: " <> dquoteList types + + InputObjectFieldTypeDoesNotExist objType fieldName fieldTy -> + "the type " <> fieldTy <<> " for field " + <> fieldName <<> " in " <> " input object type " + <> objType <<> " does not exist" + + InputObjectDuplicateFields objType fields -> + "the input object " <> objType <<> " has duplicate fields: " <> dquoteList fields + + ObjectFieldTypeDoesNotExist objType fieldName fieldTy -> + "the type " <> fieldTy <<> " for field " + <> fieldName <<> " in " <> " object type " + <> objType <<> " does not exist" + + ObjectDuplicateFields objType fields -> + "the object " <> objType <<> " has duplicate fields: " <> dquoteList fields + + ObjectFieldArgumentsNotAllowed objType _ -> + "the object " <> objType <<> " can't have arguments" + + ObjectFieldObjectBaseType objType fieldName fieldType -> + "the type " <> fieldType <<> " of the field " <> fieldName + <<> " in the object type " <> objType <<> " is object type which isn't allowed" + + ObjectRelationshipTableDoesNotExist objType relName table -> + "the remote table " <> table <<> " for relationship " <> relName + <<> " of object type " <> objType <<> " does not exist" + + ObjectRelationshipFieldDoesNotExist objType relName fieldName -> + "the field " <> fieldName <<> " for relationship " <> relName + <<> " in object type " <> objType <<> " does not exist" + + ObjectRelationshipColumnDoesNotExist objType relName remoteTable column -> + "the column " <> column <<> " of remote table " <> remoteTable + <<> " for relationship " <> relName <<> " of object type " <> objType + <<> " does not exist" + + DuplicateEnumValues tyName values -> + "the enum type " <> tyName <<> " has duplicate values: " <> dquoteList values + runSetCustomTypes :: ( MonadError QErr m diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index ee811b00192bb..9013e87c2b0a5 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -210,8 +210,7 @@ applyQP2 (ReplaceMetadata _ tables functionsMeta Action.persistCreateAction createAction for_ (_amPermissions action) $ \permission -> do let createActionPermission = CreateActionPermission (_amName action) - (_apmRole permission) (_apmDefinition permission) - (_apmComment permission) + (_apmRole permission) Nothing (_apmComment permission) Action.persistCreateActionPermission createActionPermission buildSchemaCacheStrict diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs b/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs index 41c8ad3883707..640231622110c 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata/Generator.hs @@ -22,7 +22,6 @@ import qualified Data.Aeson as J import qualified Data.HashMap.Strict as HM import qualified Data.List.NonEmpty as NEList import qualified Data.Text as T -import qualified Data.URL.Template as UT import qualified Data.Vector as V import qualified Language.GraphQL.Draft.Parser as G import qualified Language.GraphQL.Draft.Syntax as G @@ -286,21 +285,9 @@ instance (Arbitrary a) => Arbitrary (ActionDefinition a) where instance Arbitrary ActionName where arbitrary = genericArbitrary -instance Arbitrary UT.Variable where - arbitrary = genericArbitrary - -instance Arbitrary UT.URLTemplate where - arbitrary = genericArbitrary - instance Arbitrary InputWebhook where arbitrary = genericArbitrary -instance Arbitrary ActionPermissionSelect where - arbitrary = genericArbitrary - -instance Arbitrary ActionPermissionDefinition where - arbitrary = genericArbitrary - instance Arbitrary ActionPermissionMetadata where arbitrary = genericArbitrary diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs b/server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs index 4365fb0fc27a8..b59b45fafea2c 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata/Types.hs @@ -162,35 +162,6 @@ $(deriveToJSON defaultOptions ''ClearMetadata) instance FromJSON ClearMetadata where parseJSON _ = return ClearMetadata --- representation of action permission metadata -data ActionPermissionMetadata - = ActionPermissionMetadata - { _apmRole :: !RoleName - , _apmComment :: !(Maybe Text) - , _apmDefinition :: !ActionPermissionDefinition - } deriving (Show, Eq, Lift, Generic) - -$(deriveFromJSON - (aesonDrop 4 snakeCase){omitNothingFields=True} - ''ActionPermissionMetadata) - --- representation of action metadata -data ActionMetadata - = ActionMetadata - { _amName :: !ActionName - , _amComment :: !(Maybe Text) - , _amDefinition :: !ActionDefinitionInput - , _amPermissions :: ![ActionPermissionMetadata] - } deriving (Show, Eq, Lift, Generic) - -instance FromJSON ActionMetadata where - parseJSON = withObject "Object" $ \o -> - ActionMetadata - <$> o .: "name" - <*> o .:? "comment" - <*> o .: "definition" - <*> o .:? "permissions" .!= [] - data ReplaceMetadata = ReplaceMetadata { aqVersion :: !MetadataVersion @@ -527,11 +498,8 @@ replaceMetadataToOrdJSON ( ReplaceMetadata <> catMaybes [maybeAnyToMaybeOrdPair "description" AO.toOrdered descM] permToOrdJSON :: ActionPermissionMetadata -> AO.Value - permToOrdJSON (ActionPermissionMetadata role permComment permDef) = - AO.object $ [ ("role", AO.toOrdered role) - , ("definition", AO.toOrdered permDef) - ] - <> catMaybes [maybeCommentToMaybeOrdPair permComment] + permToOrdJSON (ActionPermissionMetadata role permComment) = + AO.object $ [("role", AO.toOrdered role)] <> catMaybes [maybeCommentToMaybeOrdPair permComment] -- Utility functions listToMaybeOrdPair :: Text -> (a -> AO.Value) -> [a] -> Maybe (Text, AO.Value) diff --git a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs index d8ebb6dfae98f..1dc79657d55da 100644 --- a/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs +++ b/server/src-lib/Hasura/RQL/DDL/Schema/Cache.hs @@ -64,7 +64,6 @@ import Hasura.SQL.Types mergeCustomTypes :: MonadError QErr f - -- => M.HashMap RoleName GS.GCtx -> GS.GCtx -> VT.TypeMap => M.HashMap RoleName GS.GCtx -> GS.GCtx -> (NonObjectTypeMap, AnnotatedObjects) -> f (GS.GCtxMap, GS.GCtx) mergeCustomTypes gCtxMap remoteSchemaCtx customTypesState = do @@ -198,7 +197,7 @@ buildSchemaCacheRule = proc (catalogMetadata, invalidationKeys) -> do buildAndCollectInfo = proc (catalogMetadata, invalidationKeys) -> do let CatalogMetadata tables relationships permissions eventTriggers remoteSchemas functions allowlistDefs - computedFields customTypes actions actionPermissions = catalogMetadata + computedFields customTypes actions = catalogMetadata -- tables tableRawInfos <- buildTableCache -< (tables, Inc.selectD #_ikMetadata invalidationKeys) @@ -259,18 +258,23 @@ buildSchemaCacheRule = proc (catalogMetadata, invalidationKeys) -> do resolvedCustomTypes <- bindA -< resolveCustomTypes tableCache customTypes -- actions - resolvedActionDefs <- (mapFromL _caName actions >- returnA) + actionCache <- (mapFromL _amName actions >- returnA) >-> (| Inc.keyed (\_ action -> do - let CreateAction name def _ = action - metadataObj = mkActionMetadataObj action + let ActionMetadata name comment def actionPermissions = action + metadataObj = MetadataObject (MOAction name) $ toJSON $ + CreateAction name def comment addActionContext e = "in action " <> name <<> "; " <> e (| withRecordInconsistency ( - (| modifyErrA (bindErrorA -< resolveAction resolvedCustomTypes def) + (| modifyErrA ( do + resolvedDef <- bindErrorA -< resolveAction resolvedCustomTypes def + let permissionInfos = map (ActionPermissionInfo . _apmRole) actionPermissions + permissionMap = mapFromL _apiRole permissionInfos + returnA -< ActionInfo name resolvedDef permissionMap comment + ) |) addActionContext) |) metadataObj) |) >-> (\actionMap -> returnA -< M.catMaybes actionMap) - actionCache <- buildActionCache -< (resolvedActionDefs, M.groupOn _capAction actionPermissions) -- remote schemas let remoteSchemaInvalidationKeys = Inc.selectD #_ikRemoteSchemas invalidationKeys @@ -290,8 +294,6 @@ buildSchemaCacheRule = proc (catalogMetadata, invalidationKeys) -> do definition = object ["table" .= qt, "configuration" .= configuration] in MetadataObject objectId definition - mkActionMetadataObj ca = MetadataObject (MOAction $ _caName ca) $ toJSON ca - mkRemoteSchemaMetadataObject remoteSchema = MetadataObject (MORemoteSchema (_arsqName remoteSchema)) (toJSON remoteSchema) @@ -399,35 +401,6 @@ buildSchemaCacheRule = proc (catalogMetadata, invalidationKeys) -> do returnA -< (remoteSchemaMap, schemaWithCT, defCtxWithCT) ) - - buildActionCache - :: ( ArrowChoice arr, Inc.ArrowDistribute arr, ArrowWriter (Seq CollectedInfo) arr - , Inc.ArrowCache m arr, MonadError QErr m - ) - => ( M.HashMap ActionName ResolvedActionDefinition - , M.HashMap ActionName [CreateActionPermission] - ) `arr` M.HashMap ActionName ActionInfo - buildActionCache = proc (definitions, permissions) -> do - let combinedMap = M.fromList $ flip map (M.toList definitions) $ - \(name, def) -> (name, (def, M.lookupDefault [] name permissions)) - (| Inc.keyed (\actionName (def, perms) -> do - permissionInfo <- (\maybeMap -> returnA -< M.catMaybes maybeMap) <-< - (| Inc.keyed (\role perm -> - (| withRecordInconsistency (do - selectFilter <- bindErrorA -< buildActionFilter (_apdSelect $ _capDefinition perm) - returnA -< ActionPermissionInfo role selectFilter - ) - |) (mkActionPermMetaObj actionName perm) - ) - |) (mapFromL _capRole perms) - returnA -< ActionInfo actionName def permissionInfo - ) - |) combinedMap - where - mkActionPermMetaObj actionName perm = - let objId = MOActionPermission actionName $ _capRole perm - in MetadataObject objId $ toJSON perm - -- | @'withMetadataCheck' cascade action@ runs @action@ and checks if the schema changed as a -- result. If it did, it checks to ensure the changes do not violate any integrity constraints, and -- if not, incorporates them into the schema cache. diff --git a/server/src-lib/Hasura/RQL/DML/Delete.hs b/server/src-lib/Hasura/RQL/DML/Delete.hs index 949a74b237266..80e18c22b1799 100644 --- a/server/src-lib/Hasura/RQL/DML/Delete.hs +++ b/server/src-lib/Hasura/RQL/DML/Delete.hs @@ -29,7 +29,7 @@ data AnnDelG v = AnnDel { dqp1Table :: !QualifiedTable , dqp1Where :: !(AnnBoolExp v, AnnBoolExp v) - , dqp1MutFlds :: !(MutFldsG v) + , dqp1Output :: !(MutationOutputG v) , dqp1AllCols :: ![PGColumnInfo] } deriving (Show, Eq) @@ -41,10 +41,10 @@ traverseAnnDel traverseAnnDel f annUpd = AnnDel tn <$> ((,) <$> traverseAnnBoolExp f whr <*> traverseAnnBoolExp f fltr) - <*> traverseMutFlds f mutFlds + <*> traverseMutationOutput f mutOutput <*> pure allCols where - AnnDel tn (whr, fltr) mutFlds allCols = annUpd + AnnDel tn (whr, fltr) mutOutput allCols = annUpd type AnnDel = AnnDelG S.SQLExp @@ -115,7 +115,7 @@ validateDeleteQ = deleteQueryToTx :: Bool -> (AnnDel, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON deleteQueryToTx strfyNum (u, p) = runMutation $ Mutation (dqp1Table u) (deleteCTE, p) - (dqp1MutFlds u) (dqp1AllCols u) strfyNum + (dqp1Output u) (dqp1AllCols u) strfyNum where deleteCTE = mkDeleteCTE u diff --git a/server/src-lib/Hasura/RQL/DML/Insert.hs b/server/src-lib/Hasura/RQL/DML/Insert.hs index e4f1446bc7397..b4f112e3d64d3 100644 --- a/server/src-lib/Hasura/RQL/DML/Insert.hs +++ b/server/src-lib/Hasura/RQL/DML/Insert.hs @@ -37,7 +37,7 @@ data InsertQueryP1 , iqp1Tuples :: ![[S.SQLExp]] , iqp1Conflict :: !(Maybe ConflictClauseP1) , iqp1CheckCond :: !(Maybe AnnBoolExpSQL) - , iqp1MutFlds :: !MutFlds + , iqp1Output :: !MutationOutput , iqp1AllCols :: ![PGColumnInfo] } deriving (Show, Eq) @@ -47,15 +47,15 @@ mkInsertCTE (InsertQueryP1 tn cols vals c checkCond _ _) = where tupVals = S.ValuesExp $ map S.TupleExp vals insert = - S.SQLInsert tn cols tupVals (toSQLConflict <$> c) - . Just - . S.RetExp - $ maybe - [S.selectStar] - (\e -> + S.SQLInsert tn cols tupVals (toSQLConflict <$> c) + . Just + . S.RetExp + $ maybe + [S.selectStar] + (\e -> [ S.selectStar , insertCheckExpr (toSQLBoolExp (S.QualTable tn) e) - ]) + ]) checkCond toSQLConflict :: ConflictClauseP1 -> S.SQLConflict @@ -201,7 +201,7 @@ convInsertQuery objsParser sessVarBldr prepFn (InsertQuery tableName val oC mRet withPathK "returning" $ checkRetCols fieldInfoMap selPerm retCols - let mutFlds = mkDefaultMutFlds mAnnRetCols + let mutOutput = mkDefaultMutFlds mAnnRetCols let defInsVals = S.mkColDefValMap $ map pgiColumn $ getCols fieldInfoMap @@ -216,16 +216,16 @@ convInsertQuery objsParser sessVarBldr prepFn (InsertQuery tableName val oC mRet inpCols = HS.toList $ HS.fromList $ concatMap fst insTuples checkExpr <- convAnnBoolExpPartialSQL sessVarFromCurrentSetting (ipiCheck insPerm) - + conflictClause <- withPathK "on_conflict" $ forM oC $ \c -> do roleName <- askCurRole unless (isTabUpdatable roleName tableInfo) $ throw400 PermissionDenied $ "upsert is not allowed for role " <> roleName <<> " since update permissions are not defined" + buildConflictClause sessVarBldr tableInfo inpCols c - return $ InsertQueryP1 tableName insCols sqlExps - conflictClause (Just checkExpr) mutFlds allCols + conflictClause (Just checkExpr) mutOutput allCols where selNecessaryMsg = "; \"returning\" can only be used if the role has " @@ -251,7 +251,7 @@ insertP2 :: Bool -> (InsertQueryP1, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON insertP2 strfyNum (u, p) = runMutation $ Mutation (iqp1Table u) (insertCTE, p) - (iqp1MutFlds u) (iqp1AllCols u) strfyNum + (iqp1Output u) (iqp1AllCols u) strfyNum where insertCTE = mkInsertCTE u @@ -260,23 +260,23 @@ insertP2 strfyNum (u, p) = -- -- The resulting SQL will look something like this: -- --- > INSERT INTO +-- > INSERT INTO -- > ... --- > RETURNING --- > *, --- > CASE WHEN {cond} --- > THEN NULL --- > ELSE hdb_catalog.check_violation('insert check constraint failed') +-- > RETURNING +-- > *, +-- > CASE WHEN {cond} +-- > THEN NULL +-- > ELSE hdb_catalog.check_violation('insert check constraint failed') -- > END insertCheckExpr :: S.BoolExp -> S.Extractor -insertCheckExpr condExpr = +insertCheckExpr condExpr = S.Extractor (S.SECond condExpr S.SENull - (S.SEFunction - (S.FunctionExp - (QualifiedObject (SchemaName "hdb_catalog") (FunctionName "check_violation")) + (S.SEFunction + (S.FunctionExp + (QualifiedObject (SchemaName "hdb_catalog") (FunctionName "check_violation")) (S.FunctionArgs [S.SELit "insert check constraint failed"] mempty) Nothing) )) diff --git a/server/src-lib/Hasura/RQL/DML/Mutation.hs b/server/src-lib/Hasura/RQL/DML/Mutation.hs index e8aa8ae44d450..c201f7fcebd2d 100644 --- a/server/src-lib/Hasura/RQL/DML/Mutation.hs +++ b/server/src-lib/Hasura/RQL/DML/Mutation.hs @@ -3,16 +3,13 @@ module Hasura.RQL.DML.Mutation , runMutation , mutateAndFetchCols , mkSelCTEFromColVals - , withSingleTableRow ) where import Hasura.Prelude -import qualified Data.Aeson.Ordered as AO import qualified Data.HashMap.Strict as Map import qualified Data.Sequence as DS -import qualified Data.Text as T import qualified Database.PG.Query as Q import qualified Hasura.SQL.DML as S @@ -30,7 +27,7 @@ data Mutation = Mutation { _mTable :: !QualifiedTable , _mQuery :: !(S.CTE, DS.Seq Q.PrepArg) - , _mFields :: !MutFlds + , _mOutput :: !MutationOutput , _mCols :: ![PGColumnInfo] , _mStrfyNum :: !Bool } deriving (Show, Eq) @@ -38,22 +35,22 @@ data Mutation runMutation :: Mutation -> Q.TxE QErr EncJSON runMutation mut = bool (mutateAndReturn mut) (mutateAndSel mut) $ - hasNestedFld $ _mFields mut + hasNestedFld $ _mOutput mut mutateAndReturn :: Mutation -> Q.TxE QErr EncJSON -mutateAndReturn (Mutation qt (cte, p) mutFlds _ strfyNum) = +mutateAndReturn (Mutation qt (cte, p) mutationOutput _ strfyNum) = encJFromBS . runIdentity . Q.getRow <$> Q.rawQE dmlTxErrorHandler (Q.fromBuilder $ toSQL selWith) (toList p) True where - selWith = mkMutationOutputExp qt Nothing cte mutFlds strfyNum + selWith = mkMutationOutputExp qt Nothing cte mutationOutput strfyNum mutateAndSel :: Mutation -> Q.TxE QErr EncJSON -mutateAndSel (Mutation qt q mutFlds allCols strfyNum) = do +mutateAndSel (Mutation qt q mutationOutput allCols strfyNum) = do -- Perform mutation and fetch unique columns MutateResp _ columnVals <- mutateAndFetchCols qt allCols q strfyNum selCTE <- mkSelCTEFromColVals qt allCols columnVals - let selWith = mkMutationOutputExp qt Nothing selCTE mutFlds strfyNum + let selWith = mkMutationOutputExp qt Nothing selCTE mutationOutput strfyNum -- Perform select query and fetch returning fields encJFromBS . runIdentity . Q.getRow <$> Q.rawQE dmlTxErrorHandler (Q.fromBuilder $ toSQL selWith) [] True @@ -88,7 +85,7 @@ mutateAndFetchCols qt cols (cte, p) strfyNum = { S.selExtr = [S.Extractor S.countStar Nothing] , S.selFrom = Just $ S.FromExp [S.FIIden aliasIden] } - colSel = S.SESelect $ mkSQLSelect False $ + colSel = S.SESelect $ mkSQLSelect JASMultipleRows $ AnnSelG selFlds tabFrom tabPerm noTableArgs strfyNum -- | Note:- Using sorted columns is necessary to enable casting the rows returned by VALUES expression to table type. @@ -130,27 +127,3 @@ mkSelCTEFromColVals qt allCols colVals = TENull -> S.SENull TELit textValue -> S.withTyAnn (unsafePGColumnToRepresentation colTy) $ S.SELit textValue - --- | Note: Expecting '{"returning": [{}]}' encoded JSON --- FIXME:- If possible, move this logic to SQL -withSingleTableRow - :: MonadError QErr m => EncJSON -> m EncJSON -withSingleTableRow response = - case AO.eitherDecode $ encJToLBS response of - Left e -> throw500 $ "error occurred while parsing mutation result: " <> T.pack e - Right val -> do - obj <- asObject val - rowsVal <- onNothing (AO.lookup "returning" obj) $ - throw500 "returning field not found in mutation result" - rows <- asArray rowsVal - pure $ AO.toEncJSON $ case rows of - [] -> AO.Null - r:_ -> r - where - asObject = \case - AO.Object o -> pure o - _ -> throw500 "expecting ordered Object" - - asArray = \case - AO.Array arr -> pure $ toList arr - _ -> throw500 "expecting ordered Array" diff --git a/server/src-lib/Hasura/RQL/DML/Returning.hs b/server/src-lib/Hasura/RQL/DML/Returning.hs index 6a675af67dddc..917efa664397d 100644 --- a/server/src-lib/Hasura/RQL/DML/Returning.hs +++ b/server/src-lib/Hasura/RQL/DML/Returning.hs @@ -12,7 +12,7 @@ import qualified Hasura.SQL.DML as S data MutFldG v = MCount | MExp !T.Text - | MRet ![(FieldName, AnnFldG v)] + | MRet !(AnnFldsG v) deriving (Show, Eq) traverseMutFld @@ -27,10 +27,24 @@ traverseMutFld f = \case type MutFld = MutFldG S.SQLExp -type MutFldsG v = [(T.Text, MutFldG v)] +type MutFldsG v = Fields (MutFldG v) -onlyReturningMutFld :: AnnFldsG v -> MutFldsG v -onlyReturningMutFld annFlds = [("returning", MRet annFlds)] +data MutationOutputG v + = MTOFields !(MutFldsG v) -- ^ Multirow + | MTOObject !(AnnFldsG v) -- ^ Singlerow table object + deriving (Show, Eq) + +traverseMutationOutput + :: (Applicative f) + => (a -> f b) + -> MutationOutputG a -> f (MutationOutputG b) +traverseMutationOutput f = \case + MTOFields mutationFields -> + MTOFields <$> traverse (traverse (traverseMutFld f)) mutationFields + MTOObject annFields -> + MTOObject <$> traverseAnnFlds f annFields + +type MutationOutput = MutationOutputG S.SQLExp traverseMutFlds :: (Applicative f) @@ -42,8 +56,10 @@ traverseMutFlds f = type MutFlds = MutFldsG S.SQLExp -hasNestedFld :: MutFlds -> Bool -hasNestedFld = any isNestedMutFld +hasNestedFld :: MutationOutputG a -> Bool +hasNestedFld = \case + MTOFields flds -> any isNestedMutFld flds + MTOObject annFlds -> any isNestedAnnFld annFlds where isNestedMutFld (_, mutFld) = case mutFld of MRet annFlds -> any isNestedAnnFld annFlds @@ -70,8 +86,8 @@ pgColsToSelFlds cols = flip map cols $ \pgColInfo -> (fromPGCol $ pgiColumn pgColInfo, mkAnnColField pgColInfo Nothing) -mkDefaultMutFlds :: Maybe [PGColumnInfo] -> MutFlds -mkDefaultMutFlds = \case +mkDefaultMutFlds :: Maybe [PGColumnInfo] -> MutationOutput +mkDefaultMutFlds = MTOFields . \case Nothing -> mutFlds Just cols -> ("returning", MRet $ pgColsToSelFlds cols):mutFlds where @@ -87,32 +103,39 @@ mkMutFldExp qt preCalAffRows strfyNum = \case let countExp = S.SESelect $ S.mkSelect { S.selExtr = [S.Extractor S.countStar Nothing] - , S.selFrom = Just $ S.FromExp $ pure frmItem + , S.selFrom = Just $ S.FromExp $ pure $ S.FIIden cteAlias } in maybe countExp (S.SEUnsafe . T.pack . show) preCalAffRows MExp t -> S.SELit t MRet selFlds -> -- let tabFrom = TableFrom qt $ Just frmItem - let tabFrom = FromIden $ qualTableToAliasIden qt + let tabFrom = FromIden cteAlias tabPerm = TablePerm annBoolExpTrue Nothing - in S.SESelect $ mkSQLSelect False $ + in S.SESelect $ mkSQLSelect JASMultipleRows $ AnnSelG selFlds tabFrom tabPerm noTableArgs strfyNum where - frmItem = S.FIIden $ qualTableToAliasIden qt + cteAlias = qualTableToAliasIden qt mkMutationOutputExp - :: QualifiedTable -> Maybe Int -> S.CTE -> MutFlds -> Bool -> S.SelectWith -mkMutationOutputExp qt preCalAffRows cte mutFlds strfyNum = - S.SelectWith [(alias, cte)] sel + :: QualifiedTable -> Maybe Int -> S.CTE -> MutationOutput -> Bool -> S.SelectWith +mkMutationOutputExp qt preCalAffRows cte mutOutput strfyNum = + S.SelectWith [(S.Alias cteAlias, cte)] sel where - alias = S.Alias $ qualTableToAliasIden qt + cteAlias = qualTableToAliasIden qt sel = S.mkSelect { S.selExtr = [S.Extractor extrExp Nothing] } - extrExp = S.SEFnApp "json_build_object" jsonBuildObjArgs Nothing + extrExp = case mutOutput of + MTOFields mutFlds -> + let jsonBuildObjArgs = flip concatMap mutFlds $ + \(FieldName k, mutFld) -> [S.SELit k, mkMutFldExp qt preCalAffRows strfyNum mutFld] + in S.SEFnApp "json_build_object" jsonBuildObjArgs Nothing + + MTOObject annFlds -> + let tabFrom = FromIden cteAlias + tabPerm = TablePerm annBoolExpTrue Nothing + in S.SESelect $ mkSQLSelect JASSingleObject $ + AnnSelG annFlds tabFrom tabPerm noTableArgs strfyNum - jsonBuildObjArgs = - flip concatMap mutFlds $ - \(k, mutFld) -> [S.SELit k, mkMutFldExp qt preCalAffRows strfyNum mutFld] checkRetCols :: (UserInfoM m, QErrM m) diff --git a/server/src-lib/Hasura/RQL/DML/Select.hs b/server/src-lib/Hasura/RQL/DML/Select.hs index 2491d7a7c91ee..9a21d761919c5 100644 --- a/server/src-lib/Hasura/RQL/DML/Select.hs +++ b/server/src-lib/Hasura/RQL/DML/Select.hs @@ -268,16 +268,16 @@ convSelectQuery sessVarBldr prepArgBuilder (DMLQuery qt selQ) = do convSelectQ fieldInfo selPermInfo extSelQ sessVarBldr prepArgBuilder -selectP2 :: Bool -> (AnnSimpleSel, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON -selectP2 asSingleObject (sel, p) = +selectP2 :: JsonAggSelect -> (AnnSimpleSel, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON +selectP2 jsonAggSelect (sel, p) = encJFromBS . runIdentity . Q.getRow <$> Q.rawQE dmlTxErrorHandler (Q.fromBuilder selectSQL) (toList p) True where - selectSQL = toSQL $ mkSQLSelect asSingleObject sel + selectSQL = toSQL $ mkSQLSelect jsonAggSelect sel -selectQuerySQL :: Bool -> AnnSimpleSel -> Q.Query -selectQuerySQL asSingleObject sel = - Q.fromBuilder $ toSQL $ mkSQLSelect asSingleObject sel +selectQuerySQL :: JsonAggSelect -> AnnSimpleSel -> Q.Query +selectQuerySQL jsonAggSelect sel = + Q.fromBuilder $ toSQL $ mkSQLSelect jsonAggSelect sel selectAggQuerySQL :: AnnAggSel -> Q.Query selectAggQuerySQL = @@ -296,7 +296,7 @@ phaseOne = phaseTwo :: (MonadTx m) => (AnnSimpleSel, DS.Seq Q.PrepArg) -> m EncJSON phaseTwo = - liftTx . selectP2 False + liftTx . selectP2 JASMultipleRows runSelect :: (QErrM m, UserInfoM m, CacheRM m, HasSQLGenCtx m, MonadTx m) diff --git a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs index 55784b52b620b..c6cd5b60121c0 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Internal.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Internal.hs @@ -143,12 +143,11 @@ withJsonAggExtr subQueryReq permLimitM ordBy alias = ) asJsonAggExtr - :: Bool -> S.Alias -> Bool -> Maybe Int -> Maybe S.OrderByExp -> S.Extractor -asJsonAggExtr singleObj als subQueryReq permLimit ordByExpM = - flip S.Extractor (Just als) $ - bool (withJsonAggExtr subQueryReq permLimit ordByExpM als) - (asSingleRowExtr als) - singleObj + :: JsonAggSelect -> S.Alias -> Bool -> Maybe Int -> Maybe S.OrderByExp -> S.Extractor +asJsonAggExtr jsonAggSelect als subQueryReq permLimit ordByExpM = + flip S.Extractor (Just als) $ case jsonAggSelect of + JASMultipleRows -> withJsonAggExtr subQueryReq permLimit ordByExpM als + JASSingleObject -> asSingleRowExtr als -- array relationships are not grouped, so have to be prefixed by -- parent's alias @@ -572,7 +571,7 @@ mkBaseNode subQueryReq pfxs fldAls annSelFlds selectFrom map (mkArrItem arrRelCtx) arrFlds -- all computed fields with table returns computedFieldNodes = HM.fromList $ map mkComputedFieldTable $ - mapMaybe getComputedFieldTable flds + mapMaybe getComputedFieldTable flds (obExtrs, ordByObjs, ordByArrs, obeM) = mkOrdByItems' arrRelCtx @@ -646,10 +645,10 @@ mkBaseNode subQueryReq pfxs fldAls annSelFlds selectFrom in (arrAls, arrNode) -- process a computed field, which returns a table - mkComputedFieldTable (fld, asObject, sel) = + mkComputedFieldTable (fld, jsonAggSelect, sel) = let prefixes = Prefixes (mkComputedFieldTableAls thisPfx fld) thisPfx baseNode = annSelToBaseNode False prefixes fld sel - in (fld, CFTableNode asObject baseNode) + in (fld, CFTableNode jsonAggSelect baseNode) getAnnObj (f, annFld) = case annFld of FObj ob -> Just (f, ob) @@ -660,8 +659,8 @@ mkBaseNode subQueryReq pfxs fldAls annSelFlds selectFrom _ -> Nothing getComputedFieldTable (f, annFld) = case annFld of - FComputedField (CFSTable b sel) -> Just (f, b, sel) - _ -> Nothing + FComputedField (CFSTable jas sel) -> Just (f, jas, sel) + _ -> Nothing annSelToBaseNode :: Bool -> Prefixes -> FieldName -> AnnSimpleSel -> BaseNode annSelToBaseNode subQueryReq pfxs fldAls annSel = @@ -678,7 +677,7 @@ mkArrNode subQueryReq pfxs (fldName, annArrSel) = case annArrSel of ASSimple annArrRel -> let bn = annSelToBaseNode subQueryReq pfxs fldName $ aarAnnSel annArrRel permLimit = getPermLimit $ aarAnnSel annArrRel - extr = asJsonAggExtr False (S.toAlias fldName) subQueryReq permLimit $ + extr = asJsonAggExtr JASMultipleRows (S.toAlias fldName) subQueryReq permLimit $ _bnOrderBy bn in ArrNode [extr] (aarMapping annArrRel) bn @@ -743,10 +742,10 @@ baseNodeToSel joinCond baseNode = in S.mkLateralFromItem sel als computedFieldNodeToFromItem :: (FieldName, CFTableNode) -> S.FromItem - computedFieldNodeToFromItem (fld, CFTableNode asObject bn) = + computedFieldNodeToFromItem (fld, CFTableNode jsonAggSelect bn) = let internalSel = baseNodeToSel (S.BELit True) bn als = S.Alias $ _bnPrefix bn - extr = asJsonAggExtr asObject (S.toAlias fld) False Nothing $ + extr = asJsonAggExtr jsonAggSelect (S.toAlias fld) False Nothing $ _bnOrderBy bn internalSelFrom = S.mkSelFromItem internalSel als sel = S.mkSelect @@ -765,12 +764,12 @@ mkAggSelect annAggSel = ArrNode extr _ bn = aggSelToArrNode rootPrefix (FieldName "root") aggSel -mkSQLSelect :: Bool -> AnnSimpleSel -> S.Select -mkSQLSelect isSingleObject annSel = +mkSQLSelect :: JsonAggSelect -> AnnSimpleSel -> S.Select +mkSQLSelect jsonAggSelect annSel = prefixNumToAliases $ arrNodeToSelect baseNode extrs $ S.BELit True where permLimit = getPermLimit annSel - extrs = pure $ asJsonAggExtr isSingleObject rootFldAls False permLimit + extrs = pure $ asJsonAggExtr jsonAggSelect rootFldAls False permLimit $ _bnOrderBy baseNode rootFldIden = toIden rootFldName rootPrefix = Prefixes rootFldIden rootFldIden diff --git a/server/src-lib/Hasura/RQL/DML/Select/Types.hs b/server/src-lib/Hasura/RQL/DML/Select/Types.hs index d8aaa4ce4f43b..8dc04963043eb 100644 --- a/server/src-lib/Hasura/RQL/DML/Select/Types.hs +++ b/server/src-lib/Hasura/RQL/DML/Select/Types.hs @@ -17,6 +17,12 @@ import qualified Hasura.SQL.DML as S import Hasura.SQL.Types type SelectQExt = SelectG ExtCol BoolExp Int + +data JsonAggSelect + = JASMultipleRows + | JASSingleObject + deriving (Show, Eq) + -- Columns in RQL data ExtCol = ECSimple !PGCol @@ -105,7 +111,7 @@ data ComputedFieldScalarSel v data ComputedFieldSel v = CFSScalar !(ComputedFieldScalarSel v) - | CFSTable !Bool !(AnnSimpleSelG v) + | CFSTable !JsonAggSelect !(AnnSimpleSelG v) deriving (Show, Eq) traverseComputedFieldSel @@ -228,6 +234,11 @@ data AggFld type AggFlds = Fields AggFld type AnnFldsG v = Fields (AnnFldG v) +traverseAnnFlds + :: (Applicative f) + => (a -> f b) -> AnnFldsG a -> f (AnnFldsG b) +traverseAnnFlds f = traverse (traverse (traverseAnnFld f)) + type AnnFlds = AnnFldsG S.SQLExp data TableAggFldG v @@ -241,8 +252,7 @@ traverseTableAggFld => (a -> f b) -> TableAggFldG a -> f (TableAggFldG b) traverseTableAggFld f = \case TAFAgg aggFlds -> pure $ TAFAgg aggFlds - TAFNodes annFlds -> - TAFNodes <$> traverse (traverse (traverseAnnFld f)) annFlds + TAFNodes annFlds -> TAFNodes <$> traverseAnnFlds f annFlds TAFExp t -> pure $ TAFExp t type TableAggFld = TableAggFldG S.SQLExp @@ -304,8 +314,7 @@ traverseAnnSimpleSel :: (Applicative f) => (a -> f b) -> AnnSimpleSelG a -> f (AnnSimpleSelG b) -traverseAnnSimpleSel f = - traverseAnnSel (traverse (traverse (traverseAnnFld f))) f +traverseAnnSimpleSel f = traverseAnnSel (traverseAnnFlds f) f traverseAnnAggSel :: (Applicative f) @@ -452,14 +461,14 @@ data ArrNodeInfo -- | Node for computed field returning setof
data CFTableNode = CFTableNode - { _ctnAsSingleObject :: !Bool - , _ctnNode :: !BaseNode + { _ctnSelectType :: !JsonAggSelect + , _ctnNode :: !BaseNode } deriving (Show, Eq) mergeCFTableNodes :: CFTableNode -> CFTableNode -> CFTableNode mergeCFTableNodes lNode rNode = CFTableNode - (_ctnAsSingleObject lNode && _ctnAsSingleObject rNode) + (_ctnSelectType rNode) (mergeBaseNodes (_ctnNode lNode) (_ctnNode rNode)) data Prefixes diff --git a/server/src-lib/Hasura/RQL/DML/Update.hs b/server/src-lib/Hasura/RQL/DML/Update.hs index 55b423ebd6385..7e30f41c93d3d 100644 --- a/server/src-lib/Hasura/RQL/DML/Update.hs +++ b/server/src-lib/Hasura/RQL/DML/Update.hs @@ -35,7 +35,7 @@ data AnnUpdG v -- we don't prepare the arguments for returning -- however the session variable can still be -- converted as desired - , uqp1MutFlds :: !(MutFldsG v) + , uqp1Output :: !(MutationOutputG v) , uqp1AllCols :: ![PGColumnInfo] } deriving (Show, Eq) @@ -48,10 +48,10 @@ traverseAnnUpd f annUpd = AnnUpd tn <$> traverse (traverse f) setExps <*> ((,) <$> traverseAnnBoolExp f whr <*> traverseAnnBoolExp f fltr) - <*> traverseMutFlds f mutFlds + <*> traverseMutationOutput f mutOutput <*> pure allCols where - AnnUpd tn setExps (whr, fltr) mutFlds allCols = annUpd + AnnUpd tn setExps (whr, fltr) mutOutput allCols = annUpd type AnnUpd = AnnUpdG S.SQLExp @@ -212,7 +212,7 @@ updateQueryToTx :: Bool -> (AnnUpd, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON updateQueryToTx strfyNum (u, p) = runMutation $ Mutation (uqp1Table u) (updateCTE, p) - (uqp1MutFlds u) (uqp1AllCols u) strfyNum + (uqp1Output u) (uqp1AllCols u) strfyNum where updateCTE = mkUpdateCTE u diff --git a/server/src-lib/Hasura/RQL/Instances.hs b/server/src-lib/Hasura/RQL/Instances.hs index fece8094723b8..ce5d6b79c1e06 100644 --- a/server/src-lib/Hasura/RQL/Instances.hs +++ b/server/src-lib/Hasura/RQL/Instances.hs @@ -31,6 +31,7 @@ instance NFData G.ValueConst instance NFData G.VariableDefinition instance (NFData a) => NFData (G.ObjectFieldG a) instance NFData UT.Variable +instance NFData UT.TemplateItem instance NFData UT.URLTemplate deriving instance NFData G.Alias diff --git a/server/src-lib/Hasura/RQL/Types/Action.hs b/server/src-lib/Hasura/RQL/Types/Action.hs index 608dd098d4b56..62a4f802dc5d3 100644 --- a/server/src-lib/Hasura/RQL/Types/Action.hs +++ b/server/src-lib/Hasura/RQL/Types/Action.hs @@ -17,14 +17,14 @@ module Hasura.RQL.Types.Action , aiName , aiDefinition , aiPermissions + , aiComment , ActionPermissionInfo(..) , ActionPermissionMap - - , ActionPermissionSelect(..) - , ActionPermissionDefinition(..) , CreateActionPermission(..) + , ActionMetadata(..) + , ActionPermissionMetadata(..) ) where @@ -33,9 +33,7 @@ import Data.URL.Template import Hasura.Incremental (Cacheable) import Hasura.Prelude import Hasura.RQL.DDL.Headers -import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.CustomTypes -import Hasura.RQL.Types.DML import Hasura.RQL.Types.Permission import Hasura.SQL.Types import Language.Haskell.TH.Syntax (Lift) @@ -44,7 +42,6 @@ import qualified Data.Aeson as J import qualified Data.Aeson.Casing as J import qualified Data.Aeson.TH as J import qualified Data.HashMap.Strict as Map -import qualified Data.Text as T import qualified Database.PG.Query as Q import qualified Language.GraphQL.Draft.Syntax as G @@ -116,56 +113,35 @@ type ResolvedActionDefinition = ActionDefinition ResolvedWebhook data ActionPermissionInfo = ActionPermissionInfo { _apiRole :: !RoleName - , _apiFilter :: !AnnBoolExpPartialSQL } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ActionPermissionInfo) type ActionPermissionMap = Map.HashMap RoleName ActionPermissionInfo --- data ActionMetadataField --- = ActionMetadataFieldId --- | ActionMetadataFieldCreatedAt --- | ActionMetadataFieldStatus --- deriving (Show, Eq) - --- data ActionOutputTypeInfo --- = ActionOutputScalar !VT.ScalarTyInfo --- | ActionOutputEnum !VT.EnumTyInfo --- | ActionOutputObject !VT.ObjTyInfo --- deriving (Show, Eq) - --- TODO: this is terrible --- instance J.ToJSON ActionOutputTypeInfo where --- toJSON = J.toJSON . show - data ActionInfo = ActionInfo { _aiName :: !ActionName , _aiDefinition :: !ResolvedActionDefinition , _aiPermissions :: !ActionPermissionMap + , _aiComment :: !(Maybe Text) } deriving (Show, Eq) $(J.deriveToJSON (J.aesonDrop 3 J.snakeCase) ''ActionInfo) $(makeLenses ''ActionInfo) -data InputWebhook - = IWTemplate !URLTemplate - | IWPlain !Text +newtype InputWebhook + = InputWebhook {unInputWebhook :: URLTemplate} deriving (Show, Eq, Lift, Generic) instance NFData InputWebhook instance Cacheable InputWebhook instance J.ToJSON InputWebhook where - toJSON = \case - IWTemplate template -> J.String $ printURLTemplate template - IWPlain t -> J.String t + toJSON = J.String . printURLTemplate . unInputWebhook instance J.FromJSON InputWebhook where parseJSON = J.withText "String" $ \t -> - if T.any (== '{') t then - case parseURLTemplate t of - Left _ -> fail "Parsing URL template failed" - Right template -> pure $ IWTemplate template - else pure $ IWPlain t + case parseURLTemplate t of + Left e -> fail $ "Parsing URL template failed: " ++ e + Right v -> pure $ InputWebhook v type ActionDefinitionInput = ActionDefinition InputWebhook @@ -186,29 +162,45 @@ data UpdateAction } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''UpdateAction) -newtype ActionPermissionSelect - = ActionPermissionSelect - { _apsFilter :: BoolExp - } deriving (Show, Eq, Lift, Generic) -instance NFData ActionPermissionSelect -instance Cacheable ActionPermissionSelect -$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionPermissionSelect) - -newtype ActionPermissionDefinition - = ActionPermissionDefinition - { _apdSelect :: ActionPermissionSelect - } deriving (Show, Eq, Lift, Generic) -instance NFData ActionPermissionDefinition -instance Cacheable ActionPermissionDefinition -$(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ActionPermissionDefinition) - data CreateActionPermission = CreateActionPermission { _capAction :: !ActionName , _capRole :: !RoleName - , _capDefinition :: !ActionPermissionDefinition + , _capDefinition :: !(Maybe J.Value) , _capComment :: !(Maybe Text) } deriving (Show, Eq, Lift, Generic) instance NFData CreateActionPermission instance Cacheable CreateActionPermission $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''CreateActionPermission) + +-- representation of action permission metadata +data ActionPermissionMetadata + = ActionPermissionMetadata + { _apmRole :: !RoleName + , _apmComment :: !(Maybe Text) + } deriving (Show, Eq, Lift, Generic) +instance NFData ActionPermissionMetadata +instance Cacheable ActionPermissionMetadata + +$(J.deriveFromJSON + (J.aesonDrop 4 J.snakeCase){J.omitNothingFields=True} + ''ActionPermissionMetadata) + +-- representation of action metadata +data ActionMetadata + = ActionMetadata + { _amName :: !ActionName + , _amComment :: !(Maybe Text) + , _amDefinition :: !ActionDefinitionInput + , _amPermissions :: ![ActionPermissionMetadata] + } deriving (Show, Eq, Lift, Generic) +instance NFData ActionMetadata +instance Cacheable ActionMetadata + +instance J.FromJSON ActionMetadata where + parseJSON = J.withObject "Object" $ \o -> + ActionMetadata + <$> o J..: "name" + <*> o J..:? "comment" + <*> o J..: "definition" + <*> o J..:? "permissions" J..!= [] diff --git a/server/src-lib/Hasura/RQL/Types/Catalog.hs b/server/src-lib/Hasura/RQL/Types/Catalog.hs index 57cc0fa7940fe..0f9eb2d34e4e1 100644 --- a/server/src-lib/Hasura/RQL/Types/Catalog.hs +++ b/server/src-lib/Hasura/RQL/Types/Catalog.hs @@ -139,6 +139,8 @@ instance NFData CatalogFunction instance Cacheable CatalogFunction $(deriveFromJSON (aesonDrop 3 snakeCase) ''CatalogFunction) +type CatalogAction = ActionMetadata + data CatalogMetadata = CatalogMetadata { _cmTables :: ![CatalogTable] @@ -150,8 +152,7 @@ data CatalogMetadata , _cmAllowlistCollections :: ![CollectionDef] , _cmComputedFields :: ![CatalogComputedField] , _cmCustomTypes :: !CustomTypes - , _cmActions :: ![CreateAction] - , _cmActionPermissions :: ![CreateActionPermission] + , _cmActions :: ![CatalogAction] } deriving (Show, Eq, Generic) instance NFData CatalogMetadata instance Cacheable CatalogMetadata diff --git a/server/src-lib/Hasura/RQL/Types/Common.hs b/server/src-lib/Hasura/RQL/Types/Common.hs index 93d4eafbe975c..fccf29a13a298 100644 --- a/server/src-lib/Hasura/RQL/Types/Common.hs +++ b/server/src-lib/Hasura/RQL/Types/Common.hs @@ -146,7 +146,10 @@ $(deriveToJSON (aesonDrop 2 snakeCase) ''RelInfo) newtype FieldName = FieldName { getFieldNameTxt :: T.Text } - deriving (Show, Eq, Ord, Hashable, FromJSON, ToJSON, FromJSONKey, ToJSONKey, Lift, Data, Generic, Arbitrary, NFData, Cacheable) + deriving ( Show, Eq, Ord, Hashable, FromJSON, ToJSON + , FromJSONKey, ToJSONKey, Lift, Data, Generic + , IsString, Arbitrary, NFData, Cacheable + ) instance IsIden FieldName where toIden (FieldName f) = Iden f diff --git a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs index 8ccd36e530d2e..4669146062417 100644 --- a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs @@ -70,7 +70,7 @@ instance J.FromJSON GraphQLType where newtype InputObjectFieldName = InputObjectFieldName { unInputObjectFieldName :: G.Name } - deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift, Generic, NFData, Cacheable) + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, DQuote, Lift, Generic, NFData, Cacheable) data InputObjectFieldDefinition = InputObjectFieldDefinition @@ -85,7 +85,7 @@ $(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''InputObjectFieldDefinition) newtype InputObjectTypeName = InputObjectTypeName { unInputObjectTypeName :: G.NamedType } - deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift, Generic, NFData, Cacheable) + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, DQuote, Lift, Generic, NFData, Cacheable) data InputObjectTypeDefinition = InputObjectTypeDefinition @@ -99,7 +99,7 @@ $(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''InputObjectTypeDefinition) newtype ObjectFieldName = ObjectFieldName { unObjectFieldName :: G.Name } - deriving ( Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON + deriving ( Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, DQuote , J.FromJSONKey, J.ToJSONKey, Lift, Generic, NFData, Cacheable) data ObjectFieldDefinition @@ -119,7 +119,7 @@ $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ObjectFieldDefinition) newtype RelationshipName = RelationshipName { unRelationshipName :: G.Name } - deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift, Generic, NFData, Cacheable) + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, DQuote, Lift, Generic, NFData, Cacheable) data TypeRelationship t f = TypeRelationship @@ -139,7 +139,7 @@ $(J.deriveJSON (J.aesonDrop 3 J.snakeCase) ''TypeRelationship) newtype ObjectTypeName = ObjectTypeName { unObjectTypeName :: G.NamedType } - deriving ( Show, Eq, Ord, Hashable, J.FromJSON, J.FromJSONKey + deriving ( Show, Eq, Ord, Hashable, J.FromJSON, J.FromJSONKey, DQuote , J.ToJSONKey, J.ToJSON, Lift, Generic, NFData, Cacheable) data ObjectTypeDefinition @@ -164,7 +164,7 @@ $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''ScalarTypeDefinition) newtype EnumTypeName = EnumTypeName { unEnumTypeName :: G.NamedType } - deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, Lift, Generic, NFData, Cacheable) + deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, DQuote, Lift, Generic, NFData, Cacheable) data EnumValueDefinition = EnumValueDefinition diff --git a/server/src-lib/Hasura/RQL/Types/Metadata.hs b/server/src-lib/Hasura/RQL/Types/Metadata.hs index 9b033c37270a9..adf3d68a71615 100644 --- a/server/src-lib/Hasura/RQL/Types/Metadata.hs +++ b/server/src-lib/Hasura/RQL/Types/Metadata.hs @@ -58,7 +58,7 @@ moiName objectId = moiTypeName objectId <> " " <> case objectId of MTOPerm name _ -> dquoteTxt name MTOTrigger name -> dquoteTxt name in tableObjectName <> " in " <> moiName (MOTable tableName) - MOCustomTypes -> "" + MOCustomTypes -> "custom_types" MOAction name -> dquoteTxt name MOActionPermission name role -> dquoteTxt role <> " permission in " <> dquoteTxt name diff --git a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs index 55654c21bd7c3..ce28e068a0fc7 100644 --- a/server/src-lib/Hasura/RQL/Types/SchemaCache.hs +++ b/server/src-lib/Hasura/RQL/Types/SchemaCache.hs @@ -187,12 +187,6 @@ incSchemaCacheVer :: SchemaCacheVer -> SchemaCacheVer incSchemaCacheVer (SchemaCacheVer prev) = SchemaCacheVer $ prev + 1 --- data CustomTypesState --- = CustomTypeState --- { _ctsTypes :: !RT.TypeMap --- , _ctsRelationships :: !(M.HashMap G.NamedType ) --- } - type FunctionCache = M.HashMap QualifiedFunction FunctionInfo -- info of all functions type ActionCache = M.HashMap ActionName ActionInfo -- info of all actions diff --git a/server/src-lib/Hasura/SQL/Types.hs b/server/src-lib/Hasura/SQL/Types.hs index f2a0867e3c10e..79022b616f857 100644 --- a/server/src-lib/Hasura/SQL/Types.hs +++ b/server/src-lib/Hasura/SQL/Types.hs @@ -33,6 +33,7 @@ module Hasura.SQL.Types , DQuote(..) , dquote + , dquoteList , IsIden(..) , Iden(..) @@ -121,10 +122,18 @@ instance DQuote T.Text where dquoteTxt = id {-# INLINE dquoteTxt #-} +deriving instance DQuote G.NamedType +deriving instance DQuote G.Name +deriving instance DQuote G.EnumValue + dquote :: (DQuote a) => a -> T.Text dquote = T.dquote . dquoteTxt {-# INLINE dquote #-} +dquoteList :: (DQuote a, Foldable t) => t a -> T.Text +dquoteList = T.intercalate ", " . map dquote . toList +{-# INLINE dquoteList #-} + infixr 6 <>> (<>>) :: (DQuote a) => T.Text -> a -> T.Text (<>>) lTxt a = lTxt <> dquote a @@ -135,9 +144,6 @@ infixr 6 <<> (<<>) a rTxt = dquote a <> rTxt {-# INLINE (<<>) #-} -instance DQuote G.Name where - dquoteTxt = G.unName - pgFmtIden :: T.Text -> T.Text pgFmtIden x = "\"" <> T.replace "\"" "\"\"" (trimNullChars x) <> "\"" diff --git a/server/src-rsr/catalog_metadata.sql b/server/src-rsr/catalog_metadata.sql index a405426bc52e3..824010edd14e8 100644 --- a/server/src-rsr/catalog_metadata.sql +++ b/server/src-rsr/catalog_metadata.sql @@ -9,8 +9,7 @@ select 'allowlist_collections', allowlist.item, 'computed_fields', computed_field.items, 'custom_types', coalesce((select custom_types from hdb_catalog.hdb_custom_types), '{}'), - 'actions', actions.items, - 'action_permissions', action_permissions.items + 'actions', actions.items ) from ( @@ -179,29 +178,32 @@ from coalesce( json_agg( json_build_object( - 'name', action_name, - 'definition', action_defn :: json, - 'comment', comment + 'name', ha.action_name, + 'definition', ha.action_defn :: json, + 'comment', ha.comment, + 'permissions', p.items ) ), '[]' ) as items from - hdb_catalog.hdb_action - ) as actions, - ( - select - coalesce( - json_agg( - json_build_object( - 'action', action_name, - 'role', role_name, - 'definition', definition :: json, - 'comment', comment - ) - ), - '[]' - ) as items - from - hdb_catalog.hdb_action_permission - ) as action_permissions + hdb_catalog.hdb_action ha + left join lateral + ( + select + coalesce( + json_agg( + json_build_object( + 'action', hap.action_name, + 'role', hap.role_name, + 'definition', hap.definition :: json, + 'comment', hap.comment + ) + ), + '[]' + ) as items + from + hdb_catalog.hdb_action_permission hap + where hap.action_name = ha.action_name + ) p on 'true' + ) as actions diff --git a/server/src-test/Data/Parser/URLTemplate.hs b/server/src-test/Data/Parser/URLTemplate.hs index 21517718adff3..8dad329aa8914 100644 --- a/server/src-test/Data/Parser/URLTemplate.hs +++ b/server/src-test/Data/Parser/URLTemplate.hs @@ -8,9 +8,10 @@ import Test.QuickCheck spec :: Spec spec = describe "parseURLTemplate" $ - it "parse URL templates generated by printURLTemplate" $ - withMaxSuccess 50 $ - forAll (resize 10 genURLTemplate) $ \urlTemplate -> - case parseURLTemplate (printURLTemplate urlTemplate) of - Left err -> counterexample err False - Right r -> property $ r == urlTemplate + it "URL template parser and printer" $ + withMaxSuccess 1000 $ + forAll genURLTemplate $ \urlTemplate -> do + let templateString = printURLTemplate urlTemplate + case parseURLTemplate templateString of + Left e -> counterexample e False + Right r -> property $ printURLTemplate r == templateString From a3e2805a141504dc0df70eebb0b0d0d8c0e4b516 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Mon, 10 Feb 2020 20:59:43 +0530 Subject: [PATCH 55/62] document async action architecture in Resolve/Action.hs file --- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 374 +++++++++--------- .../src-lib/Hasura/GraphQL/Resolve/Insert.hs | 6 +- .../Hasura/GraphQL/Resolve/Mutation.hs | 8 +- server/src-lib/Hasura/RQL/DDL/Action.hs | 6 +- server/src-lib/Hasura/RQL/DDL/Metadata.hs | 1 - server/src-lib/Hasura/RQL/DML/Returning.hs | 23 +- server/src-rsr/catalog_metadata.sql | 1 - server/src-rsr/initialise.sql | 2 +- server/src-rsr/migrations/31_to_32.sql | 2 +- 9 files changed, 207 insertions(+), 216 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 806a2ca127ca5..14cddf9cf4d21 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -2,9 +2,6 @@ module Hasura.GraphQL.Resolve.Action ( resolveActionMutation , resolveAsyncActionQuery , asyncActionsProcessor - - , ActionSelect(..) - , traverseActionSelect ) where import Hasura.Prelude @@ -50,32 +47,6 @@ import Hasura.SQL.Types import Hasura.SQL.Value (PGScalarValue (..), pgScalarValueToJson, toTxtValue) -data OutputFieldResolved - = OutputFieldSimple !Text - | OutputFieldTypename !G.NamedType - deriving (Show, Eq) - -data ResponseFieldResolved - = ResponseFieldOutput ![(Text, OutputFieldResolved)] - | ResponseFieldMetadata !FieldName - | ResponseFieldTypename !G.NamedType - deriving (Show, Eq) - -data ActionSelect v - = ActionSelect - { _asId :: !v - , _asSelection :: ![(Text, ResponseFieldResolved)] - , _asFilter :: !(AnnBoolExp v) - } deriving (Show, Eq, Functor) - -traverseActionSelect - :: (Applicative f) - => (a -> f b) - -> ActionSelect a - -> f (ActionSelect b) -traverseActionSelect f (ActionSelect idText selection rowFilter) = - ActionSelect <$> f idText <*> pure selection <*> traverseAnnBoolExp f rowFilter - newtype ActionContext = ActionContext {_acName :: ActionName} deriving (Show, Eq) @@ -96,33 +67,30 @@ data ActionWebhookErrorResponse } deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''ActionWebhookErrorResponse) -data ResolvePlan - = ResolveReturn - | ResolvePostgres [(PGCol, PGScalarType)] ![(Text, OutputFieldResolved)] - deriving (Show, Eq) - -processOutputSelectionSet - :: ( MonadReusability m +resolveActionMutation + :: ( HasVersion + , MonadReusability m , MonadError QErr m , MonadReader r m + , MonadIO m , Has FieldMap r , Has OrdByCtx r , Has SQLGenCtx r + , Has HTTP.Manager r + , Has [HTTP.Header] r ) - => RS.ArgumentExp UnresolvedVal - -> [(PGCol, PGScalarType)] - -> G.NamedType -> SelSet -> m GRS.AnnSimpleSelect -processOutputSelectionSet tableRowInput definitionList fldTy flds = do - stringifyNumerics <- stringifyNum <$> asks getter - annotatedFields <- processTableSelectionSet fldTy flds - let annSel = RS.AnnSelG annotatedFields selectFrom - RS.noTablePermissions RS.noTableArgs stringifyNumerics - pure annSel - where - jsonbToRecordFunction = QualifiedObject (SchemaName "pg_catalog") $ FunctionName "jsonb_to_record" - functionArgs = RS.FunctionArgsExp [tableRowInput] mempty - selectFrom = RS.FromFunction jsonbToRecordFunction functionArgs $ Just definitionList + => Field + -> ActionExecutionContext + -> UserVars + -> m RespTx +resolveActionMutation field executionContext sessionVariables = + case executionContext of + ActionExecutionSyncWebhook executionContextSync -> + resolveActionMutationSync field executionContextSync sessionVariables + ActionExecutionAsync -> + resolveActionMutationAsync field sessionVariables +-- | Synchronously execute webhook handler and resolve response to action "output" resolveActionMutationSync :: ( HasVersion , MonadReusability m @@ -157,50 +125,120 @@ resolveActionMutationSync field executionContext sessionVariables = do SyncActionExecutionContext actionName definitionList resolvedWebhook confHeaders forwardClientHeaders = executionContext -callWebhook - :: (HasVersion, MonadIO m, MonadError QErr m) - => HTTP.Manager - -> [HTTP.Header] - -> [HeaderConf] - -> Bool - -> ResolvedWebhook - -> ActionWebhookPayload - -> m J.Value -callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook actionWebhookPayload = do - resolvedConfHeaders <- makeHeadersFromConf confHeaders - let clientHeaders = if forwardClientHeaders then mkClientHeadersForward reqHeaders else [] - contentType = ("Content-Type", "application/json") - options = wreqOptions manager $ - -- Using HashMap to avoid duplicate headers between configuration headers - -- and client headers where configuration headers are preferred - contentType : (Map.toList . Map.fromList) (resolvedConfHeaders <> clientHeaders) - postPayload = J.toJSON actionWebhookPayload - url = (T.unpack $ unResolvedWebhook resolvedWebhook) - httpResponse <- liftIO $ try $ try $ - Wreq.asJSON =<< Wreq.postWith options url postPayload - case httpResponse of - Left e -> - throw500WithDetail "http exception when calling webhook" $ - J.toJSON $ HttpException e - Right (Left (Wreq.JSONError e)) -> - throw500WithDetail "not a valid json response from webhook" $ - J.toJSON e - Right (Right responseWreq) -> do - let responseValue = responseWreq ^. Wreq.responseBody - responseStatus = responseWreq ^. Wreq.responseStatus +{- Note: [Async action architecture] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +In async actions, acquiring the action result is deferred. The async action mutation is made to +initiate the action which returns an UUID. The UUID is used to query/subsribe for actions response. - if | HTTP.statusIsSuccessful responseStatus -> pure responseValue +On mutation, the server makes an action log record in hdb_catalog.hdb_action_log table with request headers +and input arguments. The `asyncActionsProcessor` background thread processes the async actions by executing +the webhook handler and writing back the response payload or errors if any in the database. - | HTTP.statusIsClientError responseStatus -> do - ActionWebhookErrorResponse message maybeCode <- - modifyErr ("webhook response: " <>) $ decodeValue responseValue - let code = maybe Unexpected ActionWebhookCode maybeCode - qErr = QErr [] responseStatus message code Nothing - throwError qErr +When an async action query/subscription is made, the server fetches the relavent data from the hdb_action_log +table provides the action response. See Note [Resolving async action query/subscription] below. +-} - | otherwise -> - throw500WithDetail "internal error" $ - J.object ["webhook_response" J..= responseValue] +-- | Resolve asynchronous action mutation which returns only the action uuid +resolveActionMutationAsync + :: ( MonadError QErr m, MonadReader r m + , Has [HTTP.Header] r + ) + => Field + -> UserVars + -> m RespTx +resolveActionMutationAsync field sessionVariables = do + reqHeaders <- asks getter + let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field + pure $ do + actionId <- runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler [Q.sql| + INSERT INTO + "hdb_catalog"."hdb_action_log" + ("action_name", "session_variables", "request_headers", "input_payload", "status") + VALUES + ($1, $2, $3, $4, $5) + RETURNING "id" + |] + (actionName, Q.AltJ sessionVariables, Q.AltJ $ toHeadersMap reqHeaders, Q.AltJ inputArgs, "created"::Text) False + + pure $ encJFromJValue $ UUID.toText actionId + where + actionName = G.unName $ _fName field + toHeadersMap = Map.fromList . map ((bsToTxt . CI.original) *** bsToTxt) + +{- Note: [Resolving async action query/subscription] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +Resolving async action query involves in selecting fields from hdb_catalog.hdb_action_log table. +See Note [Async action architecture] above. See the table's Postgres schema in src-rsr/initialise.sql. +The webhook's response JSON stored in "response_payload" column has to be fetched as "output" +along with relationships (if any) to other tables. The in-built pg_catalog function `jsonb_to_record` +helps in converting any JSON object to Postgres record type. Thus generated record is used to resolve +action's type. Here, we treat the "output" field as a computed field to hdb_action_log table with +`jsonb_to_record` as custom SQL function. +-} + +resolveAsyncActionQuery + :: ( MonadReusability m + , MonadError QErr m + , MonadReader r m + , Has FieldMap r + , Has OrdByCtx r + , Has SQLGenCtx r + ) + => UserInfo + -> ActionSelectOpContext + -> Field + -> m GRS.AnnSimpleSelect +resolveAsyncActionQuery userInfo selectContext field = do + actionId <- withArg (_fArguments field) "id" parseActionId + stringifyNumerics <- stringifyNum <$> asks getter + + annotatedFields <- fmap (map (first FieldName)) $ withSelSet (_fSelSet field) $ \fld -> + case _fName fld of + "__typename" -> return $ RS.FExp $ G.unName $ G.unNamedType $ _fType fld + "output" -> do + -- See Note [Resolving async action query/subscription] + let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload" + definitionList = _asocDefinitionList selectContext + (RS.FComputedField . RS.CFSTable RS.JASSingleObject) -- The output of action is always a single object + <$> processOutputSelectionSet inputTableArgument definitionList (_fType fld) (_fSelSet fld) + + -- The metadata columns + "id" -> return $ mkAnnFldFromPGCol "id" PGUUID + "created_at" -> return $ mkAnnFldFromPGCol "created_at" PGTimeStampTZ + "errors" -> return $ mkAnnFldFromPGCol "errors" PGJSONB + G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t + + let tableFromExp = RS.FromTable actionLogTable + tableArguments = RS.noTableArgs + { RS._taWhere = Just $ mkTableBoolExpression actionId} + tablePermissions = RS.TablePerm annBoolExpTrue Nothing + selectAstUnresolved = RS.AnnSelG annotatedFields tableFromExp tablePermissions + tableArguments stringifyNumerics + return selectAstUnresolved + where + actionLogTable = QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log") + + -- TODO:- Avoid using PGColumnInfo + mkAnnFldFromPGCol column columnType = + flip RS.mkAnnColField Nothing $ + PGColumnInfo (unsafePGCol column) (G.Name column) 0 (PGColumnScalar columnType) True Nothing + + parseActionId annInpValue = mkParameterizablePGValue <$> asPGColumnValue annInpValue + + mkTableBoolExpression actionId = + let actionIdColumnInfo = PGColumnInfo (unsafePGCol "id") "id" 0 (PGColumnScalar PGUUID) False Nothing + actionIdColumnEq = BoolFld $ AVCol actionIdColumnInfo [AEQ True actionId] + sessionVarsColumnInfo = PGColumnInfo (unsafePGCol "session_variables") "session_variables" + 0 (PGColumnScalar PGJSONB) False Nothing + sessionVarValue = UVPG $ AnnPGVal Nothing False $ WithScalarType PGJSONB + $ PGValJSONB $ Q.JSONB $ J.toJSON $ userVars userInfo + sessionVarsColumnEq = BoolFld $ AVCol sessionVarsColumnInfo [AEQ True sessionVarValue] + + -- For non-admin roles, accessing an async action's response should be allowed only for the user + -- who initiated the action through mutation. The action's response is accessible for a query/subscription + -- only when it's session variables are equal to that of action's. + in if isAdmin (userRole userInfo) then actionIdColumnEq + else BoolAnd [actionIdColumnEq, sessionVarsColumnEq] data ActionLogItem = ActionLogItem @@ -211,6 +249,8 @@ data ActionLogItem , _aliInputPayload :: !J.Value } deriving (Show, Eq) +-- | Process async actions from hdb_catalog.hdb_action_log table. This functions is executed in a background thread. +-- See Note [Async action architecture] above asyncActionsProcessor :: HasVersion => IORef (RebuildableSchemaCache Run, SchemaCacheVer) @@ -297,57 +337,50 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do getUndeliveredEvents = runTx undeliveredEventsQuery -resolveActionMutation - :: ( HasVersion - , MonadReusability m - , MonadError QErr m - , MonadReader r m - , MonadIO m - , Has FieldMap r - , Has OrdByCtx r - , Has SQLGenCtx r - , Has HTTP.Manager r - , Has [HTTP.Header] r - ) - => Field - -> ActionExecutionContext - -- We need the sesion variables for column presets - -> UserVars - -> m RespTx -resolveActionMutation field executionContext sessionVariables = - case executionContext of - ActionExecutionSyncWebhook executionContextSync -> - resolveActionMutationSync field executionContextSync sessionVariables - ActionExecutionAsync -> - resolveActionMutationAsync field sessionVariables +callWebhook + :: (HasVersion, MonadIO m, MonadError QErr m) + => HTTP.Manager + -> [HTTP.Header] + -> [HeaderConf] + -> Bool + -> ResolvedWebhook + -> ActionWebhookPayload + -> m J.Value +callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook actionWebhookPayload = do + resolvedConfHeaders <- makeHeadersFromConf confHeaders + let clientHeaders = if forwardClientHeaders then mkClientHeadersForward reqHeaders else [] + contentType = ("Content-Type", "application/json") + options = wreqOptions manager $ + -- Using HashMap to avoid duplicate headers between configuration headers + -- and client headers where configuration headers are preferred + contentType : (Map.toList . Map.fromList) (resolvedConfHeaders <> clientHeaders) + postPayload = J.toJSON actionWebhookPayload + url = (T.unpack $ unResolvedWebhook resolvedWebhook) + httpResponse <- liftIO $ try $ try $ + Wreq.asJSON =<< Wreq.postWith options url postPayload + case httpResponse of + Left e -> + throw500WithDetail "http exception when calling webhook" $ + J.toJSON $ HttpException e + Right (Left (Wreq.JSONError e)) -> + throw500WithDetail "not a valid json response from webhook" $ + J.toJSON e + Right (Right responseWreq) -> do + let responseValue = responseWreq ^. Wreq.responseBody + responseStatus = responseWreq ^. Wreq.responseStatus --- | Resolve asynchronous action mutation which returns only the action uuid -resolveActionMutationAsync - :: ( MonadError QErr m, MonadReader r m - , Has [HTTP.Header] r - ) - => Field - -- We need the sesion variables for column presets - -> UserVars - -> m RespTx -resolveActionMutationAsync field sessionVariables = do - reqHeaders <- asks getter - let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field - pure $ do - actionId <- runIdentity . Q.getRow <$> Q.withQE defaultTxErrorHandler [Q.sql| - INSERT INTO - "hdb_catalog"."hdb_action_log" - ("action_name", "session_variables", "request_headers", "input_payload", "status") - VALUES - ($1, $2, $3, $4, $5) - RETURNING "id" - |] - (actionName, Q.AltJ sessionVariables, Q.AltJ $ toHeadersMap reqHeaders, Q.AltJ inputArgs, "created"::Text) False + if | HTTP.statusIsSuccessful responseStatus -> pure responseValue - pure $ encJFromJValue $ UUID.toText actionId - where - actionName = G.unName $ _fName field - toHeadersMap = Map.fromList . map ((bsToTxt . CI.original) *** bsToTxt) + | HTTP.statusIsClientError responseStatus -> do + ActionWebhookErrorResponse message maybeCode <- + modifyErr ("webhook response: " <>) $ decodeValue responseValue + let code = maybe Unexpected ActionWebhookCode maybeCode + qErr = QErr [] responseStatus message code Nothing + throwError qErr + + | otherwise -> + throw500WithDetail "internal error" $ + J.object ["webhook_response" J..= responseValue] annInpValueToJson :: AnnInpVal -> J.Value annInpValueToJson annInpValue = @@ -359,7 +392,7 @@ annInpValueToJson annInpValue = AGObject _ objectM -> J.toJSON $ fmap (fmap annInpValueToJson) objectM AGArray _ valuesM -> J.toJSON $ fmap (fmap annInpValueToJson) valuesM -resolveAsyncActionQuery +processOutputSelectionSet :: ( MonadReusability m , MonadError QErr m , MonadReader r m @@ -367,55 +400,16 @@ resolveAsyncActionQuery , Has OrdByCtx r , Has SQLGenCtx r ) - => UserInfo - -> ActionSelectOpContext - -> Field - -> m GRS.AnnSimpleSelect -resolveAsyncActionQuery userInfo selectContext field = do - actionId <- withArg (_fArguments field) "id" parseActionId + => RS.ArgumentExp UnresolvedVal + -> [(PGCol, PGScalarType)] + -> G.NamedType -> SelSet -> m GRS.AnnSimpleSelect +processOutputSelectionSet tableRowInput definitionList fldTy flds = do stringifyNumerics <- stringifyNum <$> asks getter - - annotatedFields <- fmap (map (first FieldName)) $ withSelSet (_fSelSet field) $ \fld -> - case _fName fld of - "__typename" -> return $ RS.FExp $ G.unName $ G.unNamedType $ _fType fld - "output" -> do - -- Treating "output" as a computed field to "hdb_action_log" table with "jsonb_to_record" SQL function - let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload" - definitionList = _asocDefinitionList selectContext - (RS.FComputedField . RS.CFSTable RS.JASSingleObject) -- The output of action is always a single object - <$> processOutputSelectionSet inputTableArgument definitionList (_fType fld) (_fSelSet fld) - -- the metadata columns - "id" -> return $ mkAnnFldFromPGCol "id" PGUUID - "created_at" -> return $ mkAnnFldFromPGCol "created_at" PGTimeStampTZ - "errors" -> return $ mkAnnFldFromPGCol "errors" PGJSONB - G.Name t -> throw500 $ "unexpected field in actions' httpResponse : " <> t - - let tableFromExp = RS.FromTable actionLogTable - tableArguments = RS.noTableArgs - { RS._taWhere = Just $ mkTableBoolExpression actionId} - tablePermissions = RS.TablePerm annBoolExpTrue Nothing - selectAstUnresolved = RS.AnnSelG annotatedFields tableFromExp tablePermissions - tableArguments stringifyNumerics - return selectAstUnresolved + annotatedFields <- processTableSelectionSet fldTy flds + let annSel = RS.AnnSelG annotatedFields selectFrom + RS.noTablePermissions RS.noTableArgs stringifyNumerics + pure annSel where - actionLogTable = QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log") - - -- TODO:- Avoid using PGColumnInfo - mkAnnFldFromPGCol column columnType = - flip RS.mkAnnColField Nothing $ - PGColumnInfo (unsafePGCol column) (G.Name column) 0 (PGColumnScalar columnType) True Nothing - - parseActionId annInpValue = mkParameterizablePGValue <$> asPGColumnValue annInpValue - - mkTableBoolExpression actionId = - let actionIdColumnInfo = PGColumnInfo (unsafePGCol "id") "id" 0 (PGColumnScalar PGUUID) False Nothing - actionIdColumnEq = BoolFld $ AVCol actionIdColumnInfo [AEQ True actionId] - sessionVarsColumnInfo = PGColumnInfo (unsafePGCol "session_variables") "session_variables" - 0 (PGColumnScalar PGJSONB) False Nothing - sessionVarValue = UVPG $ AnnPGVal Nothing False $ WithScalarType PGJSONB - $ PGValJSONB $ Q.JSONB $ J.toJSON $ userVars userInfo - sessionVarsColumnEq = BoolFld $ AVCol sessionVarsColumnInfo [AEQ True sessionVarValue] - in if isAdmin (userRole userInfo) then actionIdColumnEq - -- For non-admin roles, the async result is accessible only if the request session variables - -- equals to action's session variables - else BoolAnd [actionIdColumnEq, sessionVarsColumnEq] + jsonbToRecordFunction = QualifiedObject (SchemaName "pg_catalog") $ FunctionName "jsonb_to_record" + functionArgs = RS.FunctionArgsExp [tableRowInput] mempty + selectFrom = RS.FromFunction jsonbToRecordFunction functionArgs $ Just definitionList diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs index 53ad765ebb606..664493d2d1cdc 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Insert.hs @@ -344,7 +344,7 @@ insertArrRel strfyNum role resCols arrRelIns = colMapping = riMapping relInfo tn = riRTable relInfo relNameTxt = relNameToTxt $ riName relInfo - mutOutput = RR.MTOFields [("affected_rows", RR.MCount)] + mutOutput = RR.MOutMultirowFields [("affected_rows", RR.MCount)] -- | insert an object with object and array relationships insertObj @@ -467,7 +467,7 @@ convertInsert -> Field -- the mutation field -> m RespTx convertInsert role tn fld = prefixErrPath fld $ do - mutOutputUnres <- RR.MTOFields <$> resolveMutationFields (_fType fld) (_fSelSet fld) + mutOutputUnres <- RR.MOutMultirowFields <$> resolveMutationFields (_fType fld) (_fSelSet fld) mutOutputRes <- RR.traverseMutationOutput resolveValTxt mutOutputUnres annVals <- withArg arguments "objects" asArray -- if insert input objects is empty array then @@ -503,7 +503,7 @@ convertInsertOne -> m RespTx convertInsertOne role qt field = prefixErrPath field $ do tableSelFields <- processTableSelectionSet (_fType field) $ _fSelSet field - let mutationOutputUnresolved = RR.MTOObject tableSelFields + let mutationOutputUnresolved = RR.MOutSinglerowObject tableSelFields mutationOutputResolved <- RR.traverseMutationOutput resolveValTxt mutationOutputUnresolved annInputObj <- withArg arguments "object" asObject InsCtx tableColMap check defValMap relInfoMap updPerm <- getInsCtx qt diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs index 72fb8b23419b9..ad0f5052f4acf 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Mutation.hs @@ -298,7 +298,7 @@ mutationFieldsResolver ) => Field -> m (RR.MutationOutputG UnresolvedVal) mutationFieldsResolver field = - RR.MTOFields <$> resolveMutationFields (_fType field) (_fSelSet field) + RR.MOutMultirowFields <$> resolveMutationFields (_fType field) (_fSelSet field) tableSelectionAsMutationOutput :: ( MonadReusability m, MonadError QErr m @@ -307,15 +307,15 @@ tableSelectionAsMutationOutput ) => Field -> m (RR.MutationOutputG UnresolvedVal) tableSelectionAsMutationOutput field = - RR.MTOObject <$> processTableSelectionSet (_fType field) (_fSelSet field) + RR.MOutSinglerowObject <$> processTableSelectionSet (_fType field) (_fSelSet field) -- | build mutation response for empty objects buildEmptyMutResp :: RR.MutationOutput -> EncJSON buildEmptyMutResp = mkTx where mkTx = \case - RR.MTOFields mutFlds -> encJFromJValue $ OMap.fromList $ map (second convMutFld) mutFlds - RR.MTOObject _ -> encJFromJValue $ J.Object mempty + RR.MOutMultirowFields mutFlds -> encJFromJValue $ OMap.fromList $ map (second convMutFld) mutFlds + RR.MOutSinglerowObject _ -> encJFromJValue $ J.Object mempty -- generate empty mutation response convMutFld = \case RR.MCount -> J.toJSON (0 :: Int) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index a5263af52de22..b40ddf8d4fb8f 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -235,9 +235,9 @@ persistCreateActionPermission :: (MonadTx m) => CreateActionPermission -> m () persistCreateActionPermission CreateActionPermission{..}= do liftTx $ Q.unitQE defaultTxErrorHandler [Q.sql| INSERT into hdb_catalog.hdb_action_permission - (action_name, role_name, definition, comment) - VALUES ($1, $2, $3, $4) - |] (_capAction, _capRole, Q.AltJ J.Null, _capComment) True + (action_name, role_name, comment) + VALUES ($1, $2, $3) + |] (_capAction, _capRole, _capComment) True data DropActionPermission = DropActionPermission diff --git a/server/src-lib/Hasura/RQL/DDL/Metadata.hs b/server/src-lib/Hasura/RQL/DDL/Metadata.hs index 9013e87c2b0a5..b21c5b8a8266f 100644 --- a/server/src-lib/Hasura/RQL/DDL/Metadata.hs +++ b/server/src-lib/Hasura/RQL/DDL/Metadata.hs @@ -417,7 +417,6 @@ fetchMetadata = do json_agg( json_build_object( 'role', ap.role_name, - 'definition', ap.definition, 'comment', ap.comment ) order by ap.role_name asc ), diff --git a/server/src-lib/Hasura/RQL/DML/Returning.hs b/server/src-lib/Hasura/RQL/DML/Returning.hs index 917efa664397d..a65d5e248a4ca 100644 --- a/server/src-lib/Hasura/RQL/DML/Returning.hs +++ b/server/src-lib/Hasura/RQL/DML/Returning.hs @@ -30,8 +30,8 @@ type MutFld = MutFldG S.SQLExp type MutFldsG v = Fields (MutFldG v) data MutationOutputG v - = MTOFields !(MutFldsG v) -- ^ Multirow - | MTOObject !(AnnFldsG v) -- ^ Singlerow table object + = MOutMultirowFields !(MutFldsG v) + | MOutSinglerowObject !(AnnFldsG v) deriving (Show, Eq) traverseMutationOutput @@ -39,10 +39,10 @@ traverseMutationOutput => (a -> f b) -> MutationOutputG a -> f (MutationOutputG b) traverseMutationOutput f = \case - MTOFields mutationFields -> - MTOFields <$> traverse (traverse (traverseMutFld f)) mutationFields - MTOObject annFields -> - MTOObject <$> traverseAnnFlds f annFields + MOutMultirowFields mutationFields -> + MOutMultirowFields <$> traverse (traverse (traverseMutFld f)) mutationFields + MOutSinglerowObject annFields -> + MOutSinglerowObject <$> traverseAnnFlds f annFields type MutationOutput = MutationOutputG S.SQLExp @@ -58,8 +58,8 @@ type MutFlds = MutFldsG S.SQLExp hasNestedFld :: MutationOutputG a -> Bool hasNestedFld = \case - MTOFields flds -> any isNestedMutFld flds - MTOObject annFlds -> any isNestedAnnFld annFlds + MOutMultirowFields flds -> any isNestedMutFld flds + MOutSinglerowObject annFlds -> any isNestedAnnFld annFlds where isNestedMutFld (_, mutFld) = case mutFld of MRet annFlds -> any isNestedAnnFld annFlds @@ -87,7 +87,7 @@ pgColsToSelFlds cols = \pgColInfo -> (fromPGCol $ pgiColumn pgColInfo, mkAnnColField pgColInfo Nothing) mkDefaultMutFlds :: Maybe [PGColumnInfo] -> MutationOutput -mkDefaultMutFlds = MTOFields . \case +mkDefaultMutFlds = MOutMultirowFields . \case Nothing -> mutFlds Just cols -> ("returning", MRet $ pgColsToSelFlds cols):mutFlds where @@ -108,7 +108,6 @@ mkMutFldExp qt preCalAffRows strfyNum = \case in maybe countExp (S.SEUnsafe . T.pack . show) preCalAffRows MExp t -> S.SELit t MRet selFlds -> - -- let tabFrom = TableFrom qt $ Just frmItem let tabFrom = FromIden cteAlias tabPerm = TablePerm annBoolExpTrue Nothing in S.SESelect $ mkSQLSelect JASMultipleRows $ @@ -125,12 +124,12 @@ mkMutationOutputExp qt preCalAffRows cte mutOutput strfyNum = sel = S.mkSelect { S.selExtr = [S.Extractor extrExp Nothing] } extrExp = case mutOutput of - MTOFields mutFlds -> + MOutMultirowFields mutFlds -> let jsonBuildObjArgs = flip concatMap mutFlds $ \(FieldName k, mutFld) -> [S.SELit k, mkMutFldExp qt preCalAffRows strfyNum mutFld] in S.SEFnApp "json_build_object" jsonBuildObjArgs Nothing - MTOObject annFlds -> + MOutSinglerowObject annFlds -> let tabFrom = FromIden cteAlias tabPerm = TablePerm annBoolExpTrue Nothing in S.SESelect $ mkSQLSelect JASSingleObject $ diff --git a/server/src-rsr/catalog_metadata.sql b/server/src-rsr/catalog_metadata.sql index 824010edd14e8..a3a2ef1613d7b 100644 --- a/server/src-rsr/catalog_metadata.sql +++ b/server/src-rsr/catalog_metadata.sql @@ -196,7 +196,6 @@ from json_build_object( 'action', hap.action_name, 'role', hap.role_name, - 'definition', hap.definition :: json, 'comment', hap.comment ) ), diff --git a/server/src-rsr/initialise.sql b/server/src-rsr/initialise.sql index a63001bd1a5be..0003fd3cc7a05 100644 --- a/server/src-rsr/initialise.sql +++ b/server/src-rsr/initialise.sql @@ -680,7 +680,7 @@ CREATE TABLE hdb_catalog.hdb_action_permission ( action_name TEXT NOT NULL, role_name TEXT NOT NULL, - definition JSONB NOT NULL, + definition JSONB NOT NULL DEFAULT '{}'::jsonb, comment TEXT NULL, PRIMARY KEY (action_name, role_name), diff --git a/server/src-rsr/migrations/31_to_32.sql b/server/src-rsr/migrations/31_to_32.sql index 2ff954c12c1dc..2d844ecd6daef 100644 --- a/server/src-rsr/migrations/31_to_32.sql +++ b/server/src-rsr/migrations/31_to_32.sql @@ -10,7 +10,7 @@ CREATE TABLE hdb_catalog.hdb_action_permission ( action_name TEXT NOT NULL, role_name TEXT NOT NULL, - definition JSONB NOT NULL, + definition JSONB NOT NULL DEFAULT '{}'::jsonb, comment TEXT NULL, PRIMARY KEY (action_name, role_name), From 5b2de9acc4ca6afcfa0939002ff90c30c5e54fba Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Mon, 10 Feb 2020 21:20:38 +0530 Subject: [PATCH 56/62] remove few commented code --- server/src-lib/Hasura/GraphQL/Schema/Action.hs | 4 ++-- server/src-lib/Hasura/GraphQL/Validate/Types.hs | 6 ------ server/src-lib/Hasura/RQL/DDL/Action.hs | 1 - 3 files changed, 2 insertions(+), 9 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index eb55dd868218a..99d4da8101f41 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -48,8 +48,6 @@ mkAsyncActionQueryResponseObj actionName outputType = , G.toGT $ mkScalarTy PGTimeStampTZ) , ( "errors", "errors related to the invocation" , G.toGT $ mkScalarTy PGJSON) - -- , ( "status", "the status of this action, whether it is processed, etc." - -- , G.toGT $ G.NamedType "action_status") , ( "output", "the output fields of this action" , unGraphQLType outputType) ] @@ -199,6 +197,8 @@ mkActionFieldsAndTypes actionInfo annotatedOutputType permission = ) , RFRelationship $ RelationshipField (RelInfo + -- RelationshipName, which is newtype wrapper over G.Name is always + -- non-empty text so as to conform GraphQL spec (RelName $ mkNonEmptyTextUnsafe $ coerce relationshipName) (_trType relationship) columnMapping remoteTable True) diff --git a/server/src-lib/Hasura/GraphQL/Validate/Types.hs b/server/src-lib/Hasura/GraphQL/Validate/Types.hs index 94548e122f55a..eb33f8f22912b 100644 --- a/server/src-lib/Hasura/GraphQL/Validate/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Validate/Types.hs @@ -411,12 +411,6 @@ instance J.ToJSON TypeInfo where instance J.FromJSON TypeInfo where parseJSON _ = fail "FromJSON not implemented for TypeInfo" --- $(J.deriveJSON --- J.defaultOptions { J.constructorTagModifier = J.snakeCase . drop 2 --- , J.sumEncoding = J.TaggedObject "type" "detail" --- } --- ''TypeInfo) - data AsObjType = AOTObj ObjTyInfo | AOTIFace IFaceTyInfo diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index b40ddf8d4fb8f..7ad4ffd295faf 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -243,7 +243,6 @@ data DropActionPermission = DropActionPermission { _dapAction :: !ActionName , _dapRole :: !RoleName - -- , _capIfExists :: !(Maybe IfExists) } deriving (Show, Eq, Lift) $(J.deriveJSON (J.aesonDrop 4 J.snakeCase) ''DropActionPermission) From c96dd6ebdb9f39559304108b964dddcc3d08a617 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Tue, 11 Feb 2020 15:56:03 +0530 Subject: [PATCH 57/62] remove commented code from GraphQL/Context.hs & update graphql-parser-hs lib git reference --- server/cabal.project | 6 +++--- server/src-lib/Hasura/GraphQL/Context.hs | 9 --------- 2 files changed, 3 insertions(+), 12 deletions(-) diff --git a/server/cabal.project b/server/cabal.project index 4b5fe08fd3c58..a74125f55a132 100644 --- a/server/cabal.project +++ b/server/cabal.project @@ -11,7 +11,7 @@ -- ...and then invoke cabal with -- $ cabal new-build --project-file=cabal.project.myconfig -- --- See: https://www.haskell.org/cabal/users-guide/nix-local-build.html#configuring-builds-with-cabal-project +-- See: https://www.haskell.org/cabal/users-guide/nix-local-build.html#configuring-builds-with-cabal-project packages: . package * @@ -33,8 +33,8 @@ source-repository-package source-repository-package type: git - location: https://github.com/0x777/graphql-parser-hs.git - tag: 10f9e9c23c16a2a8c4c333ab404ac1e9ae43fc58 + location: https://github.com/hasura/graphql-parser-hs.git + tag: 088acdf9120c4bea11f6185dfb587bd04ee2cb54 source-repository-package type: git diff --git a/server/src-lib/Hasura/GraphQL/Context.hs b/server/src-lib/Hasura/GraphQL/Context.hs index 908d9506ffb04..792eb13338ebd 100644 --- a/server/src-lib/Hasura/GraphQL/Context.hs +++ b/server/src-lib/Hasura/GraphQL/Context.hs @@ -51,15 +51,6 @@ instance ToJSON GCtx where type GCtxMap = Map.HashMap RoleName GCtx --- data GCtxMap --- = GCtxMap --- { _gcmAdminCtx :: !GCtx --- , _gcmRoles :: !(Map.HashMap RoleName GCtx) --- } deriving (Show, Eq) - --- getAdminGCtx :: GCtxMap -> GCtx --- getAdminGCtx = _gcmAdminCtx - mkQueryRootTyInfo :: [ObjFldInfo] -> ObjTyInfo mkQueryRootTyInfo flds = mkHsraObjTyInfo (Just "query root") From 2e92e3a6e7886570c40f2e408a8f0f80c3fb680d Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Tue, 11 Feb 2020 18:24:33 +0530 Subject: [PATCH 58/62] remove a non exhaustive pattern matches --- server/src-lib/Hasura/SQL/Value.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/server/src-lib/Hasura/SQL/Value.hs b/server/src-lib/Hasura/SQL/Value.hs index ac22c115787b4..9d9a889b86314 100644 --- a/server/src-lib/Hasura/SQL/Value.hs +++ b/server/src-lib/Hasura/SQL/Value.hs @@ -93,6 +93,7 @@ pgScalarValueToJson = \case PGValChar t -> toJSON t PGValVarchar t -> toJSON t PGValText t -> toJSON t + PGValCitext t -> toJSON t PGValDate d -> toJSON d PGValTimeStampTZ u -> toJSON $ formatTime defaultTimeLocale "%FT%T%QZ" u From c3557ea2c8280a58e149c69bb53b11a935335f05 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 12 Feb 2020 12:17:46 +0530 Subject: [PATCH 59/62] support actions returning array of objects --- .../src-lib/Hasura/GraphQL/Resolve/Action.hs | 87 ++++++++++++++----- .../src-lib/Hasura/GraphQL/Resolve/Types.hs | 5 +- .../src-lib/Hasura/GraphQL/Schema/Action.hs | 3 +- server/src-lib/Hasura/RQL/DDL/Action.hs | 7 -- server/src-lib/Hasura/RQL/DDL/CustomTypes.hs | 9 +- .../src-lib/Hasura/RQL/Types/CustomTypes.hs | 7 ++ 6 files changed, 80 insertions(+), 38 deletions(-) diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs index 14cddf9cf4d21..fcdea618345ef 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Action.hs @@ -67,6 +67,21 @@ data ActionWebhookErrorResponse } deriving (Show, Eq) $(J.deriveJSON (J.aesonDrop 5 J.snakeCase) ''ActionWebhookErrorResponse) +data ActionWebhookResponse + = AWRArray ![J.Object] + | AWRObject !J.Object + deriving (Show, Eq) + +instance J.FromJSON ActionWebhookResponse where + parseJSON v = case v of + J.Array{} -> AWRArray <$> J.parseJSON v + J.Object o -> pure $ AWRObject o + _ -> fail $ "expecting object or array of objects for action webhook response" + +instance J.ToJSON ActionWebhookResponse where + toJSON (AWRArray objects) = J.toJSON objects + toJSON (AWRObject object) = J.toJSON object + resolveActionMutation :: ( HasVersion , MonadReusability m @@ -113,16 +128,17 @@ resolveActionMutationSync field executionContext sessionVariables = do handlerPayload = ActionWebhookPayload actionContext sessionVariables inputArgs manager <- asks getter reqHeaders <- asks getter - webhookRes <- callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook handlerPayload + webhookRes <- callWebhook manager outputType reqHeaders confHeaders forwardClientHeaders resolvedWebhook handlerPayload let webhookResponseExpression = RS.AEInput $ UVSQL $ - toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB webhookRes + toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes selectAstUnresolved <- - processOutputSelectionSet webhookResponseExpression definitionList + processOutputSelectionSet webhookResponseExpression outputType definitionList (_fType field) $ _fSelSet field astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved - return $ asSingleRowJsonResp (RS.selectQuerySQL RS.JASSingleObject astResolved) [] + let jsonAggType = mkJsonAggSelect outputType + return $ asSingleRowJsonResp (RS.selectQuerySQL jsonAggType astResolved) [] where - SyncActionExecutionContext actionName definitionList resolvedWebhook confHeaders + SyncActionExecutionContext actionName outputType definitionList resolvedWebhook confHeaders forwardClientHeaders = executionContext {- Note: [Async action architecture] @@ -188,7 +204,7 @@ resolveAsyncActionQuery -> ActionSelectOpContext -> Field -> m GRS.AnnSimpleSelect -resolveAsyncActionQuery userInfo selectContext field = do +resolveAsyncActionQuery userInfo selectOpCtx field = do actionId <- withArg (_fArguments field) "id" parseActionId stringifyNumerics <- stringifyNum <$> asks getter @@ -198,9 +214,11 @@ resolveAsyncActionQuery userInfo selectContext field = do "output" -> do -- See Note [Resolving async action query/subscription] let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload" - definitionList = _asocDefinitionList selectContext - (RS.FComputedField . RS.CFSTable RS.JASSingleObject) -- The output of action is always a single object - <$> processOutputSelectionSet inputTableArgument definitionList (_fType fld) (_fSelSet fld) + ActionSelectOpContext outputType definitionList = selectOpCtx + jsonAggSelect = mkJsonAggSelect outputType + (RS.FComputedField . RS.CFSTable jsonAggSelect) + <$> processOutputSelectionSet inputTableArgument outputType + definitionList (_fType fld) (_fSelSet fld) -- The metadata columns "id" -> return $ mkAnnFldFromPGCol "id" PGUUID @@ -281,12 +299,14 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do let webhookUrl = _adHandler definition forwardClientHeaders = _adForwardClientHeaders definition confHeaders = _adHeaders definition + outputType = _adOutputType definition actionContext = ActionContext actionName - res <- runExceptT $ callWebhook httpManager reqHeaders confHeaders forwardClientHeaders webhookUrl $ - ActionWebhookPayload actionContext sessionVariables inputPayload - case res of + eitherRes <- runExceptT $ callWebhook httpManager outputType reqHeaders confHeaders + forwardClientHeaders webhookUrl $ + ActionWebhookPayload actionContext sessionVariables inputPayload + case eitherRes of Left e -> setError actionId e - Right responsePayload -> setCompleted actionId responsePayload + Right responsePayload -> setCompleted actionId $ J.toJSON responsePayload setError :: UUID.UUID -> QErr -> IO () setError actionId e = @@ -340,13 +360,14 @@ asyncActionsProcessor cacheRef pgPool httpManager = forever $ do callWebhook :: (HasVersion, MonadIO m, MonadError QErr m) => HTTP.Manager + -> GraphQLType -> [HTTP.Header] -> [HeaderConf] -> Bool -> ResolvedWebhook -> ActionWebhookPayload - -> m J.Value -callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook actionWebhookPayload = do + -> m ActionWebhookResponse +callWebhook manager outputType reqHeaders confHeaders forwardClientHeaders resolvedWebhook actionWebhookPayload = do resolvedConfHeaders <- makeHeadersFromConf confHeaders let clientHeaders = if forwardClientHeaders then mkClientHeadersForward reqHeaders else [] contentType = ("Content-Type", "application/json") @@ -362,14 +383,27 @@ callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook Left e -> throw500WithDetail "http exception when calling webhook" $ J.toJSON $ HttpException e + Right (Left (Wreq.JSONError e)) -> throw500WithDetail "not a valid json response from webhook" $ J.toJSON e + Right (Right responseWreq) -> do let responseValue = responseWreq ^. Wreq.responseBody responseStatus = responseWreq ^. Wreq.responseStatus - - if | HTTP.statusIsSuccessful responseStatus -> pure responseValue + webhookResponseObject = J.object ["webhook_response" J..= responseValue] + + if | HTTP.statusIsSuccessful responseStatus -> do + let expectingArray = isListType outputType + addInternalToErr e = e{qeInternal = Just webhookResponseObject} + throw400Detail t = throwError $ addInternalToErr $ err400 Unexpected t + webhookResponse <- modifyQErr addInternalToErr $ decodeValue responseValue + case webhookResponse of + AWRArray{} -> when (not expectingArray) $ + throw400Detail "expecting object for action webhook response but got array" + AWRObject{} -> when expectingArray $ + throw400Detail "expecting array for action webhook response but got object" + pure webhookResponse | HTTP.statusIsClientError responseStatus -> do ActionWebhookErrorResponse message maybeCode <- @@ -379,8 +413,7 @@ callWebhook manager reqHeaders confHeaders forwardClientHeaders resolvedWebhook throwError qErr | otherwise -> - throw500WithDetail "internal error" $ - J.object ["webhook_response" J..= responseValue] + throw500WithDetail "internal error" webhookResponseObject annInpValueToJson :: AnnInpVal -> J.Value annInpValueToJson annInpValue = @@ -392,6 +425,10 @@ annInpValueToJson annInpValue = AGObject _ objectM -> J.toJSON $ fmap (fmap annInpValueToJson) objectM AGArray _ valuesM -> J.toJSON $ fmap (fmap annInpValueToJson) valuesM +mkJsonAggSelect :: GraphQLType -> RS.JsonAggSelect +mkJsonAggSelect = + bool RS.JASSingleObject RS.JASMultipleRows . isListType + processOutputSelectionSet :: ( MonadReusability m , MonadError QErr m @@ -401,15 +438,21 @@ processOutputSelectionSet , Has SQLGenCtx r ) => RS.ArgumentExp UnresolvedVal + -> GraphQLType -> [(PGCol, PGScalarType)] -> G.NamedType -> SelSet -> m GRS.AnnSimpleSelect -processOutputSelectionSet tableRowInput definitionList fldTy flds = do +processOutputSelectionSet tableRowInput actionOutputType definitionList fldTy flds = do stringifyNumerics <- stringifyNum <$> asks getter annotatedFields <- processTableSelectionSet fldTy flds let annSel = RS.AnnSelG annotatedFields selectFrom RS.noTablePermissions RS.noTableArgs stringifyNumerics pure annSel where - jsonbToRecordFunction = QualifiedObject (SchemaName "pg_catalog") $ FunctionName "jsonb_to_record" + jsonbToPostgresRecordFunction = + QualifiedObject "pg_catalog" $ FunctionName $ + if isListType actionOutputType then + "jsonb_to_recordset" -- Multirow array response + else "jsonb_to_record" -- Single object response + functionArgs = RS.FunctionArgsExp [tableRowInput] mempty - selectFrom = RS.FromFunction jsonbToRecordFunction functionArgs $ Just definitionList + selectFrom = RS.FromFunction jsonbToPostgresRecordFunction functionArgs $ Just definitionList diff --git a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs index 63054ac7a0c61..9746692b138ed 100644 --- a/server/src-lib/Hasura/GraphQL/Resolve/Types.hs +++ b/server/src-lib/Hasura/GraphQL/Resolve/Types.hs @@ -19,6 +19,7 @@ import Hasura.RQL.Types.BoolExp import Hasura.RQL.Types.Column import Hasura.RQL.Types.Common import Hasura.RQL.Types.ComputedField +import Hasura.RQL.Types.CustomTypes import Hasura.RQL.Types.Function import Hasura.RQL.Types.Permission import Hasura.SQL.Types @@ -104,6 +105,7 @@ data DelOpCtx data SyncActionExecutionContext = SyncActionExecutionContext { _saecName :: !ActionName + , _saecOutputType :: !GraphQLType , _saecDefinitionList :: ![(PGCol, PGScalarType)] , _saecWebhook :: !ResolvedWebhook , _saecHeaders :: ![HeaderConf] @@ -117,7 +119,8 @@ data ActionExecutionContext data ActionSelectOpContext = ActionSelectOpContext - { _asocDefinitionList :: ![(PGCol, PGScalarType)] + { _asocOutputType :: !GraphQLType + , _asocDefinitionList :: ![(PGCol, PGScalarType)] } deriving (Show, Eq) -- (custom name | generated name) -> PG column info diff --git a/server/src-lib/Hasura/GraphQL/Schema/Action.hs b/server/src-lib/Hasura/GraphQL/Schema/Action.hs index 99d4da8101f41..536767287fe74 100644 --- a/server/src-lib/Hasura/GraphQL/Schema/Action.hs +++ b/server/src-lib/Hasura/GraphQL/Schema/Action.hs @@ -67,6 +67,7 @@ mkMutationField actionName actionInfo definitionList = case _adKind definition of ActionSynchronous -> ActionExecutionSyncWebhook $ SyncActionExecutionContext actionName + (_adOutputType definition) definitionList (_adHandler definition) (_adHeaders definition) @@ -101,7 +102,7 @@ mkQueryField mkQueryField actionName comment definition definitionList = case _adKind definition of ActionAsynchronous -> - Just ( ActionSelectOpContext definitionList + Just ( ActionSelectOpContext (_adOutputType definition) definitionList , mkHsraObjFldInfo (Just description) (unActionName actionName) (mapFromL _iviName [idArgument]) diff --git a/server/src-lib/Hasura/RQL/DDL/Action.hs b/server/src-lib/Hasura/RQL/DDL/Action.hs index 7ad4ffd295faf..bf6c4acac859d 100644 --- a/server/src-lib/Hasura/RQL/DDL/Action.hs +++ b/server/src-lib/Hasura/RQL/DDL/Action.hs @@ -95,9 +95,6 @@ resolveAction customTypes actionDefinition = do _ -> throw400 InvalidParams $ "the argument's base type: " <> showNamedTy argumentBaseType <> " should be a scalar/enum/input_object" - when (hasList responseType) $ throw400 InvalidParams $ - "the output type: " <> G.showGT responseType <> " cannot be a list" - -- Check if the response type is an object getObjectTypeInfo responseBaseType traverse resolveWebhook actionDefinition @@ -119,10 +116,6 @@ resolveAction customTypes actionDefinition = do <> showNamedTy typeName <> " is not an object type defined in custom types" - hasList = \case - G.TypeList _ _ -> True - G.TypeNamed _ _ -> False - runUpdateAction :: forall m. ( QErrM m , CacheRWM m, MonadTx m) => UpdateAction -> m EncJSON diff --git a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs index ae1193049985b..741b70cb27e8e 100644 --- a/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/DDL/CustomTypes.hs @@ -109,8 +109,8 @@ validateCustomTypeDefinitions tableCache customTypes = do scalarFields <- fmap (Map.fromList . catMaybes) $ for fields $ \objectField -> do - let fieldType = unGraphQLType $ _ofdType objectField - fieldBaseType = G.getBaseType fieldType + let fieldType = _ofdType objectField + fieldBaseType = G.getBaseType $ unGraphQLType fieldType fieldName = _ofdName objectField -- check that arguments are not defined @@ -161,11 +161,6 @@ validateCustomTypeDefinitions tableCache customTypes = do objectTypeName relationshipName remoteTable columnName return () -isListType :: G.GType -> Bool -isListType = \case - G.TypeList _ _ -> True - G.TypeNamed _ _ -> False - data CustomTypeValidationError = DuplicateTypeNames !(Set.HashSet G.NamedType) -- ^ type names have to be unique across all types diff --git a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs index 4669146062417..78dd74319dce2 100644 --- a/server/src-lib/Hasura/RQL/Types/CustomTypes.hs +++ b/server/src-lib/Hasura/RQL/Types/CustomTypes.hs @@ -2,6 +2,7 @@ module Hasura.RQL.Types.CustomTypes ( CustomTypes(..) , emptyCustomTypes , GraphQLType(..) + , isListType , EnumTypeName(..) , EnumValueDefinition(..) , EnumTypeDefinition(..) @@ -68,6 +69,12 @@ instance J.FromJSON GraphQLType where Left _ -> fail $ "not a valid GraphQL type: " <> T.unpack t Right a -> return $ GraphQLType a +isListType :: GraphQLType -> Bool +isListType (GraphQLType ty) = + case ty of + G.TypeList _ _ -> True + G.TypeNamed _ _ -> False + newtype InputObjectFieldName = InputObjectFieldName { unInputObjectFieldName :: G.Name } deriving (Show, Eq, Ord, Hashable, J.FromJSON, J.ToJSON, DQuote, Lift, Generic, NFData, Cacheable) From 20e23a1ccdacdb2439f5ad8c52e8560f94f07d34 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Wed, 12 Feb 2020 14:22:52 +0530 Subject: [PATCH 60/62] tests for list type response actions --- server/tests-py/context.py | 125 +++++++++++++----- .../actions/sync/create_user_success.yaml | 1 + .../actions/sync/create_users_fail.yaml | 17 +++ .../actions/sync/create_users_success.yaml | 29 ++++ .../sync/expecting_array_response.yaml | 61 +++++++++ .../sync/expecting_object_response.yaml | 62 +++++++++ .../sync/invalid_webhook_response.yaml | 62 +++++++++ .../sync/{setup.yaml => schema_setup.yaml} | 19 +++ .../{teardown.yaml => schema_teardown.yaml} | 4 + .../queries/actions/sync/values_teardown.yaml | 7 + server/tests-py/test_actions.py | 36 +++-- 11 files changed, 380 insertions(+), 43 deletions(-) create mode 100644 server/tests-py/queries/actions/sync/create_users_fail.yaml create mode 100644 server/tests-py/queries/actions/sync/create_users_success.yaml create mode 100644 server/tests-py/queries/actions/sync/expecting_array_response.yaml create mode 100644 server/tests-py/queries/actions/sync/expecting_object_response.yaml create mode 100644 server/tests-py/queries/actions/sync/invalid_webhook_response.yaml rename server/tests-py/queries/actions/sync/{setup.yaml => schema_setup.yaml} (67%) rename server/tests-py/queries/actions/sync/{teardown.yaml => schema_teardown.yaml} (75%) create mode 100644 server/tests-py/queries/actions/sync/values_teardown.yaml diff --git a/server/tests-py/context.py b/server/tests-py/context.py index ce785c0f08e99..6fbd9555f821b 100644 --- a/server/tests-py/context.py +++ b/server/tests-py/context.py @@ -169,61 +169,118 @@ def do_GET(self): def do_POST(self): content_len = self.headers.get('Content-Length') req_body = self.rfile.read(int(content_len)).decode("utf-8") - req_json = json.loads(req_body) + self.req_json = json.loads(req_body) req_headers = self.headers req_path = self.path - self.log_message(json.dumps(req_json)) + self.log_message(json.dumps(self.req_json)) + if req_path == "/create-user": - email_address = req_json['input']['email'] - name = req_json['input']['name'] - resp, status = self.create_user(email_address, name) - self.send_response(status) - self.send_header('Content-Type', 'application/json') - self.end_headers() - self.wfile.write(json.dumps(resp).encode("utf-8")) + resp, status = self.create_user() + self._send_response(status, resp) + + elif req_path == "/create-users": + resp, status = self.create_users() + self._send_response(status, resp) + + elif req_path == "/invalid-response": + self._send_response(HTTPStatus.OK, "some-string") + else: self.send_response(HTTPStatus.NO_CONTENT) self.end_headers() - def create_user(self, email_address, name): - if self.check_email(email_address): - gql_query = ''' - mutation ($email: String! $name: String!) { - insert_user_one(object: {email: $email, name: $name}){ - id - } + def create_user(self): + email_address = self.req_json['input']['email'] + name = self.req_json['input']['name'] + + if not self.check_email(email_address): + response = { + 'message': 'Given email address is not valid', + 'code': 'invalid-email' } - ''' - variables = { + return response, HTTPStatus.BAD_REQUEST + + gql_query = ''' + mutation ($email: String! $name: String!) { + insert_user_one(object: {email: $email, name: $name}){ + id + } + } + ''' + query = { + 'query': gql_query, + 'variables': { 'email': email_address, 'name': name } - query = { - 'query': gql_query, - 'variables': variables - } - headers = {} - admin_secret = self.hge_ctx.hge_key - if admin_secret is not None: - headers['X-Hasura-Admin-Secret'] = admin_secret - code, resp, resp_hdrs = self.hge_ctx.anyq('/v1/graphql', query, headers) - self.log_message(json.dumps(resp)) - user_id = resp['data']['insert_user_one']['id'] + } + code, resp = self.execute_query(query) + if code != 200 or 'data' not in resp: response = { - 'id': user_id + 'message': 'GraphQL query execution failed', + 'code': 'unexpected' } - return response, HTTPStatus.OK - else: + return response, HTTPStatus.BAD_REQUEST + + response = resp['data']['insert_user_one'] + return response, HTTPStatus.OK + + def create_users(self): + inputs = self.req_json['input']['users'] + for input in inputs: + email_address = input['email'] + if not self.check_email(email_address): + response = { + 'message': 'Email address is not valid: ' + email_address, + 'code': 'invalid-email' + } + return response, HTTPStatus.BAD_REQUEST + + gql_query = ''' + mutation ($insert_inputs: [user_insert_input!]!){ + insert_user(objects: $insert_inputs){ + returning{ + id + } + } + } + ''' + query = { + 'query': gql_query, + 'variables': { + 'insert_inputs': inputs + } + } + code, resp = self.execute_query(query) + if code != 200 or 'data' not in resp: response = { - 'message': 'Given email address is not valid', - 'code': 'invalid-email' + 'message': 'GraphQL query execution failed', + 'code': 'unexpected' } return response, HTTPStatus.BAD_REQUEST + response = resp['data']['insert_user']['returning'] + return response, HTTPStatus.OK + def check_email(self, email): regex = '^\w+([\.-]?\w+)*@\w+([\.-]?\w+)*(\.\w{2,3})+$' return re.search(regex,email) + def execute_query(self, query): + headers = {} + admin_secret = self.hge_ctx.hge_key + if admin_secret is not None: + headers['X-Hasura-Admin-Secret'] = admin_secret + code, resp, _ = self.hge_ctx.anyq('/v1/graphql', query, headers) + self.log_message(json.dumps(resp)) + return code, resp + + def _send_response(self, status, body): + self.send_response(status) + self.send_header('Content-Type', 'application/json') + self.end_headers() + self.wfile.write(json.dumps(body).encode("utf-8")) + class ActionsWebhookServer(http.server.HTTPServer): def __init__(self, hge_ctx, server_address): diff --git a/server/tests-py/queries/actions/sync/create_user_success.yaml b/server/tests-py/queries/actions/sync/create_user_success.yaml index f4687f68f2bd4..14446d458345c 100644 --- a/server/tests-py/queries/actions/sync/create_user_success.yaml +++ b/server/tests-py/queries/actions/sync/create_user_success.yaml @@ -13,6 +13,7 @@ query: } } } + response: data: create_user: diff --git a/server/tests-py/queries/actions/sync/create_users_fail.yaml b/server/tests-py/queries/actions/sync/create_users_fail.yaml new file mode 100644 index 0000000000000..d0b864f8aaa99 --- /dev/null +++ b/server/tests-py/queries/actions/sync/create_users_fail.yaml @@ -0,0 +1,17 @@ +description: Run create_users sync action mutation with invalid email +url: /v1/graphql +status: 200 +query: + query: | + mutation { + create_users(users: [{email: "blake@hasura.io", name: "Blake"}, {email: "random-email", name: "Elsa"}]){ + id + } + } + +response: + errors: + - extensions: + path: $ + code: invalid-email + message: 'Email address is not valid: random-email' diff --git a/server/tests-py/queries/actions/sync/create_users_success.yaml b/server/tests-py/queries/actions/sync/create_users_success.yaml new file mode 100644 index 0000000000000..20d5c62c58a3d --- /dev/null +++ b/server/tests-py/queries/actions/sync/create_users_success.yaml @@ -0,0 +1,29 @@ +description: Run create_users sync action mutation with valid emails +url: /v1/graphql +status: 200 +query: + query: | + mutation { + create_users(users: [{email: "blake@hasura.io", name: "Blake"}, {email: "elsa@hasura.io", name: "Elsa"}]){ + id + user { + name + email + is_admin + } + } + } + +response: + data: + create_users: + - id: 1 + user: + name: Blake + email: blake@hasura.io + is_admin: false + - id: 2 + user: + name: Elsa + email: elsa@hasura.io + is_admin: false diff --git a/server/tests-py/queries/actions/sync/expecting_array_response.yaml b/server/tests-py/queries/actions/sync/expecting_array_response.yaml new file mode 100644 index 0000000000000..6f595add7d427 --- /dev/null +++ b/server/tests-py/queries/actions/sync/expecting_array_response.yaml @@ -0,0 +1,61 @@ +- description: Update actions webhook to another route which retuns object response + url: /v1/query + status: 200 + response: + message: success + query: + type: update_action + args: + name: create_users + definition: + kind: synchronous + arguments: + - name: email + type: String! + - name: name + type: String! + output_type: '[UserId]' + handler: http://127.0.0.1:5593/create-user + +- description: Run create_users action + url: /v1/graphql + status: 200 + query: + query: | + mutation { + create_users(email: "clarke@gmail.com", name: "Clarke"){ + id + user { + name + email + is_admin + } + } + } + + response: + errors: + - extensions: + internal: + webhook_response: + id: 1 + path: $ + code: unexpected + message: expecting array for action webhook response but got object + +- description: Revert action definition + url: /v1/query + status: 200 + response: + message: success + query: + type: update_action + args: + name: create_users + definition: + kind: synchronous + arguments: + - name: users + type: '[UserInput!]!' + output_type: '[UserId]' + handler: http://127.0.0.1:5593/create-users diff --git a/server/tests-py/queries/actions/sync/expecting_object_response.yaml b/server/tests-py/queries/actions/sync/expecting_object_response.yaml new file mode 100644 index 0000000000000..87883b0894b1e --- /dev/null +++ b/server/tests-py/queries/actions/sync/expecting_object_response.yaml @@ -0,0 +1,62 @@ +- description: Update actions webhook to another route which retuns array response + url: /v1/query + status: 200 + response: + message: success + query: + type: update_action + args: + name: create_user + definition: + kind: synchronous + arguments: + - name: users + type: '[UserInput!]!' + output_type: UserId + handler: http://127.0.0.1:5593/create-users + +- description: Run create_users sync action + url: /v1/graphql + status: 200 + query: + query: | + mutation { + create_user(users: [{email: "blake@hasura.io", name: "Blake"}, {email: "elsa@hasura.io", name: "Elsa"}]){ + id + user { + name + email + is_admin + } + } + } + + response: + errors: + - extensions: + internal: + webhook_response: + - id: 1 + - id: 2 + path: $ + code: unexpected + message: expecting object for action webhook response but got array + +- description: Revert action definition + url: /v1/query + status: 200 + response: + message: success + query: + type: update_action + args: + name: create_user + definition: + kind: synchronous + arguments: + - name: email + type: String! + - name: name + type: String! + output_type: UserId + handler: http://127.0.0.1:5593/create-user diff --git a/server/tests-py/queries/actions/sync/invalid_webhook_response.yaml b/server/tests-py/queries/actions/sync/invalid_webhook_response.yaml new file mode 100644 index 0000000000000..016eb22454b72 --- /dev/null +++ b/server/tests-py/queries/actions/sync/invalid_webhook_response.yaml @@ -0,0 +1,62 @@ +- description: Update actions webhook to another route which retuns non-object/array response + url: /v1/query + status: 200 + response: + message: success + query: + type: update_action + args: + name: create_user + definition: + kind: synchronous + arguments: + - name: email + type: String! + - name: name + type: String! + output_type: UserId + handler: http://127.0.0.1:5593/invalid-response + +- description: Run create_user sync action + url: /v1/graphql + status: 200 + query: + query: | + mutation { + create_user(email: "clarke@gmail.com", name: "Clarke"){ + id + user { + name + email + is_admin + } + } + } + + response: + errors: + - extensions: + internal: + webhook_response: some-string + path: $ + code: parse-failed + message: expecting object or array of objects for action webhook response + +- description: Revert action wehbook + url: /v1/query + status: 200 + response: + message: success + query: + type: update_action + args: + name: create_user + definition: + kind: synchronous + arguments: + - name: email + type: String! + - name: name + type: String! + output_type: UserId + handler: http://127.0.0.1:5593/create-user diff --git a/server/tests-py/queries/actions/sync/setup.yaml b/server/tests-py/queries/actions/sync/schema_setup.yaml similarity index 67% rename from server/tests-py/queries/actions/sync/setup.yaml rename to server/tests-py/queries/actions/sync/schema_setup.yaml index 21be07e31b4c5..383584410891e 100644 --- a/server/tests-py/queries/actions/sync/setup.yaml +++ b/server/tests-py/queries/actions/sync/schema_setup.yaml @@ -17,6 +17,14 @@ args: - type: set_custom_types args: + input_objects: + - name: UserInput + fields: + - name: name + type: String! + - name: email + type: String! + objects: - name: UserId fields: @@ -41,3 +49,14 @@ args: type: String! output_type: UserId handler: http://127.0.0.1:5593/create-user + +- type: create_action + args: + name: create_users + definition: + kind: synchronous + arguments: + - name: users + type: '[UserInput!]!' + output_type: '[UserId]' + handler: http://127.0.0.1:5593/create-users diff --git a/server/tests-py/queries/actions/sync/teardown.yaml b/server/tests-py/queries/actions/sync/schema_teardown.yaml similarity index 75% rename from server/tests-py/queries/actions/sync/teardown.yaml rename to server/tests-py/queries/actions/sync/schema_teardown.yaml index 5b4bfc6d4a39a..8ed87dd5442ee 100644 --- a/server/tests-py/queries/actions/sync/teardown.yaml +++ b/server/tests-py/queries/actions/sync/schema_teardown.yaml @@ -4,6 +4,10 @@ args: args: name: create_user clear_data: true +- type: drop_action + args: + name: create_users + clear_data: true # clear custom types - type: set_custom_types args: {} diff --git a/server/tests-py/queries/actions/sync/values_teardown.yaml b/server/tests-py/queries/actions/sync/values_teardown.yaml new file mode 100644 index 0000000000000..f5acee6da0db4 --- /dev/null +++ b/server/tests-py/queries/actions/sync/values_teardown.yaml @@ -0,0 +1,7 @@ +type: bulk +args: +- type: run_sql + args: + sql: | + DELETE FROM "user"; + SELECT setval('user_id_seq', 1, FALSE); diff --git a/server/tests-py/test_actions.py b/server/tests-py/test_actions.py index 3ddfff0454f19..3aa8634fcd840 100644 --- a/server/tests-py/test_actions.py +++ b/server/tests-py/test_actions.py @@ -4,24 +4,42 @@ import time from validate import check_query_f, check_query -from super_classes import DefaultTestQueries +from super_classes import DefaultTestQueries, DefaultTestMutations """ TODO:- Test Actions metadata """ -class TestActionsSync(DefaultTestQueries): +@pytest.mark.usefixtures("actions_webhook") +@pytest.mark.parametrize("transport", ['http', 'websocket']) +class TestActionsSync(DefaultTestMutations): @classmethod def dir(cls): return 'queries/actions/sync' - def test_create_user_fail(self, hge_ctx, actions_webhook): - check_query_f(hge_ctx, self.dir() + '/create_user_fail.yaml') + def test_create_user_fail(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + '/create_user_fail.yaml', transport) - def test_create_user_success(self, hge_ctx, actions_webhook): - check_query_f(hge_ctx, self.dir() + '/create_user_success.yaml') + def test_create_user_success(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + '/create_user_success.yaml', transport) + def test_create_users_fail(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + '/create_users_fail.yaml', transport) + + def test_create_users_success(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + '/create_users_success.yaml', transport) + + def test_invalid_webhook_response(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + '/invalid_webhook_response.yaml') + + def test_expecting_object_response(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + '/expecting_object_response.yaml') + + def test_expecting_array_response(self, hge_ctx, transport): + check_query_f(hge_ctx, self.dir() + '/expecting_array_response.yaml') + +@pytest.mark.usefixtures("actions_webhook") class TestActionsAsync(DefaultTestQueries): @classmethod def dir(cls): @@ -34,7 +52,7 @@ def mk_headers_with_secret(self, hge_ctx, headers={}): return headers - def test_create_user_fail(self, hge_ctx, actions_webhook): + def test_create_user_fail(self, hge_ctx): graphql_mutation = ''' mutation { create_user(email: "random-email", name: "Clarke") @@ -85,7 +103,7 @@ def test_create_user_fail(self, hge_ctx, actions_webhook): } check_query(hge_ctx, conf) - def test_create_user_success(self, hge_ctx, actions_webhook): + def test_create_user_success(self, hge_ctx): graphql_mutation = ''' mutation { create_user(email: "clarke@hasura.io", name: "Clarke") @@ -146,7 +164,7 @@ def test_create_user_success(self, hge_ctx, actions_webhook): } check_query(hge_ctx, conf) - def test_create_user_roles(self, hge_ctx, actions_webhook): + def test_create_user_roles(self, hge_ctx): graphql_mutation = ''' mutation { create_user(email: "blake@hasura.io", name: "Blake") From e32545ed8fe8f0e9ef7204d2a433ed1745b88a09 Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 13 Feb 2020 12:03:44 +0530 Subject: [PATCH 61/62] update docs with actions and custom types metadata API reference --- .../schema-metadata-api/actions.rst | 333 ++++++++++++++++++ .../schema-metadata-api/custom-types.rst | 309 ++++++++++++++++ .../schema-metadata-api/event-triggers.rst | 50 +-- .../schema-metadata-api/index.rst | 34 ++ .../schema-metadata-api/syntax-defs.rst | 94 +++++ 5 files changed, 773 insertions(+), 47 deletions(-) create mode 100644 docs/graphql/manual/api-reference/schema-metadata-api/actions.rst create mode 100644 docs/graphql/manual/api-reference/schema-metadata-api/custom-types.rst diff --git a/docs/graphql/manual/api-reference/schema-metadata-api/actions.rst b/docs/graphql/manual/api-reference/schema-metadata-api/actions.rst new file mode 100644 index 0000000000000..33f52c61febaf --- /dev/null +++ b/docs/graphql/manual/api-reference/schema-metadata-api/actions.rst @@ -0,0 +1,333 @@ +.. meta:: + :description: Manage actions with the Hasura schema/metadata API + :keywords: hasura, docs, schema/metadata API, API reference, actions + +Schema/Metadata API Reference: Actions +====================================== + +.. contents:: Table of contents + :backlinks: none + :depth: 1 + :local: + +**actions** are user defined mutations with custom business logic. + +.. _create_action: + +create_action +------------- + +``create_action`` is used to define an action. There shouldn't be an existing action with the same name. + +Create a synchronous action with name ``create_user``: + +.. code-block:: http + + POST /v1/query HTTP/1.1 + Content-Type: application/json + X-Hasura-Role: admin + + { + "type":"create_action", + "args":{ + "name":"create_user", + "definition":{ + "kind":"synchronous", + "arguments":[ + { + "name":"username", + "type":"String!" + }, + { + "name":"email", + "type":"String!" + } + ], + "output_type":"User", + "handler":"https://action.my_app.com/create-user" + }, + "comment": "Custom action to create user" + } + } + + +.. _create_action_syntax: + +Args syntax +^^^^^^^^^^^ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`ActionName ` + - Name of the action + * - definition + - true + - ActionDefinition_ + - Definition of the action + * - comment + - false + - text + - comment + +.. _ActionDefinition: + +ActionDefinition +&&&&&&&&&&&&&&&& + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - arguments + - true + - Array of InputArgument_ + - Input arguments + * - output_type + - true + - :ref:`GraphQLType ` + - The output type of the action. Only object and list of objects are allowed. + * - kind + - false + - [ ``synchronous`` | ``asynchronous`` ] + - The kind of the action (default: ``synchronous``) + * - headers + - false + - [ :ref:`HeaderFromValue ` | :ref:`HeaderFromEnv ` ] + - List of defined headers to be sent to the handler + * - forward_client_headers + - false + - boolean + - If set to ``true`` the client headers are forwarded to the webhook handler (default: ``false``) + * - handler + - true + - :ref:`WebhookURL ` + - The action's webhook URL + +.. _InputArgument: + +InputArgument +&&&&&&&&&&&&& + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - text + - Name of the argument + * - type + - true + - :ref:`GraphQLType ` + - Type of the argument + +.. note:: + + The ``GraphQL Types`` used in creating an action must be defined before via :doc:`Custom Types ` + +.. _drop_action: + +drop_action +----------- + +``drop_action`` is used to remove an action. Permissions defined on the actions are also dropped automatically. + +Drop an action ``create_user``: + +.. code-block:: http + + POST /v1/query HTTP/1.1 + Content-Type: application/json + X-Hasura-Role: admin + + { + "type":"drop_action", + "args":{ + "name":"create_user", + "clear_data": true + } + } + +.. _drop_action_syntax: + +Args syntax +^^^^^^^^^^^ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`ActionName ` + - Name of the action + * - clear_data + - false + - boolean + - If set to ``true`` and action kind is ``asynchronous``, related data is deleted from catalog. (default: ``true``) + +.. _update_action: + +update_action +------------- + +``update_action`` is used to update the definition of the action. Definition thus provided is +replaced with existing one. + +Update an action ``create_user`` by making it's kind to ``asynchronous``: + +.. code-block:: http + + POST /v1/query HTTP/1.1 + Content-Type: application/json + X-Hasura-Role: admin + + { + "type":"update_action", + "args":{ + "name":"create_user", + "definition":{ + "kind":"asynchronous", + "arguments":[ + { + "name":"username", + "type":"String!" + }, + { + "name":"email", + "type":"String!" + } + ], + "output_type":"User", + "handler":"https://action.my_app.com/create-user" + } + } + } + + +.. _update_action_syntax: + +Args syntax +^^^^^^^^^^^ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`ActionName ` + - Name of the action + * - definition + - true + - ActionDefinition_ + - Definition of the action to be replaced + +.. _create_action_permission: + +create_action_permission +------------------------ + +``create_action_permission`` is used to define a permission to make action visible for a role. + +.. code-block:: http + + POST /v1/query HTTP/1.1 + Content-Type: application/json + X-Hasura-Role: admin + + { + "type": "create_action_permission", + "args": { + "action": "create_user", + "role": "user" + } + } + } + +.. _create_action_permission_syntax: + +Args syntax +^^^^^^^^^^^ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`ActionName ` + - Name of the action + * - role + - true + - :ref:`RoleName ` + - Name of the role + * - comment + - false + - text + - comment + +.. _drop_action_permission: + +drop_action_permission +---------------------- + +``drop_action_permission`` is used to drop a permission defined on an action. + +.. code-block:: http + + POST /v1/query HTTP/1.1 + Content-Type: application/json + X-Hasura-Role: admin + + { + "type": "drop_action_permission", + "args": { + "action": "create_user", + "role": "user" + } + } + } + +.. _drop_action_permission_syntax: + +Args syntax +^^^^^^^^^^^ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`ActionName ` + - Name of the action + * - role + - true + - :ref:`RoleName ` + - Name of the role diff --git a/docs/graphql/manual/api-reference/schema-metadata-api/custom-types.rst b/docs/graphql/manual/api-reference/schema-metadata-api/custom-types.rst new file mode 100644 index 0000000000000..a0e2926cdba93 --- /dev/null +++ b/docs/graphql/manual/api-reference/schema-metadata-api/custom-types.rst @@ -0,0 +1,309 @@ +.. meta:: + :description: Define custom types with the Hasura schema/metadata API + :keywords: hasura, docs, schema/metadata API, API reference, custom types + +Schema/Metadata API Reference: Custom Types +=========================================== + +**Custom Types** are user-defined GraphQL types which help to define :doc:`Actions `. + +.. _set_custom_types: + +set_custom_types +---------------- + +``set_custom_types`` is used to set user-defined GraphQL types. This API will replace the given types with existing ones. + + +.. code-block:: http + + POST /v1/query HTTP/1.1 + Content-Type: application/json + X-Hasura-Role: admin + + { + "type": "set_custom_types", + "args": { + "scalars": [], + "enums": [], + "input_objects": [ + { + "name": "User", + "fields": [ + { + "name": "username", + "type": "String!" + }, + { + "name": "password", + "type": "String!" + } + ] + } + ], + "objects": [ + { + "name": "UserId", + "fields": [ + { + "name": "id", + "type": "Int!" + } + ], + "relationships": [ + { + "name": "posts", + "type": "array", + "remote_table": "post", + "field_mapping": { + "id": "user_id" + } + } + ] + } + ] + } + } + + +.. _set_custom_types_syntax: + +Args syntax +^^^^^^^^^^^ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - input_objects + - false + - Array of InputObjectType_ + - Set of GraphQL ``Input Object`` + * - objects + - false + - Array of ObjectType_ + - Set of GraphQL ``Object`` + * - scalars + - false + - Array of ScalarType_ + - Set of GraphQL ``Scalar`` + * - enums + - false + - Array of EnumType_ + - Set of GraphQL ``Enum`` + +.. _InputObjectType: + +InputObjectType +&&&&&&&&&&&&&&& + +A simple JSON object to define `GraphQL Input Object `__ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`GraphQLName` + - Name of the Input object type + * - description + - false + - String + - Description of the Input object type + * - fields + - true + - Array of InputObjectField_ + - Fields of the Input object type + +.. _InputObjectField: + +InputObjectField +**************** + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`GraphQLName` + - Name of the Input object field + * - description + - false + - String + - Description of the Input object field + * - type + - true + - :ref:`GraphQLType ` + - GraphQL ype of the input object field + + +.. _ObjectType: + +ObjectType +&&&&&&&&&& + +A simple JSON object to define `GraphQL Object `__ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`GraphQLName` + - Name of the Object type + * - description + - false + - String + - Description of the Object type + * - fields + - true + - Array of ObjectField_ + - Fields of the Object type + * - relationships + - false + - Array of ObjectRelationship_ + - Relationships of the Object type to tables + +.. _ObjectField: + +ObjectField +*********** + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`GraphQLName` + - Name of the Input object field + * - description + - false + - String + - Description of the Input object field + * - type + - true + - :ref:`GraphQLType ` + - GraphQL type of the input object field + +.. _ObjectRelationship: + +ObjectRelationship +****************** + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`RelationshipName` + - Name of the relationship, shouldn't conflict with existing field names + * - type + - true + - [ ``object`` | ``array`` ] + - Type of the relationship + * - remote_table + - true + - :ref:`TableName` + - The table to which relationship is defined + * - field_mapping + - true + - Object (ObjectField_ name : Remote table's :ref:`PGColumn`) + - Mapping of fields of object type to columns of remote table + +.. _ScalarType: + +ScalarType +&&&&&&&&&& + +A simple JSON object to define `GraphQL Scalar `__ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`GraphQLName` + - Name of the Scalar type + * - description + - false + - String + - Description of the Scalar type + +.. _EnumType: + +EnumType +&&&&&&&& + +A simple JSON object to define `GraphQL Enum `__ + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - name + - true + - :ref:`GraphQLName` + - Name of the Enum type + * - description + - false + - String + - Description of the Enum type + * - values + - true + - Array of EnumValue_ + - Values of the Enum type + +.. _EnumValue: + +EnumValue +********* + +.. list-table:: + :header-rows: 1 + + * - Key + - Required + - Schema + - Description + * - value + - true + - :ref:`GraphQLName` + - Value of the Enum type + * - description + - false + - String + - Description of the value + * - is_deprecated + - false + - Boolean + - If set to ``true``, the enum value is marked as deprecated diff --git a/docs/graphql/manual/api-reference/schema-metadata-api/event-triggers.rst b/docs/graphql/manual/api-reference/schema-metadata-api/event-triggers.rst index 64c1166ce511f..daee82eea80f7 100644 --- a/docs/graphql/manual/api-reference/schema-metadata-api/event-triggers.rst +++ b/docs/graphql/manual/api-reference/schema-metadata-api/event-triggers.rst @@ -2,7 +2,7 @@ :description: Manage event triggers with the Hasura schema/metadata API :keywords: hasura, docs, schema/metadata API, API reference, event trigger -Schema/Metadata API Reference: Event Triggers +Schema/Metadata API Reference: Event Triggers ============================================= .. contents:: Table of contents @@ -94,7 +94,7 @@ Args syntax - Specification for delete operation * - headers - false - - [ HeaderFromValue_ | HeaderFromEnv_ ] + - [ :ref:`HeaderFromValue ` | :ref:`HeaderFromEnv ` ] - List of headers to be sent with the webhook * - replace - false @@ -179,7 +179,7 @@ Args syntax - true - JSON - Some JSON payload to send to trigger - + .. _TriggerName: TriggerName @@ -210,48 +210,6 @@ OperationSpec - EventTriggerColumns_ - List of columns or "*" to send as part of webhook payload -.. _HeaderFromValue: - -HeaderFromValue -&&&&&&&&&&&&&&& - -.. list-table:: - :header-rows: 1 - - * - Key - - required - - Schema - - Description - * - name - - true - - String - - Name of the header - * - value - - true - - String - - Value of the header - -.. _HeaderFromEnv: - -HeaderFromEnv -&&&&&&&&&&&&& - -.. list-table:: - :header-rows: 1 - - * - Key - - required - - Schema - - Description - * - name - - true - - String - - Name of the header - * - value_from_env - - true - - String - - Name of the environment variable which holds the value of the header - .. _EventTriggerColumns: EventTriggerColumns @@ -261,5 +219,3 @@ EventTriggerColumns :class: haskell-pre "*" | [:ref:`PGColumn`] - - diff --git a/docs/graphql/manual/api-reference/schema-metadata-api/index.rst b/docs/graphql/manual/api-reference/schema-metadata-api/index.rst index 29be947141bb4..ce30129cb5a3c 100644 --- a/docs/graphql/manual/api-reference/schema-metadata-api/index.rst +++ b/docs/graphql/manual/api-reference/schema-metadata-api/index.rst @@ -296,6 +296,36 @@ The various types of queries are listed in the following table: - 1 - Drop a collection from the allow-list + * - :ref:`set_custom_types` + - :ref:`set_custom_types_args ` + - 1 + - Set custom GraphQL types + + * - :ref:`create_action` + - :ref:`create_action_args ` + - 1 + - Create an action + + * - :ref:`drop_action` + - :ref:`drop_action_args ` + - 1 + - Drop an action + + * - :ref:`update_action` + - :ref:`update_action_args ` + - 1 + - Update an action + + * - :ref:`create_action_permission` + - :ref:`create_action_permission_args ` + - 1 + - Create an action permission + + * - :ref:`drop_action_permission` + - :ref:`drop_action_permission_args ` + - 1 + - Drop an action permission + **See:** - :doc:`Run SQL ` @@ -307,6 +337,8 @@ The various types of queries are listed in the following table: - :doc:`Event Triggers ` - :doc:`Remote Schemas ` - :doc:`Query Collections ` +- :doc:`Custom Types ` +- :doc:`Actions ` - :doc:`Manage Metadata ` Response structure @@ -391,5 +423,7 @@ See :doc:`../../deployment/graphql-engine-flags/reference` for info on setting t Event Triggers Remote Schemas Query Collections + Custom Types + Actions Manage Metadata Common syntax definitions diff --git a/docs/graphql/manual/api-reference/schema-metadata-api/syntax-defs.rst b/docs/graphql/manual/api-reference/schema-metadata-api/syntax-defs.rst index 13e0dd91e96ab..26ffc5f646dc8 100644 --- a/docs/graphql/manual/api-reference/schema-metadata-api/syntax-defs.rst +++ b/docs/graphql/manual/api-reference/schema-metadata-api/syntax-defs.rst @@ -507,3 +507,97 @@ A JSONObject_ of Postgres column name to GraphQL name mapping "column2" : String, .. } + +.. _ActionName: + +ActionName +^^^^^^^^^^ + +.. parsed-literal:: + :class: haskell-pre + + String + + +.. _WebhookURL: + +WebhookURL +^^^^^^^^^^ + +A String value which supports templating environment variables enclosed in ``{{`` and ``}}``. + +.. parsed-literal:: + :class: haskell-pre + + String + +Template example: ``https://{{ACTION_API_DOMAIN}}/create-user`` + +.. _HeaderFromValue: + +HeaderFromValue +^^^^^^^^^^^^^^^ + +.. list-table:: + :header-rows: 1 + + * - Key + - required + - Schema + - Description + * - name + - true + - String + - Name of the header + * - value + - true + - String + - Value of the header + +.. _HeaderFromEnv: + + +HeaderFromEnv +^^^^^^^^^^^^^ + +.. list-table:: + :header-rows: 1 + + * - Key + - required + - Schema + - Description + * - name + - true + - String + - Name of the header + * - value_from_env + - true + - String + - Name of the environment variable which holds the value of the header + +.. _GraphQLType: + +GraphQLType +^^^^^^^^^^^ + +A GraphQL `Type Reference `__ string. + +.. parsed-literal:: + :class: haskell-pre + + String + +Example: ``String!`` for non-nullable String type and ``[String]`` for array of String types + +.. _GraphQLName: + +GraphQLName +^^^^^^^^^^^ + +A string literal that conform to `GraphQL spec `__. + +.. parsed-literal:: + :class: haskell-pre + + String From 12dc26e489c593f15cb996271941e554b086a85e Mon Sep 17 00:00:00 2001 From: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Date: Thu, 13 Feb 2020 15:14:59 +0530 Subject: [PATCH 62/62] update actions python tests as per #f8e1330 --- .../async/{setup.yaml => schema_setup.yaml} | 0 .../async/{teardown.yaml => schema_teardown.yaml} | 0 .../queries/actions/async/values_teardown.yaml | 7 +++++++ server/tests-py/test_actions.py | 15 ++++++++++----- 4 files changed, 17 insertions(+), 5 deletions(-) rename server/tests-py/queries/actions/async/{setup.yaml => schema_setup.yaml} (100%) rename server/tests-py/queries/actions/async/{teardown.yaml => schema_teardown.yaml} (100%) create mode 100644 server/tests-py/queries/actions/async/values_teardown.yaml diff --git a/server/tests-py/queries/actions/async/setup.yaml b/server/tests-py/queries/actions/async/schema_setup.yaml similarity index 100% rename from server/tests-py/queries/actions/async/setup.yaml rename to server/tests-py/queries/actions/async/schema_setup.yaml diff --git a/server/tests-py/queries/actions/async/teardown.yaml b/server/tests-py/queries/actions/async/schema_teardown.yaml similarity index 100% rename from server/tests-py/queries/actions/async/teardown.yaml rename to server/tests-py/queries/actions/async/schema_teardown.yaml diff --git a/server/tests-py/queries/actions/async/values_teardown.yaml b/server/tests-py/queries/actions/async/values_teardown.yaml new file mode 100644 index 0000000000000..f5acee6da0db4 --- /dev/null +++ b/server/tests-py/queries/actions/async/values_teardown.yaml @@ -0,0 +1,7 @@ +type: bulk +args: +- type: run_sql + args: + sql: | + DELETE FROM "user"; + SELECT setval('user_id_seq', 1, FALSE); diff --git a/server/tests-py/test_actions.py b/server/tests-py/test_actions.py index 3aa8634fcd840..82ddfea802526 100644 --- a/server/tests-py/test_actions.py +++ b/server/tests-py/test_actions.py @@ -4,15 +4,20 @@ import time from validate import check_query_f, check_query -from super_classes import DefaultTestQueries, DefaultTestMutations """ TODO:- Test Actions metadata """ -@pytest.mark.usefixtures("actions_webhook") +use_action_fixtures = pytest.mark.usefixtures( + "actions_webhook", + 'per_class_db_schema_for_mutation_tests', + 'per_method_db_data_for_mutation_tests' +) + @pytest.mark.parametrize("transport", ['http', 'websocket']) -class TestActionsSync(DefaultTestMutations): +@use_action_fixtures +class TestActionsSync: @classmethod def dir(cls): @@ -39,8 +44,8 @@ def test_expecting_object_response(self, hge_ctx, transport): def test_expecting_array_response(self, hge_ctx, transport): check_query_f(hge_ctx, self.dir() + '/expecting_array_response.yaml') -@pytest.mark.usefixtures("actions_webhook") -class TestActionsAsync(DefaultTestQueries): +@use_action_fixtures +class TestActionsAsync: @classmethod def dir(cls): return 'queries/actions/async'