mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-15 01:12:56 +03:00
[skip ci] add relay modern support (#4458)
* validation support for unions and interfaces * refactor SQL generation logic for improved readability * '/v1/relay' endpoint for relay schema * implement 'Node' interface and top level 'node' field resolver * add relay toggle on graphiql * fix explain api response & index plan id with query type * add hasura mutations to relay * add relay pytests * update CHANGELOG.md Co-authored-by: rakeshkky <12475069+rakeshkky@users.noreply.github.com> Co-authored-by: Rishichandra Wawhal <rishi@hasura.io> Co-authored-by: Rikin Kachhia <54616969+rikinsk@users.noreply.github.com>
This commit is contained in:
parent
62936ccd33
commit
ab65b39cd8
@ -2,7 +2,6 @@
|
|||||||
|
|
||||||
## Next release
|
## Next release
|
||||||
|
|
||||||
|
|
||||||
### Bug fixes and improvements
|
### Bug fixes and improvements
|
||||||
|
|
||||||
(Add entries here in the order of: server, console, cli, docs, others)
|
(Add entries here in the order of: server, console, cli, docs, others)
|
||||||
@ -97,7 +96,7 @@ Read more about the session argument for computed fields in the [docs](https://h
|
|||||||
A new `seeds` command is introduced in CLI, this will allow managing seed migrations as SQL files
|
A new `seeds` command is introduced in CLI, this will allow managing seed migrations as SQL files
|
||||||
|
|
||||||
#### Creating seed
|
#### Creating seed
|
||||||
```
|
```
|
||||||
# create a new seed file and use editor to add SQL content
|
# create a new seed file and use editor to add SQL content
|
||||||
hasura seed create new_table_seed
|
hasura seed create new_table_seed
|
||||||
|
|
||||||
|
@ -2,7 +2,6 @@ import React from 'react';
|
|||||||
import OverlayTrigger from 'react-bootstrap/lib/OverlayTrigger';
|
import OverlayTrigger from 'react-bootstrap/lib/OverlayTrigger';
|
||||||
import Tooltip from 'react-bootstrap/lib/Tooltip';
|
import Tooltip from 'react-bootstrap/lib/Tooltip';
|
||||||
import styles from './Tooltip.scss';
|
import styles from './Tooltip.scss';
|
||||||
|
|
||||||
const tooltipGen = (message: string) => {
|
const tooltipGen = (message: string) => {
|
||||||
return <Tooltip id={message}>{message}</Tooltip>;
|
return <Tooltip id={message}>{message}</Tooltip>;
|
||||||
};
|
};
|
||||||
@ -28,5 +27,4 @@ const ToolTip: React.FC<TooltipProps> = ({
|
|||||||
)}
|
)}
|
||||||
</OverlayTrigger>
|
</OverlayTrigger>
|
||||||
);
|
);
|
||||||
|
export default ToolTip;
|
||||||
export default ToolTip;
|
|
@ -233,6 +233,7 @@ library
|
|||||||
, ghc-heap-view
|
, ghc-heap-view
|
||||||
|
|
||||||
, directory
|
, directory
|
||||||
|
, semigroups >= 0.19.1
|
||||||
|
|
||||||
exposed-modules: Control.Arrow.Extended
|
exposed-modules: Control.Arrow.Extended
|
||||||
, Control.Arrow.Trans
|
, Control.Arrow.Trans
|
||||||
|
@ -1,25 +1,25 @@
|
|||||||
module Data.HashMap.Strict.InsOrd.Extended
|
module Data.HashMap.Strict.InsOrd.Extended
|
||||||
( OMap.elems
|
( module OMap
|
||||||
, groupTuples
|
, groupTuples
|
||||||
, groupListWith
|
, groupListWith
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
import Data.HashMap.Strict.InsOrd as OMap
|
||||||
|
import qualified Data.List as L
|
||||||
import qualified Data.Sequence.NonEmpty as NE
|
import qualified Data.Sequence.NonEmpty as NE
|
||||||
|
|
||||||
import Data.Hashable (Hashable)
|
import Data.Hashable (Hashable)
|
||||||
import Data.List (foldl')
|
|
||||||
|
|
||||||
import Prelude (Eq, Foldable, Functor, fmap, ($))
|
import Prelude (Eq, Foldable, Functor, fmap, undefined, ($))
|
||||||
|
|
||||||
groupTuples
|
groupTuples
|
||||||
:: (Eq k, Hashable k, Foldable t)
|
:: (Eq k, Hashable k, Foldable t)
|
||||||
=> t (k, v) -> OMap.InsOrdHashMap k (NE.NESeq v)
|
=> t (k, v) -> OMap.InsOrdHashMap k (NE.NESeq v)
|
||||||
groupTuples =
|
groupTuples =
|
||||||
foldl' groupFlds OMap.empty
|
L.foldl' groupFlds OMap.empty
|
||||||
where
|
where
|
||||||
groupFlds m (k, v) =
|
groupFlds m (k, v) =
|
||||||
OMap.insertWith (\_ c -> c NE.|> v) k (NE.singleton v) m
|
OMap.insertWith (\_ c -> c `undefined` v) k (NE.singleton v) m
|
||||||
|
|
||||||
groupListWith
|
groupListWith
|
||||||
:: (Eq k, Hashable k, Foldable t, Functor t)
|
:: (Eq k, Hashable k, Foldable t, Functor t)
|
||||||
|
@ -5,8 +5,6 @@ module Data.Sequence.NonEmpty
|
|||||||
( NESeq
|
( NESeq
|
||||||
, pattern (:<||)
|
, pattern (:<||)
|
||||||
, pattern (:||>)
|
, pattern (:||>)
|
||||||
, (<|)
|
|
||||||
, (|>)
|
|
||||||
, singleton
|
, singleton
|
||||||
, head
|
, head
|
||||||
, tail
|
, tail
|
||||||
@ -22,9 +20,6 @@ import Data.Aeson
|
|||||||
import Data.Foldable
|
import Data.Foldable
|
||||||
import GHC.Generics (Generic)
|
import GHC.Generics (Generic)
|
||||||
|
|
||||||
infixr 5 <|
|
|
||||||
infixl 5 |>
|
|
||||||
|
|
||||||
data NESeq a = NESeq
|
data NESeq a = NESeq
|
||||||
{ head :: a
|
{ head :: a
|
||||||
, tail :: Seq.Seq a
|
, tail :: Seq.Seq a
|
||||||
@ -59,12 +54,6 @@ instance ToJSON a => ToJSON (NESeq a) where
|
|||||||
singleton :: a -> NESeq a
|
singleton :: a -> NESeq a
|
||||||
singleton a = NESeq a Seq.empty
|
singleton a = NESeq a Seq.empty
|
||||||
|
|
||||||
(|>) :: NESeq a -> a -> NESeq a
|
|
||||||
NESeq h l |> v = NESeq h (l Seq.|> v)
|
|
||||||
|
|
||||||
(<|) :: a -> NESeq a -> NESeq a
|
|
||||||
v <| NESeq h l = NESeq v (h Seq.<| l)
|
|
||||||
|
|
||||||
toSeq :: NESeq a -> Seq.Seq a
|
toSeq :: NESeq a -> Seq.Seq a
|
||||||
toSeq (NESeq v l) = v Seq.<| l
|
toSeq (NESeq v l) = v Seq.<| l
|
||||||
|
|
||||||
|
@ -76,9 +76,9 @@ traverseAction f = \case
|
|||||||
RFRaw x -> pure $ RFRaw x
|
RFRaw x -> pure $ RFRaw x
|
||||||
|
|
||||||
data QueryDB v
|
data QueryDB v
|
||||||
= QDBSimple (RQL.AnnSimpleSelG v)
|
= QDBSimple (RQL.AnnSimpleSelG v)
|
||||||
| QDBPrimaryKey (RQL.AnnSimpleSelG v)
|
| QDBPrimaryKey (RQL.AnnSimpleSelG v)
|
||||||
| QDBAggregation (RQL.AnnAggSelG v)
|
| QDBAggregation (RQL.AnnAggregateSelectG v)
|
||||||
|
|
||||||
data ActionQuery v
|
data ActionQuery v
|
||||||
= AQQuery !(RQL.AnnActionExecution v)
|
= AQQuery !(RQL.AnnActionExecution v)
|
||||||
|
@ -43,8 +43,7 @@ import Hasura.Prelude
|
|||||||
import Hasura.RQL.DDL.Headers
|
import Hasura.RQL.DDL.Headers
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
import Hasura.Server.Utils (RequestId, mkClientHeadersForward,
|
import Hasura.Server.Utils (RequestId, mkClientHeadersForward,
|
||||||
mkSetCookieHeaders,
|
mkSetCookieHeaders, userRoleHeader)
|
||||||
userRoleHeader)
|
|
||||||
import Hasura.Server.Version (HasVersion)
|
import Hasura.Server.Version (HasVersion)
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
|
|
||||||
@ -142,8 +141,8 @@ getExecPlanPartial userInfo sc enableAL queryType req = do
|
|||||||
getGCtx :: C.GQLContext
|
getGCtx :: C.GQLContext
|
||||||
getGCtx =
|
getGCtx =
|
||||||
case Map.lookup roleName contextMap of
|
case Map.lookup roleName contextMap of
|
||||||
Nothing -> defaultContext
|
Nothing -> defaultContext
|
||||||
Just gql -> gql
|
Just gql -> gql
|
||||||
-- TODO FIXME implement backend-only field access
|
-- TODO FIXME implement backend-only field access
|
||||||
{-
|
{-
|
||||||
Just (RoleContext defaultGCtx maybeBackendGCtx) ->
|
Just (RoleContext defaultGCtx maybeBackendGCtx) ->
|
||||||
@ -206,7 +205,7 @@ getResolvedExecPlan
|
|||||||
getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx
|
getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx
|
||||||
enableAL sc scVer queryType httpManager reqHeaders reqUnparsed = do
|
enableAL sc scVer queryType httpManager reqHeaders reqUnparsed = do
|
||||||
planM <- liftIO $ EP.getPlan scVer (_uiRole userInfo)
|
planM <- liftIO $ EP.getPlan scVer (_uiRole userInfo)
|
||||||
opNameM queryStr planCache
|
opNameM queryStr queryType planCache
|
||||||
let usrVars = _uiSession userInfo
|
let usrVars = _uiSession userInfo
|
||||||
case planM of
|
case planM of
|
||||||
-- plans are only for queries and subscriptions
|
-- plans are only for queries and subscriptions
|
||||||
@ -246,7 +245,7 @@ getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx
|
|||||||
G.TypedOperationDefinition G.OperationTypeMutation _ varDefs _ selSet -> do
|
G.TypedOperationDefinition G.OperationTypeMutation _ varDefs _ selSet -> do
|
||||||
-- (Here the above fragment inlining is actually executed.)
|
-- (Here the above fragment inlining is actually executed.)
|
||||||
inlinedSelSet <- EI.inlineSelectionSet fragments selSet
|
inlinedSelSet <- EI.inlineSelectionSet fragments selSet
|
||||||
queryTx <- EM.convertMutationSelectionSet gCtx (_uiSession userInfo) httpManager reqHeaders
|
queryTx <- EM.convertMutationSelectionSet gCtx userInfo httpManager reqHeaders
|
||||||
inlinedSelSet varDefs (_grVariables reqUnparsed)
|
inlinedSelSet varDefs (_grVariables reqUnparsed)
|
||||||
-- traverse_ (addPlanToCache . EP.RPQuery) plan
|
-- traverse_ (addPlanToCache . EP.RPQuery) plan
|
||||||
return $ MutationExecutionPlan $ queryTx
|
return $ MutationExecutionPlan $ queryTx
|
||||||
|
@ -29,12 +29,13 @@ import qualified Data.Aeson.Casing as J
|
|||||||
import qualified Data.Aeson.Extended as J
|
import qualified Data.Aeson.Extended as J
|
||||||
import qualified Data.Aeson.TH as J
|
import qualified Data.Aeson.TH as J
|
||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.HashMap.Strict as Map
|
||||||
|
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||||
|
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||||
|
import qualified Data.Sequence as Seq
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.UUID.V4 as UUID
|
import qualified Data.UUID.V4 as UUID
|
||||||
import qualified Database.PG.Query as Q
|
import qualified Database.PG.Query as Q
|
||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
|
||||||
import qualified Data.Sequence as Seq
|
|
||||||
|
|
||||||
-- remove these when array encoding is merged
|
-- remove these when array encoding is merged
|
||||||
import qualified Database.PG.Query.PTI as PTI
|
import qualified Database.PG.Query.PTI as PTI
|
||||||
@ -43,24 +44,25 @@ import qualified PostgreSQL.Binary.Encoding as PE
|
|||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.UUID (UUID)
|
import Data.UUID (UUID)
|
||||||
|
|
||||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
|
||||||
import qualified Hasura.GraphQL.Parser.Schema as PS
|
import qualified Hasura.GraphQL.Parser.Schema as PS
|
||||||
|
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||||
import qualified Hasura.RQL.DML.Select as DS
|
import qualified Hasura.RQL.DML.Select as DS
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
--import qualified Hasura.GraphQL.Execute.Query as GEQ
|
--import qualified Hasura.GraphQL.Execute.Query as GEQ
|
||||||
|
|
||||||
import Hasura.Db
|
import Hasura.Db
|
||||||
import Hasura.EncJSON
|
import Hasura.EncJSON
|
||||||
import Hasura.GraphQL.Parser.Column
|
import Hasura.GraphQL.Context
|
||||||
import Hasura.GraphQL.Execute.Prepare
|
import Hasura.GraphQL.Execute.Prepare
|
||||||
import Hasura.GraphQL.Execute.Query
|
import Hasura.GraphQL.Execute.Query
|
||||||
import Hasura.RQL.Types
|
import Hasura.GraphQL.Parser.Column
|
||||||
import Hasura.GraphQL.Resolve.Action
|
import Hasura.GraphQL.Resolve.Action
|
||||||
|
import Hasura.RQL.Types
|
||||||
|
import Hasura.Server.Version (HasVersion)
|
||||||
|
import Hasura.Session
|
||||||
import Hasura.SQL.Error
|
import Hasura.SQL.Error
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
import Hasura.SQL.Value
|
import Hasura.SQL.Value
|
||||||
import Hasura.GraphQL.Context
|
|
||||||
import Hasura.Session
|
|
||||||
|
|
||||||
-- -------------------------------------------------------------------------------------------------
|
-- -------------------------------------------------------------------------------------------------
|
||||||
-- Multiplexed queries
|
-- Multiplexed queries
|
||||||
@ -72,7 +74,7 @@ toSQLSelect :: SubscriptionRootFieldResolved -> S.Select
|
|||||||
toSQLSelect = \case
|
toSQLSelect = \case
|
||||||
RFDB (QDBPrimaryKey s) -> DS.mkSQLSelect DS.JASSingleObject s
|
RFDB (QDBPrimaryKey s) -> DS.mkSQLSelect DS.JASSingleObject s
|
||||||
RFDB (QDBSimple s) -> DS.mkSQLSelect DS.JASMultipleRows s
|
RFDB (QDBSimple s) -> DS.mkSQLSelect DS.JASMultipleRows s
|
||||||
RFDB (QDBAggregation s) -> DS.mkAggSelect s
|
RFDB (QDBAggregation s) -> DS.mkAggregateSelect s
|
||||||
RFAction s -> DS.mkSQLSelect DS.JASSingleObject s
|
RFAction s -> DS.mkSQLSelect DS.JASSingleObject s
|
||||||
-- QRFActionSelect s -> DS.mkSQLSelect DS.JASSingleObject s
|
-- QRFActionSelect s -> DS.mkSQLSelect DS.JASSingleObject s
|
||||||
-- QRFActionExecuteObject s -> DS.mkSQLSelect DS.JASSingleObject s
|
-- QRFActionExecuteObject s -> DS.mkSQLSelect DS.JASSingleObject s
|
||||||
@ -279,6 +281,7 @@ $(J.deriveToJSON (J.aesonDrop 4 J.snakeCase) ''ReusableLiveQueryPlan)
|
|||||||
buildLiveQueryPlan
|
buildLiveQueryPlan
|
||||||
:: ( MonadError QErr m
|
:: ( MonadError QErr m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
|
, HasVersion
|
||||||
)
|
)
|
||||||
=> PGExecCtx
|
=> PGExecCtx
|
||||||
-> UserInfo
|
-> UserInfo
|
||||||
@ -310,7 +313,7 @@ buildLiveQueryPlan pgExecCtx userInfo unpreparedAST = do
|
|||||||
(preparedAST, (queryVariableValues, querySyntheticVariableValues)) <- flip runStateT (mempty, Seq.empty) $
|
(preparedAST, (queryVariableValues, querySyntheticVariableValues)) <- flip runStateT (mempty, Seq.empty) $
|
||||||
for unpreparedAST \unpreparedQuery -> do
|
for unpreparedAST \unpreparedQuery -> do
|
||||||
traverseQueryRootField resolveMultiplexedValue unpreparedQuery
|
traverseQueryRootField resolveMultiplexedValue unpreparedQuery
|
||||||
>>= traverseAction (DS.traverseAnnSimpleSel resolveMultiplexedValue . resolveAsyncActionQuery userInfo)
|
>>= traverseAction (DS.traverseAnnSimpleSelect resolveMultiplexedValue . resolveAsyncActionQuery userInfo)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
@ -67,37 +67,38 @@ convertMutationRootField
|
|||||||
, MonadIO m
|
, MonadIO m
|
||||||
, MonadError QErr m
|
, MonadError QErr m
|
||||||
)
|
)
|
||||||
=> SessionVariables
|
=> UserInfo
|
||||||
-> HTTP.Manager
|
-> HTTP.Manager
|
||||||
-> HTTP.RequestHeaders
|
-> HTTP.RequestHeaders
|
||||||
-> Bool
|
-> Bool
|
||||||
-> MutationRootField UnpreparedValue
|
-> MutationRootField UnpreparedValue
|
||||||
-> m (Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
-> m (Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
||||||
convertMutationRootField usrVars manager reqHeaders stringifyNum = \case
|
convertMutationRootField userInfo manager reqHeaders stringifyNum = \case
|
||||||
RFDB (MDBInsert s) -> noResponseHeaders $ convertInsert usrVars s stringifyNum
|
RFDB (MDBInsert s) -> noResponseHeaders $ convertInsert userSession s stringifyNum
|
||||||
RFDB (MDBUpdate s) -> noResponseHeaders $ convertUpdate usrVars s stringifyNum
|
RFDB (MDBUpdate s) -> noResponseHeaders $ convertUpdate userSession s stringifyNum
|
||||||
RFDB (MDBDelete s) -> noResponseHeaders $ convertDelete usrVars s stringifyNum
|
RFDB (MDBDelete s) -> noResponseHeaders $ convertDelete userSession s stringifyNum
|
||||||
RFRemote remote -> pure $ Right remote
|
RFRemote remote -> pure $ Right remote
|
||||||
RFAction (AMSync s) -> Left <$> first liftTx <$> resolveActionExecution s actionExecContext
|
RFAction (AMSync s) -> Left <$> first liftTx <$> resolveActionExecution userInfo s actionExecContext
|
||||||
RFAction (AMAsync s) -> noResponseHeaders =<< resolveActionMutationAsync s reqHeaders usrVars
|
RFAction (AMAsync s) -> noResponseHeaders =<< resolveActionMutationAsync s reqHeaders userSession
|
||||||
RFRaw s -> noResponseHeaders $ pure $ encJFromJValue s
|
RFRaw s -> noResponseHeaders $ pure $ encJFromJValue s
|
||||||
where
|
where
|
||||||
noResponseHeaders :: RespTx -> m (Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
noResponseHeaders :: RespTx -> m (Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
||||||
noResponseHeaders rTx = pure $ Left (liftTx rTx, [])
|
noResponseHeaders rTx = pure $ Left (liftTx rTx, [])
|
||||||
|
|
||||||
actionExecContext = ActionExecContext manager reqHeaders usrVars
|
userSession = _uiSession userInfo
|
||||||
|
actionExecContext = ActionExecContext manager reqHeaders $ _uiSession userInfo
|
||||||
|
|
||||||
convertMutationSelectionSet
|
convertMutationSelectionSet
|
||||||
:: (HasVersion, MonadIO m, MonadError QErr m)
|
:: (HasVersion, MonadIO m, MonadError QErr m)
|
||||||
=> GQLContext
|
=> GQLContext
|
||||||
-> SessionVariables
|
-> UserInfo
|
||||||
-> HTTP.Manager
|
-> HTTP.Manager
|
||||||
-> HTTP.RequestHeaders
|
-> HTTP.RequestHeaders
|
||||||
-> G.SelectionSet G.NoFragments G.Name
|
-> G.SelectionSet G.NoFragments G.Name
|
||||||
-> [G.VariableDefinition]
|
-> [G.VariableDefinition]
|
||||||
-> Maybe GH.VariableValues
|
-> Maybe GH.VariableValues
|
||||||
-> m (ExecutionPlan (LazyRespTx, HTTP.ResponseHeaders) RemoteCall (G.Name, J.Value))
|
-> m (ExecutionPlan (LazyRespTx, HTTP.ResponseHeaders) RemoteCall (G.Name, J.Value))
|
||||||
convertMutationSelectionSet gqlContext usrVars manager reqHeaders fields varDefs varValsM = do
|
convertMutationSelectionSet gqlContext userInfo manager reqHeaders fields varDefs varValsM = do
|
||||||
-- Parse the GraphQL query into the RQL AST
|
-- Parse the GraphQL query into the RQL AST
|
||||||
(unpreparedQueries, _reusability)
|
(unpreparedQueries, _reusability)
|
||||||
:: (OMap.InsOrdHashMap G.Name (MutationRootField UnpreparedValue), QueryReusability)
|
:: (OMap.InsOrdHashMap G.Name (MutationRootField UnpreparedValue), QueryReusability)
|
||||||
@ -106,7 +107,7 @@ convertMutationSelectionSet gqlContext usrVars manager reqHeaders fields varDefs
|
|||||||
|
|
||||||
-- Transform the RQL AST into a prepared SQL query
|
-- Transform the RQL AST into a prepared SQL query
|
||||||
-- TODO pass the correct stringifyNum somewhere rather than True
|
-- TODO pass the correct stringifyNum somewhere rather than True
|
||||||
txs <- for unpreparedQueries $ convertMutationRootField usrVars manager reqHeaders True
|
txs <- for unpreparedQueries $ convertMutationRootField userInfo manager reqHeaders True
|
||||||
let txList = OMap.toList txs
|
let txList = OMap.toList txs
|
||||||
case (mapMaybe takeTx txList, mapMaybe takeRemote txList) of
|
case (mapMaybe takeTx txList, mapMaybe takeRemote txList) of
|
||||||
(dbPlans, []) -> do
|
(dbPlans, []) -> do
|
||||||
@ -148,9 +149,9 @@ convertMutationSelectionSet gqlContext usrVars manager reqHeaders fields varDefs
|
|||||||
:: (G.Name, Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
:: (G.Name, Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
||||||
-> Maybe (G.Name, (LazyRespTx, HTTP.ResponseHeaders))
|
-> Maybe (G.Name, (LazyRespTx, HTTP.ResponseHeaders))
|
||||||
takeTx (name, Left tx) = Just (name, tx)
|
takeTx (name, Left tx) = Just (name, tx)
|
||||||
takeTx _ = Nothing
|
takeTx _ = Nothing
|
||||||
takeRemote
|
takeRemote
|
||||||
:: (G.Name, Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
:: (G.Name, Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
||||||
-> Maybe (G.Name, RemoteField)
|
-> Maybe (G.Name, RemoteField)
|
||||||
takeRemote (name, Right remote) = Just (name, remote)
|
takeRemote (name, Right remote) = Just (name, remote)
|
||||||
takeRemote _ = Nothing
|
takeRemote _ = Nothing
|
||||||
|
@ -19,6 +19,7 @@ import qualified Data.Aeson.TH as J
|
|||||||
import qualified Hasura.Cache as Cache
|
import qualified Hasura.Cache as Cache
|
||||||
import qualified Hasura.GraphQL.Execute.LiveQuery as LQ
|
import qualified Hasura.GraphQL.Execute.LiveQuery as LQ
|
||||||
import qualified Hasura.GraphQL.Execute.Query as EQ
|
import qualified Hasura.GraphQL.Execute.Query as EQ
|
||||||
|
import qualified Hasura.GraphQL.Execute.Types as ET
|
||||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
@ -29,17 +30,19 @@ data PlanId
|
|||||||
, _piRole :: !RoleName
|
, _piRole :: !RoleName
|
||||||
, _piOperationName :: !(Maybe GH.OperationName)
|
, _piOperationName :: !(Maybe GH.OperationName)
|
||||||
, _piQuery :: !GH.GQLQueryText
|
, _piQuery :: !GH.GQLQueryText
|
||||||
|
, _piQueryType :: !ET.GraphQLQueryType
|
||||||
} deriving (Show, Eq, Ord, Generic)
|
} deriving (Show, Eq, Ord, Generic)
|
||||||
|
|
||||||
instance Hashable PlanId
|
instance Hashable PlanId
|
||||||
|
|
||||||
instance J.ToJSON PlanId where
|
instance J.ToJSON PlanId where
|
||||||
toJSON (PlanId scVer rn opNameM query) =
|
toJSON (PlanId scVer rn opNameM query queryType) =
|
||||||
J.object
|
J.object
|
||||||
[ "schema_cache_version" J..= scVer
|
[ "schema_cache_version" J..= scVer
|
||||||
, "role" J..= rn
|
, "role" J..= rn
|
||||||
, "operation" J..= opNameM
|
, "operation" J..= opNameM
|
||||||
, "query" J..= query
|
, "query" J..= query
|
||||||
|
, "query_type" J..= queryType
|
||||||
]
|
]
|
||||||
|
|
||||||
newtype PlanCache
|
newtype PlanCache
|
||||||
@ -68,19 +71,19 @@ initPlanCache options =
|
|||||||
|
|
||||||
getPlan
|
getPlan
|
||||||
:: SchemaCacheVer -> RoleName -> Maybe GH.OperationName -> GH.GQLQueryText
|
:: SchemaCacheVer -> RoleName -> Maybe GH.OperationName -> GH.GQLQueryText
|
||||||
-> PlanCache -> IO (Maybe ReusablePlan)
|
-> ET.GraphQLQueryType -> PlanCache -> IO (Maybe ReusablePlan)
|
||||||
getPlan schemaVer rn opNameM q (PlanCache planCache) =
|
getPlan schemaVer rn opNameM q queryType (PlanCache planCache) =
|
||||||
Cache.lookup planId planCache
|
Cache.lookup planId planCache
|
||||||
where
|
where
|
||||||
planId = PlanId schemaVer rn opNameM q
|
planId = PlanId schemaVer rn opNameM q queryType
|
||||||
|
|
||||||
addPlan
|
addPlan
|
||||||
:: SchemaCacheVer -> RoleName -> Maybe GH.OperationName -> GH.GQLQueryText
|
:: SchemaCacheVer -> RoleName -> Maybe GH.OperationName -> GH.GQLQueryText
|
||||||
-> ReusablePlan -> PlanCache -> IO ()
|
-> ReusablePlan -> ET.GraphQLQueryType -> PlanCache -> IO ()
|
||||||
addPlan schemaVer rn opNameM q queryPlan (PlanCache planCache) =
|
addPlan schemaVer rn opNameM q queryPlan queryType (PlanCache planCache) =
|
||||||
Cache.insert planId queryPlan planCache
|
Cache.insert planId queryPlan planCache
|
||||||
where
|
where
|
||||||
planId = PlanId schemaVer rn opNameM q
|
planId = PlanId schemaVer rn opNameM q queryType
|
||||||
|
|
||||||
clearPlanCache :: PlanCache -> IO ()
|
clearPlanCache :: PlanCache -> IO ()
|
||||||
clearPlanCache (PlanCache planCache) =
|
clearPlanCache (PlanCache planCache) =
|
||||||
|
@ -37,9 +37,9 @@ import Hasura.Prelude
|
|||||||
import Hasura.RQL.DML.RemoteJoin
|
import Hasura.RQL.DML.RemoteJoin
|
||||||
import Hasura.RQL.DML.Select (asSingleRowJsonResp)
|
import Hasura.RQL.DML.Select (asSingleRowJsonResp)
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
|
import Hasura.Session
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
import Hasura.SQL.Value
|
import Hasura.SQL.Value
|
||||||
import Hasura.Session
|
|
||||||
|
|
||||||
import qualified Hasura.RQL.DML.Select as DS
|
import qualified Hasura.RQL.DML.Select as DS
|
||||||
|
|
||||||
@ -165,7 +165,7 @@ irToRootFieldPlan vars prepped = \case
|
|||||||
QDBPrimaryKey s -> mkPGPlan (DS.selectQuerySQL DS.JASSingleObject) s
|
QDBPrimaryKey s -> mkPGPlan (DS.selectQuerySQL DS.JASSingleObject) s
|
||||||
QDBAggregation s ->
|
QDBAggregation s ->
|
||||||
let (annAggSel, aggRemoteJoins) = getRemoteJoinsAggregateSelect s
|
let (annAggSel, aggRemoteJoins) = getRemoteJoinsAggregateSelect s
|
||||||
in PGPlan (DS.selectAggQuerySQL annAggSel) vars prepped aggRemoteJoins
|
in PGPlan (DS.selectAggregateQuerySQL annAggSel) vars prepped aggRemoteJoins
|
||||||
where
|
where
|
||||||
mkPGPlan f simpleSel =
|
mkPGPlan f simpleSel =
|
||||||
let (simpleSel',remoteJoins) = getRemoteJoins simpleSel
|
let (simpleSel',remoteJoins) = getRemoteJoins simpleSel
|
||||||
@ -182,9 +182,9 @@ traverseQueryRootField f =
|
|||||||
where
|
where
|
||||||
f' :: QueryDB a -> f (QueryDB b)
|
f' :: QueryDB a -> f (QueryDB b)
|
||||||
f' = \case
|
f' = \case
|
||||||
QDBSimple s -> QDBSimple <$> DS.traverseAnnSimpleSel f s
|
QDBSimple s -> QDBSimple <$> DS.traverseAnnSimpleSelect f s
|
||||||
QDBPrimaryKey s -> QDBPrimaryKey <$> DS.traverseAnnSimpleSel f s
|
QDBPrimaryKey s -> QDBPrimaryKey <$> DS.traverseAnnSimpleSelect f s
|
||||||
QDBAggregation s -> QDBAggregation <$> DS.traverseAnnAggSel f s
|
QDBAggregation s -> QDBAggregation <$> DS.traverseAnnAggregateSelect f s
|
||||||
|
|
||||||
convertQuerySelSet
|
convertQuerySelSet
|
||||||
:: forall m. (HasVersion, MonadError QErr m, MonadIO m)
|
:: forall m. (HasVersion, MonadError QErr m, MonadIO m)
|
||||||
@ -265,9 +265,9 @@ convertQuerySelSet gqlContext userInfo manager reqHeaders fields varDefs varVals
|
|||||||
:: ActionQuery UnpreparedValue -> StateT PlanningSt m ActionQueryPlan
|
:: ActionQuery UnpreparedValue -> StateT PlanningSt m ActionQueryPlan
|
||||||
convertActionQuery = \case
|
convertActionQuery = \case
|
||||||
AQQuery s -> (AQPQuery . fst) <$>
|
AQQuery s -> (AQPQuery . fst) <$>
|
||||||
lift (resolveActionExecution s $ ActionExecContext manager reqHeaders usrVars)
|
lift (resolveActionExecution userInfo s $ ActionExecContext manager reqHeaders usrVars)
|
||||||
AQAsync s -> AQPAsyncQuery <$>
|
AQAsync s -> AQPAsyncQuery <$>
|
||||||
DS.traverseAnnSimpleSel prepareWithPlan (resolveAsyncActionQuery userInfo s)
|
DS.traverseAnnSimpleSelect prepareWithPlan (resolveAsyncActionQuery userInfo s)
|
||||||
|
|
||||||
-- use the existing plan and new variables to create a pg query
|
-- use the existing plan and new variables to create a pg query
|
||||||
queryOpFromPlan
|
queryOpFromPlan
|
||||||
@ -341,3 +341,15 @@ mkGeneratedSqlMap resolved =
|
|||||||
RRSql ps -> Just ps
|
RRSql ps -> Just ps
|
||||||
RRActionQuery _ -> Nothing
|
RRActionQuery _ -> Nothing
|
||||||
in (alias, res)
|
in (alias, res)
|
||||||
|
|
||||||
|
-- The GraphQL Query type
|
||||||
|
data GraphQLQueryType
|
||||||
|
= QueryHasura
|
||||||
|
| QueryRelay
|
||||||
|
deriving (Show, Eq, Ord, Generic)
|
||||||
|
instance Hashable GraphQLQueryType
|
||||||
|
|
||||||
|
instance J.ToJSON GraphQLQueryType where
|
||||||
|
toJSON = \case
|
||||||
|
QueryHasura -> "hasura"
|
||||||
|
QueryRelay -> "relay"
|
||||||
|
@ -11,13 +11,13 @@ import qualified Database.PG.Query as Q
|
|||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
import Hasura.EncJSON
|
import Hasura.EncJSON
|
||||||
|
import Hasura.GraphQL.Resolve.Action
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
import Hasura.RQL.DML.Internal
|
import Hasura.RQL.DML.Internal
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
|
import Hasura.Server.Version (HasVersion)
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
import Hasura.SQL.Value
|
import Hasura.SQL.Value
|
||||||
import Hasura.Server.Version (HasVersion)
|
|
||||||
import Hasura.GraphQL.Resolve.Action
|
|
||||||
|
|
||||||
import qualified Hasura.GraphQL.Execute as E
|
import qualified Hasura.GraphQL.Execute as E
|
||||||
import qualified Hasura.GraphQL.Execute.LiveQuery as E
|
import qualified Hasura.GraphQL.Execute.LiveQuery as E
|
||||||
@ -26,11 +26,12 @@ import qualified Hasura.SQL.DML as S
|
|||||||
|
|
||||||
data GQLExplain
|
data GQLExplain
|
||||||
= GQLExplain
|
= GQLExplain
|
||||||
{ _gqeQuery :: !GH.GQLReqParsed
|
{ _gqeQuery :: !GH.GQLReqParsed
|
||||||
, _gqeUser :: !(Maybe (Map.HashMap Text Text))
|
, _gqeUser :: !(Maybe (Map.HashMap Text Text))
|
||||||
|
, _gqeIsRelay :: !(Maybe Bool)
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
$(J.deriveJSON (J.aesonDrop 4 J.camelCase){J.omitNothingFields=True}
|
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase){J.omitNothingFields=True}
|
||||||
''GQLExplain
|
''GQLExplain
|
||||||
)
|
)
|
||||||
|
|
||||||
@ -117,24 +118,26 @@ explainGQLQuery
|
|||||||
-> QueryActionExecuter
|
-> QueryActionExecuter
|
||||||
-> GQLExplain
|
-> GQLExplain
|
||||||
-> m EncJSON
|
-> m EncJSON
|
||||||
explainGQLQuery pgExecCtx sc sqlGenCtx enableAL actionExecuter (GQLExplain query userVarsRaw) = do
|
explainGQLQuery pgExecCtx sc sqlGenCtx enableAL actionExecuter (GQLExplain query userVarsRaw maybeIsRelay) = do
|
||||||
|
userInfo <- mkUserInfo (URBFromSessionVariablesFallback adminRoleName) UAdminSecretSent sessionVariables
|
||||||
(execPlan, queryReusability) <- runReusabilityT $
|
(execPlan, queryReusability) <- runReusabilityT $
|
||||||
E.getExecPlanPartial userInfo sc enableAL query
|
E.getExecPlanPartial userInfo sc queryType enableAL query
|
||||||
(gCtx, rootSelSet) <- case execPlan of
|
(gCtx, rootSelSet) <- case execPlan of
|
||||||
E.GExPHasura (gCtx, rootSelSet) ->
|
E.GExPHasura (gCtx, rootSelSet) ->
|
||||||
return (gCtx, rootSelSet)
|
return (gCtx, rootSelSet)
|
||||||
E.GExPRemote _ _ ->
|
E.GExPRemote{} ->
|
||||||
throw400 InvalidParams "only hasura queries can be explained"
|
throw400 InvalidParams "only hasura queries can be explained"
|
||||||
case rootSelSet of
|
case rootSelSet of
|
||||||
GV.RQuery selSet ->
|
GV.RQuery selSet ->
|
||||||
runInTx $ encJFromJValue <$> traverse (explainField userInfo gCtx sqlGenCtx actionExecuter)
|
runInTx $ encJFromJValue . map snd <$>
|
||||||
(toList selSet)
|
GV.traverseObjectSelectionSet selSet (explainField userInfo gCtx sqlGenCtx actionExecuter)
|
||||||
GV.RMutation _ ->
|
GV.RMutation _ ->
|
||||||
throw400 InvalidParams "only queries can be explained"
|
throw400 InvalidParams "only queries can be explained"
|
||||||
GV.RSubscription rootField -> do
|
GV.RSubscription fields -> do
|
||||||
(plan, _) <- E.getSubsOp pgExecCtx gCtx sqlGenCtx userInfo queryReusability actionExecuter rootField
|
(plan, _) <- E.getSubsOp pgExecCtx gCtx sqlGenCtx userInfo
|
||||||
|
queryReusability actionExecuter fields
|
||||||
runInTx $ encJFromJValue <$> E.explainLiveQueryPlan plan
|
runInTx $ encJFromJValue <$> E.explainLiveQueryPlan plan
|
||||||
where
|
where
|
||||||
usrVars = mkUserVars $ maybe [] Map.toList userVarsRaw
|
queryType = bool E.QueryHasura E.QueryRelay $ fromMaybe False maybeIsRelay
|
||||||
userInfo = mkUserInfo (fromMaybe adminRole $ roleFromVars usrVars) usrVars
|
sessionVariables = mkSessionVariablesText $ maybe [] Map.toList userVarsRaw
|
||||||
runInTx = liftEither <=< liftIO . runExceptT . runLazyTx pgExecCtx Q.ReadOnly
|
runInTx = liftEither <=< liftIO . runExceptT . runLazyTx pgExecCtx Q.ReadOnly
|
||||||
|
@ -236,7 +236,7 @@ mkGCtxRole' tn descM insPermM selPermM updColsM delPermM pkeyCols constraints vi
|
|||||||
in case riType relInfo of
|
in case riType relInfo of
|
||||||
ObjRel -> [relFld]
|
ObjRel -> [relFld]
|
||||||
ArrRel -> bool [relFld] [relFld, aggRelFld] allowAgg
|
ArrRel -> bool [relFld] [relFld, aggRelFld] allowAgg
|
||||||
SFComputedField cf -> pure
|
SAFComputedField cf -> pure
|
||||||
( (ty, mkComputedFieldName $ _cfName cf)
|
( (ty, mkComputedFieldName $ _cfName cf)
|
||||||
, RFComputedField cf
|
, RFComputedField cf
|
||||||
)
|
)
|
||||||
|
@ -8,6 +8,8 @@ module Hasura.GraphQL.Schema.Builder
|
|||||||
, addFieldsToTyAgg
|
, addFieldsToTyAgg
|
||||||
, addTypeInfoToTyAgg
|
, addTypeInfoToTyAgg
|
||||||
, addScalarToTyAgg
|
, addScalarToTyAgg
|
||||||
|
, QueryRootFieldMap
|
||||||
|
, MutationRootFieldMap
|
||||||
, RootFields(..)
|
, RootFields(..)
|
||||||
, addQueryField
|
, addQueryField
|
||||||
, addMutationField
|
, addMutationField
|
||||||
@ -57,11 +59,14 @@ instance Semigroup TyAgg where
|
|||||||
instance Monoid TyAgg where
|
instance Monoid TyAgg where
|
||||||
mempty = TyAgg Map.empty Map.empty Set.empty Map.empty
|
mempty = TyAgg Map.empty Map.empty Set.empty Map.empty
|
||||||
|
|
||||||
|
type QueryRootFieldMap = Map.HashMap G.Name (QueryCtx, ObjFldInfo)
|
||||||
|
type MutationRootFieldMap = Map.HashMap G.Name (MutationCtx, ObjFldInfo)
|
||||||
|
|
||||||
-- | A role-specific mapping from root field names to allowed operations.
|
-- | A role-specific mapping from root field names to allowed operations.
|
||||||
data RootFields
|
data RootFields
|
||||||
= RootFields
|
= RootFields
|
||||||
{ _rootQueryFields :: !(Map.HashMap G.Name (QueryCtx, ObjFldInfo))
|
{ _rootQueryFields :: !QueryRootFieldMap
|
||||||
, _rootMutationFields :: !(Map.HashMap G.Name (MutationCtx, ObjFldInfo))
|
, _rootMutationFields :: !MutationRootFieldMap
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
$(makeLenses ''RootFields)
|
$(makeLenses ''RootFields)
|
||||||
|
|
||||||
|
@ -2,14 +2,17 @@ module Hasura.GraphQL.Schema.Function
|
|||||||
( procFuncArgs
|
( procFuncArgs
|
||||||
, mkFuncArgsInp
|
, mkFuncArgsInp
|
||||||
, mkFuncQueryFld
|
, mkFuncQueryFld
|
||||||
|
, mkFuncQueryConnectionFld
|
||||||
, mkFuncAggQueryFld
|
, mkFuncAggQueryFld
|
||||||
, mkFuncArgsTy
|
, mkFuncArgsTy
|
||||||
|
, mkFuncArgItemSeq
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
|
import Hasura.GraphQL.Resolve.Types
|
||||||
import Hasura.GraphQL.Schema.Common
|
import Hasura.GraphQL.Schema.Common
|
||||||
import Hasura.GraphQL.Schema.Select
|
import Hasura.GraphQL.Schema.Select
|
||||||
import Hasura.GraphQL.Validate.Types
|
import Hasura.GraphQL.Validate.Types
|
||||||
@ -92,6 +95,20 @@ mkFuncQueryFld funInfo descM =
|
|||||||
|
|
||||||
ty = G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableTy retTable
|
ty = G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableTy retTable
|
||||||
|
|
||||||
|
mkFuncQueryConnectionFld
|
||||||
|
:: FunctionInfo -> Maybe PGDescription -> ObjFldInfo
|
||||||
|
mkFuncQueryConnectionFld funInfo descM =
|
||||||
|
mkHsraObjFldInfo (Just desc) fldName (mkFuncArgs funInfo) ty
|
||||||
|
where
|
||||||
|
retTable = fiReturnType funInfo
|
||||||
|
funcName = fiName funInfo
|
||||||
|
|
||||||
|
desc = mkDescriptionWith descM $ "execute function " <> funcName
|
||||||
|
<<> " which returns " <>> retTable
|
||||||
|
fldName = qualObjectToName funcName <> "_connection"
|
||||||
|
|
||||||
|
ty = G.toGT $ G.toNT $ G.toLT $ G.toNT $ mkTableConnectionTy retTable
|
||||||
|
|
||||||
{-
|
{-
|
||||||
|
|
||||||
function_aggregate(
|
function_aggregate(
|
||||||
@ -118,3 +135,15 @@ mkFuncAggQueryFld funInfo descM =
|
|||||||
fldName = qualObjectToName funcName <> "_aggregate"
|
fldName = qualObjectToName funcName <> "_aggregate"
|
||||||
|
|
||||||
ty = G.toGT $ G.toNT $ mkTableAggTy retTable
|
ty = G.toGT $ G.toNT $ mkTableAggTy retTable
|
||||||
|
|
||||||
|
|
||||||
|
mkFuncArgItemSeq :: FunctionInfo -> Seq (InputArgument FunctionArgItem)
|
||||||
|
mkFuncArgItemSeq functionInfo =
|
||||||
|
let inputArgs = fiInputArgs functionInfo
|
||||||
|
in Seq.fromList $ procFuncArgs inputArgs nameFn resultFn
|
||||||
|
where
|
||||||
|
nameFn = \case
|
||||||
|
IAUserProvided fa -> faName fa
|
||||||
|
IASessionVariables name -> Just name
|
||||||
|
resultFn arg gName = flip fmap arg $
|
||||||
|
\fa -> FunctionArgItem (G.Name gName) (faName fa) (faHasDefault fa)
|
||||||
|
300
server/src-lib/Hasura/GraphQL/NormalForm.hs
Normal file
300
server/src-lib/Hasura/GraphQL/NormalForm.hs
Normal file
@ -0,0 +1,300 @@
|
|||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE TypeFamilyDependencies #-}
|
||||||
|
module Hasura.GraphQL.NormalForm
|
||||||
|
( Selection(..)
|
||||||
|
, NormalizedSelection
|
||||||
|
, NormalizedSelectionSet
|
||||||
|
, NormalizedField
|
||||||
|
, SelectionSet(..)
|
||||||
|
, RootSelectionSet(..)
|
||||||
|
-- , toGraphQLOperation
|
||||||
|
, ArgsMap
|
||||||
|
, Field(..)
|
||||||
|
, Typename(..)
|
||||||
|
, IsField(..)
|
||||||
|
, toField
|
||||||
|
, AliasedFields(..)
|
||||||
|
, asObjectSelectionSet
|
||||||
|
, ObjectSelectionSet(..)
|
||||||
|
, ObjectSelectionSetMap
|
||||||
|
, traverseObjectSelectionSet
|
||||||
|
, InterfaceSelectionSet
|
||||||
|
, asInterfaceSelectionSet
|
||||||
|
, getMemberSelectionSet
|
||||||
|
, UnionSelectionSet
|
||||||
|
, ScopedSelectionSet(..)
|
||||||
|
, emptyScopedSelectionSet
|
||||||
|
, getUnionSelectionSet
|
||||||
|
, getInterfaceSelectionSet
|
||||||
|
, getObjectSelectionSet
|
||||||
|
|
||||||
|
, AnnInpVal(..)
|
||||||
|
, AnnGValue(..)
|
||||||
|
, AnnGObject
|
||||||
|
, AnnGEnumValue(..)
|
||||||
|
, hasNullVal
|
||||||
|
, getAnnInpValKind
|
||||||
|
|
||||||
|
, toGraphQLField
|
||||||
|
, toGraphQLSelectionSet
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Hasura.Prelude
|
||||||
|
|
||||||
|
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.HashMap.Strict.InsOrd.Extended as OMap
|
||||||
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
|
import qualified Hasura.RQL.Types.Column as RQL
|
||||||
|
import qualified Hasura.RQL.Types.Error as RQL
|
||||||
|
import Hasura.SQL.Types
|
||||||
|
import Hasura.SQL.Value
|
||||||
|
|
||||||
|
data Selection f s
|
||||||
|
= SelectionField !G.Alias !f
|
||||||
|
| SelectionInlineFragmentSpread !s
|
||||||
|
| SelectionFragmentSpread !G.Name !s
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
-- | What a processed G.SelectionSet should look like
|
||||||
|
type family NormalizedSelectionSet a = s | s -> a
|
||||||
|
|
||||||
|
-- | What a processed G.Field should look like
|
||||||
|
type family NormalizedField a
|
||||||
|
|
||||||
|
type NormalizedSelection a
|
||||||
|
= Selection (NormalizedField a) (NormalizedSelectionSet a)
|
||||||
|
|
||||||
|
-- | Ordered fields
|
||||||
|
newtype AliasedFields f
|
||||||
|
= AliasedFields { unAliasedFields :: OMap.InsOrdHashMap G.Alias f }
|
||||||
|
deriving (Show, Eq, Functor, Foldable, Traversable, Semigroup)
|
||||||
|
|
||||||
|
newtype ObjectSelectionSet
|
||||||
|
= ObjectSelectionSet { unObjectSelectionSet :: AliasedFields Field }
|
||||||
|
deriving (Show, Eq, Semigroup)
|
||||||
|
|
||||||
|
traverseObjectSelectionSet
|
||||||
|
:: (Monad m) => ObjectSelectionSet -> (Field -> m a) -> m [(Text, a)]
|
||||||
|
traverseObjectSelectionSet selectionSet f =
|
||||||
|
forM (OMap.toList $ unAliasedFields $ unObjectSelectionSet selectionSet) $
|
||||||
|
\(alias, field) -> (G.unName $ G.unAlias alias,) <$> f field
|
||||||
|
|
||||||
|
type ObjectSelectionSetMap
|
||||||
|
= Map.HashMap G.NamedType ObjectSelectionSet
|
||||||
|
|
||||||
|
data Typename = Typename
|
||||||
|
deriving (Show, Eq, Generic)
|
||||||
|
|
||||||
|
data ScopedSelectionSet f
|
||||||
|
= ScopedSelectionSet
|
||||||
|
{ _sssBaseSelectionSet :: !(AliasedFields f)
|
||||||
|
-- ^ Fields that aren't explicitly defined for member types
|
||||||
|
, _sssMemberSelectionSets :: !ObjectSelectionSetMap
|
||||||
|
-- ^ SelectionSets of individual member types
|
||||||
|
} deriving (Show, Eq, Generic)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
emptyScopedSelectionSet :: ScopedSelectionSet f
|
||||||
|
emptyScopedSelectionSet =
|
||||||
|
ScopedSelectionSet (AliasedFields mempty) mempty
|
||||||
|
|
||||||
|
type InterfaceSelectionSet = ScopedSelectionSet Field
|
||||||
|
|
||||||
|
type UnionSelectionSet = ScopedSelectionSet Typename
|
||||||
|
|
||||||
|
data RootSelectionSet
|
||||||
|
= RQuery !ObjectSelectionSet
|
||||||
|
| RMutation !ObjectSelectionSet
|
||||||
|
| RSubscription !ObjectSelectionSet
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
-- toGraphQLOperation :: RootSelectionSet -> G.ExecutableDefinition
|
||||||
|
-- toGraphQLOperation = \case
|
||||||
|
-- RQuery selectionSet ->
|
||||||
|
-- mkExecutableDefinition G.OperationTypeQuery $
|
||||||
|
-- toGraphQLSelectionSet $ SelectionSetObject selectionSet
|
||||||
|
-- RMutation selectionSet ->
|
||||||
|
-- mkExecutableDefinition G.OperationTypeQuery $
|
||||||
|
-- toGraphQLSelectionSet $ SelectionSetObject selectionSet
|
||||||
|
-- RSubscription opDef _ ->
|
||||||
|
-- G.ExecutableDefinitionOperation $ G.OperationDefinitionTyped opDef
|
||||||
|
-- where
|
||||||
|
-- mkExecutableDefinition operationType selectionSet =
|
||||||
|
-- G.ExecutableDefinitionOperation $ G.OperationDefinitionTyped $
|
||||||
|
-- G.TypedOperationDefinition
|
||||||
|
-- { G._todName = Nothing -- TODO, store the name too?
|
||||||
|
-- , G._todDirectives = []
|
||||||
|
-- , G._todType = operationType
|
||||||
|
-- , G._todVariableDefinitions = []
|
||||||
|
-- , G._todSelectionSet = selectionSet
|
||||||
|
-- }
|
||||||
|
|
||||||
|
|
||||||
|
data SelectionSet
|
||||||
|
= SelectionSetObject !ObjectSelectionSet
|
||||||
|
| SelectionSetUnion !UnionSelectionSet
|
||||||
|
| SelectionSetInterface !InterfaceSelectionSet
|
||||||
|
| SelectionSetNone
|
||||||
|
-- ^ in cases of enums and scalars
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
getObjectSelectionSet :: SelectionSet -> Maybe ObjectSelectionSet
|
||||||
|
getObjectSelectionSet = \case
|
||||||
|
SelectionSetObject s -> pure s
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
asObjectSelectionSet
|
||||||
|
:: (MonadError RQL.QErr m) => SelectionSet -> m ObjectSelectionSet
|
||||||
|
asObjectSelectionSet selectionSet =
|
||||||
|
onNothing (getObjectSelectionSet selectionSet) $
|
||||||
|
RQL.throw500 "expecting ObjectSelectionSet"
|
||||||
|
|
||||||
|
getUnionSelectionSet :: SelectionSet -> Maybe UnionSelectionSet
|
||||||
|
getUnionSelectionSet = \case
|
||||||
|
SelectionSetUnion s -> pure s
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
getInterfaceSelectionSet :: SelectionSet -> Maybe InterfaceSelectionSet
|
||||||
|
getInterfaceSelectionSet = \case
|
||||||
|
SelectionSetInterface s -> pure s
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
asInterfaceSelectionSet
|
||||||
|
:: (MonadError RQL.QErr m) => SelectionSet -> m InterfaceSelectionSet
|
||||||
|
asInterfaceSelectionSet selectionSet =
|
||||||
|
onNothing (getInterfaceSelectionSet selectionSet) $
|
||||||
|
RQL.throw500 "expecting InterfaceSelectionSet"
|
||||||
|
|
||||||
|
type ArgsMap = Map.HashMap G.Name AnnInpVal
|
||||||
|
|
||||||
|
data Field
|
||||||
|
= Field
|
||||||
|
{ _fName :: !G.Name
|
||||||
|
, _fType :: !G.NamedType
|
||||||
|
, _fArguments :: !ArgsMap
|
||||||
|
, _fSelSet :: !SelectionSet
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
toGraphQLField :: G.Alias -> Field -> G.Field
|
||||||
|
toGraphQLField alias Field{..} =
|
||||||
|
G.Field
|
||||||
|
{ G._fName = _fName
|
||||||
|
, G._fArguments = [] -- TODO
|
||||||
|
, G._fDirectives = []
|
||||||
|
, G._fAlias = Just alias
|
||||||
|
, G._fSelectionSet = toGraphQLSelectionSet _fSelSet
|
||||||
|
}
|
||||||
|
|
||||||
|
toGraphQLSelectionSet :: SelectionSet -> G.SelectionSet
|
||||||
|
toGraphQLSelectionSet = \case
|
||||||
|
SelectionSetObject selectionSet -> fromSelectionSet selectionSet
|
||||||
|
SelectionSetInterface selectionSet -> fromScopedSelectionSet selectionSet
|
||||||
|
SelectionSetUnion selectionSet -> fromScopedSelectionSet selectionSet
|
||||||
|
SelectionSetNone -> mempty
|
||||||
|
where
|
||||||
|
fromAliasedFields :: (IsField f) => AliasedFields f -> G.SelectionSet
|
||||||
|
fromAliasedFields =
|
||||||
|
map (G.SelectionField . uncurry toGraphQLField) .
|
||||||
|
OMap.toList . fmap toField . unAliasedFields
|
||||||
|
fromSelectionSet =
|
||||||
|
fromAliasedFields . unObjectSelectionSet
|
||||||
|
toInlineSelection typeName =
|
||||||
|
G.SelectionInlineFragment . G.InlineFragment (Just typeName) mempty .
|
||||||
|
fromSelectionSet
|
||||||
|
fromScopedSelectionSet (ScopedSelectionSet base specific) =
|
||||||
|
map (uncurry toInlineSelection) (Map.toList specific) <> fromAliasedFields base
|
||||||
|
|
||||||
|
-- $(J.deriveToJSON (J.aesonDrop 2 J.camelCase){J.omitNothingFields=True}
|
||||||
|
-- ''Field
|
||||||
|
-- )
|
||||||
|
|
||||||
|
-- $(J.deriveToJSON (J.aesonDrop 2 J.camelCase){J.omitNothingFields=True}
|
||||||
|
-- ''InterfaceSelectionSet
|
||||||
|
-- )
|
||||||
|
|
||||||
|
-- $(J.deriveToJSON (J.aesonDrop 2 J.camelCase){J.omitNothingFields=True}
|
||||||
|
-- ''SelectionSet
|
||||||
|
-- )
|
||||||
|
|
||||||
|
class IsField f where
|
||||||
|
getFieldName :: f -> G.Name
|
||||||
|
getFieldType :: f -> G.NamedType
|
||||||
|
getFieldArguments :: f -> ArgsMap
|
||||||
|
getFieldSelectionSet :: f -> SelectionSet
|
||||||
|
|
||||||
|
toField :: (IsField f) => f -> Field
|
||||||
|
toField f =
|
||||||
|
Field (getFieldName f) (getFieldType f)
|
||||||
|
(getFieldArguments f) (getFieldSelectionSet f)
|
||||||
|
|
||||||
|
instance IsField Field where
|
||||||
|
getFieldName = _fName
|
||||||
|
getFieldType = _fType
|
||||||
|
getFieldArguments = _fArguments
|
||||||
|
getFieldSelectionSet = _fSelSet
|
||||||
|
|
||||||
|
instance IsField Typename where
|
||||||
|
getFieldName _ = "__typename"
|
||||||
|
getFieldType _ = G.NamedType "String"
|
||||||
|
getFieldArguments _ = mempty
|
||||||
|
getFieldSelectionSet _ = SelectionSetNone
|
||||||
|
|
||||||
|
getMemberSelectionSet
|
||||||
|
:: IsField f
|
||||||
|
=> G.NamedType -> ScopedSelectionSet f -> ObjectSelectionSet
|
||||||
|
getMemberSelectionSet namedType (ScopedSelectionSet {..}) =
|
||||||
|
fromMaybe (ObjectSelectionSet (fmap toField _sssBaseSelectionSet)) $
|
||||||
|
Map.lookup namedType $ _sssMemberSelectionSets
|
||||||
|
|
||||||
|
data AnnInpVal
|
||||||
|
= AnnInpVal
|
||||||
|
{ _aivType :: !G.GType
|
||||||
|
, _aivVariable :: !(Maybe G.Variable)
|
||||||
|
, _aivValue :: !AnnGValue
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
type AnnGObject = OMap.InsOrdHashMap G.Name AnnInpVal
|
||||||
|
|
||||||
|
-- | See 'EnumValuesInfo' for information about what these cases mean.
|
||||||
|
data AnnGEnumValue
|
||||||
|
= AGESynthetic !(Maybe G.EnumValue)
|
||||||
|
| AGEReference !RQL.EnumReference !(Maybe RQL.EnumValue)
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data AnnGValue
|
||||||
|
= AGScalar !PGScalarType !(Maybe PGScalarValue)
|
||||||
|
| AGEnum !G.NamedType !AnnGEnumValue
|
||||||
|
| AGObject !G.NamedType !(Maybe AnnGObject)
|
||||||
|
| AGArray !G.ListType !(Maybe [AnnInpVal])
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
$(J.deriveToJSON (J.aesonDrop 4 J.camelCase){J.omitNothingFields=True}
|
||||||
|
''AnnInpVal
|
||||||
|
)
|
||||||
|
|
||||||
|
instance J.ToJSON AnnGValue where
|
||||||
|
-- toJSON (AGScalar ty valM) =
|
||||||
|
toJSON = const J.Null
|
||||||
|
-- J.
|
||||||
|
-- J.toJSON [J.toJSON ty, J.toJSON valM]
|
||||||
|
|
||||||
|
hasNullVal :: AnnGValue -> Bool
|
||||||
|
hasNullVal = \case
|
||||||
|
AGScalar _ Nothing -> True
|
||||||
|
AGEnum _ (AGESynthetic Nothing) -> True
|
||||||
|
AGEnum _ (AGEReference _ Nothing) -> True
|
||||||
|
AGObject _ Nothing -> True
|
||||||
|
AGArray _ Nothing -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
getAnnInpValKind :: AnnGValue -> Text
|
||||||
|
getAnnInpValKind = \case
|
||||||
|
AGScalar _ _ -> "scalar"
|
||||||
|
AGEnum _ _ -> "enum"
|
||||||
|
AGObject _ _ -> "object"
|
||||||
|
AGArray _ _ -> "array"
|
407
server/src-lib/Hasura/GraphQL/RelaySchema.hs
Normal file
407
server/src-lib/Hasura/GraphQL/RelaySchema.hs
Normal file
@ -0,0 +1,407 @@
|
|||||||
|
module Hasura.GraphQL.RelaySchema where
|
||||||
|
|
||||||
|
import Control.Lens.Extended hiding (op)
|
||||||
|
|
||||||
|
import qualified Data.HashMap.Strict as Map
|
||||||
|
import qualified Data.HashSet as Set
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
|
import Hasura.GraphQL.Context
|
||||||
|
import Hasura.GraphQL.Resolve.Types
|
||||||
|
import Hasura.GraphQL.Validate.Types
|
||||||
|
import Hasura.Prelude
|
||||||
|
import Hasura.RQL.Types
|
||||||
|
import Hasura.Server.Utils (duplicates)
|
||||||
|
import Hasura.Session
|
||||||
|
import Hasura.SQL.Types
|
||||||
|
|
||||||
|
import Hasura.GraphQL.Schema
|
||||||
|
import Hasura.GraphQL.Schema.BoolExp
|
||||||
|
import Hasura.GraphQL.Schema.Builder
|
||||||
|
import Hasura.GraphQL.Schema.Common
|
||||||
|
import Hasura.GraphQL.Schema.Function
|
||||||
|
import Hasura.GraphQL.Schema.OrderBy
|
||||||
|
import Hasura.GraphQL.Schema.Select
|
||||||
|
|
||||||
|
mkNodeInterface :: [QualifiedTable] -> IFaceTyInfo
|
||||||
|
mkNodeInterface relayTableNames =
|
||||||
|
let description = G.Description "An object with globally unique ID"
|
||||||
|
in mkIFaceTyInfo (Just description) nodeType (mapFromL _fiName [idField]) $
|
||||||
|
Set.fromList $ map mkTableTy relayTableNames
|
||||||
|
where
|
||||||
|
idField =
|
||||||
|
let description = G.Description "A globally unique identifier"
|
||||||
|
in mkHsraObjFldInfo (Just description) "id" mempty nodeIdType
|
||||||
|
|
||||||
|
mkRelayGCtxMap
|
||||||
|
:: forall m. (MonadError QErr m)
|
||||||
|
=> TableCache -> FunctionCache -> m GCtxMap
|
||||||
|
mkRelayGCtxMap tableCache functionCache = do
|
||||||
|
typesMapL <- mapM (mkRelayGCtxMapTable tableCache functionCache) relayTables
|
||||||
|
typesMap <- combineTypes typesMapL
|
||||||
|
let gCtxMap = flip Map.map typesMap $
|
||||||
|
\(ty, flds, insCtx) -> mkGCtx ty flds insCtx
|
||||||
|
pure $ Map.map (flip RoleContext Nothing) gCtxMap
|
||||||
|
where
|
||||||
|
relayTables =
|
||||||
|
filter (tableFltr . _tiCoreInfo) $ Map.elems tableCache
|
||||||
|
|
||||||
|
tableFltr ti =
|
||||||
|
not (isSystemDefined $ _tciSystemDefined ti)
|
||||||
|
&& isValidObjectName (_tciName ti)
|
||||||
|
&& isJust (_tciPrimaryKey ti)
|
||||||
|
|
||||||
|
combineTypes
|
||||||
|
:: [Map.HashMap RoleName (TyAgg, RootFields, InsCtxMap)]
|
||||||
|
-> m (Map.HashMap RoleName (TyAgg, RootFields, InsCtxMap))
|
||||||
|
combineTypes maps = do
|
||||||
|
let listMap = foldr (Map.unionWith (++) . Map.map pure) mempty maps
|
||||||
|
flip Map.traverseWithKey listMap $ \roleName typeList -> do
|
||||||
|
let relayTableNames = map (_tciName . _tiCoreInfo) relayTables
|
||||||
|
tyAgg = addTypeInfoToTyAgg
|
||||||
|
(TIIFace $ mkNodeInterface relayTableNames) $
|
||||||
|
mconcat $ map (^. _1) typeList
|
||||||
|
insCtx = mconcat $ map (^. _3) typeList
|
||||||
|
rootFields <- combineRootFields roleName $ map (^. _2) typeList
|
||||||
|
pure (tyAgg, rootFields, insCtx)
|
||||||
|
|
||||||
|
combineRootFields :: RoleName -> [RootFields] -> m RootFields
|
||||||
|
combineRootFields roleName rootFields = do
|
||||||
|
let duplicateQueryFields = duplicates $
|
||||||
|
concatMap (Map.keys . _rootQueryFields) rootFields
|
||||||
|
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
|
||||||
|
|
||||||
|
when (not $ null duplicateMutationFields) $
|
||||||
|
throw400 Unexpected $ "following mutation root fields are duplicated: "
|
||||||
|
<> showNames duplicateMutationFields
|
||||||
|
|
||||||
|
pure $ mconcat $ mkNodeQueryRootFields roleName relayTables : rootFields
|
||||||
|
|
||||||
|
mkRelayGCtxMapTable
|
||||||
|
:: (MonadError QErr m)
|
||||||
|
=> TableCache
|
||||||
|
-> FunctionCache
|
||||||
|
-> TableInfo
|
||||||
|
-> m (Map.HashMap RoleName (TyAgg, RootFields, InsCtxMap))
|
||||||
|
mkRelayGCtxMapTable tableCache funcCache tabInfo = do
|
||||||
|
m <- flip Map.traverseWithKey rolePerms $
|
||||||
|
mkRelayGCtxRole tableCache tn descM fields primaryKey validConstraints tabFuncs viewInfo customConfig
|
||||||
|
adminSelFlds <- mkAdminSelFlds fields tableCache
|
||||||
|
adminInsCtx <- mkAdminInsCtx tableCache fields
|
||||||
|
let adminCtx = mkRelayTyAggRole tn descM (Just (cols, icRelations adminInsCtx))
|
||||||
|
(Just (True, adminSelFlds)) (Just cols) (Just ())
|
||||||
|
primaryKey validConstraints viewInfo tabFuncs
|
||||||
|
adminInsCtxMap = Map.singleton tn adminInsCtx
|
||||||
|
return $ Map.insert adminRoleName (adminCtx, adminRootFlds, adminInsCtxMap) m
|
||||||
|
where
|
||||||
|
TableInfo coreInfo rolePerms _ = tabInfo
|
||||||
|
TableCoreInfo tn descM _ fields primaryKey _ _ viewInfo _ customConfig = coreInfo
|
||||||
|
validConstraints = mkValidConstraints $ map _cName (tciUniqueOrPrimaryKeyConstraints coreInfo)
|
||||||
|
tabFuncs = filter (isValidObjectName . fiName) $
|
||||||
|
getFuncsOfTable tn funcCache
|
||||||
|
cols = getValidCols fields
|
||||||
|
adminRootFlds =
|
||||||
|
let insertPermDetails = Just ([], True)
|
||||||
|
selectPermDetails = Just (noFilter, Nothing, [], True)
|
||||||
|
updatePermDetails = Just (getValidCols fields, mempty, noFilter, Nothing, [])
|
||||||
|
deletePermDetails = Just (noFilter, [])
|
||||||
|
|
||||||
|
queryFields = getRelayQueryRootFieldsRole tn primaryKey fields tabFuncs
|
||||||
|
selectPermDetails
|
||||||
|
mutationFields = getMutationRootFieldsRole tn primaryKey
|
||||||
|
validConstraints fields insertPermDetails
|
||||||
|
selectPermDetails updatePermDetails
|
||||||
|
deletePermDetails viewInfo customConfig
|
||||||
|
in RootFields queryFields mutationFields
|
||||||
|
|
||||||
|
mkRelayGCtxRole
|
||||||
|
:: (MonadError QErr m)
|
||||||
|
=> TableCache
|
||||||
|
-> QualifiedTable
|
||||||
|
-> Maybe PGDescription
|
||||||
|
-> FieldInfoMap FieldInfo
|
||||||
|
-> Maybe (PrimaryKey PGColumnInfo)
|
||||||
|
-> [ConstraintName]
|
||||||
|
-> [FunctionInfo]
|
||||||
|
-> Maybe ViewInfo
|
||||||
|
-> TableConfig
|
||||||
|
-> RoleName
|
||||||
|
-> RolePermInfo
|
||||||
|
-> m (TyAgg, RootFields, InsCtxMap)
|
||||||
|
mkRelayGCtxRole tableCache tn descM fields primaryKey constraints funcs viM tabConfigM role permInfo = do
|
||||||
|
selPermM <- mapM (getSelPerm tableCache fields role) selM
|
||||||
|
tabInsInfoM <- forM (_permIns permInfo) $ \ipi -> do
|
||||||
|
ctx <- mkInsCtx role tableCache fields ipi $ _permUpd permInfo
|
||||||
|
let permCols = flip getColInfos allCols $ Set.toList $ ipiCols ipi
|
||||||
|
return (ctx, (permCols, icRelations ctx))
|
||||||
|
let insPermM = snd <$> tabInsInfoM
|
||||||
|
insCtxM = fst <$> tabInsInfoM
|
||||||
|
updColsM = filterColumnFields . upiCols <$> _permUpd permInfo
|
||||||
|
tyAgg = mkRelayTyAggRole tn descM insPermM selPermM updColsM
|
||||||
|
(void $ _permDel permInfo) primaryKey constraints viM funcs
|
||||||
|
queryRootFlds = getRelayQueryRootFieldsRole tn primaryKey fields funcs
|
||||||
|
(mkSel <$> _permSel permInfo)
|
||||||
|
mutationRootFlds = getMutationRootFieldsRole tn primaryKey constraints fields
|
||||||
|
(mkIns <$> insM) (mkSel <$> selM)
|
||||||
|
(mkUpd <$> updM) (mkDel <$> delM) viM tabConfigM
|
||||||
|
insCtxMap = maybe Map.empty (Map.singleton tn) insCtxM
|
||||||
|
return (tyAgg, RootFields queryRootFlds mutationRootFlds, insCtxMap)
|
||||||
|
where
|
||||||
|
RolePermInfo insM selM updM delM = permInfo
|
||||||
|
allCols = getCols fields
|
||||||
|
filterColumnFields allowedSet =
|
||||||
|
filter ((`Set.member` allowedSet) . pgiColumn) $ getValidCols fields
|
||||||
|
mkIns i = (ipiRequiredHeaders i, isJust updM)
|
||||||
|
mkSel s = ( spiFilter s, spiLimit s
|
||||||
|
, spiRequiredHeaders s, spiAllowAgg s
|
||||||
|
)
|
||||||
|
mkUpd u = ( flip getColInfos allCols $ Set.toList $ upiCols u
|
||||||
|
, upiSet u
|
||||||
|
, upiFilter u
|
||||||
|
, upiCheck u
|
||||||
|
, upiRequiredHeaders u
|
||||||
|
)
|
||||||
|
mkDel d = (dpiFilter d, dpiRequiredHeaders d)
|
||||||
|
|
||||||
|
mkRelayTyAggRole
|
||||||
|
:: QualifiedTable
|
||||||
|
-> Maybe PGDescription
|
||||||
|
-- ^ Postgres description
|
||||||
|
-> Maybe ([PGColumnInfo], RelationInfoMap)
|
||||||
|
-- ^ insert permission
|
||||||
|
-> Maybe (Bool, [SelField])
|
||||||
|
-- ^ select permission
|
||||||
|
-> Maybe [PGColumnInfo]
|
||||||
|
-- ^ update cols
|
||||||
|
-> Maybe ()
|
||||||
|
-- ^ delete cols
|
||||||
|
-> Maybe (PrimaryKey PGColumnInfo)
|
||||||
|
-> [ConstraintName]
|
||||||
|
-- ^ constraints
|
||||||
|
-> Maybe ViewInfo
|
||||||
|
-> [FunctionInfo]
|
||||||
|
-- ^ all functions
|
||||||
|
-> TyAgg
|
||||||
|
mkRelayTyAggRole tn descM insPermM selPermM updColsM delPermM pkeyCols constraints viM funcs =
|
||||||
|
let (mutationTypes, mutationFields) =
|
||||||
|
mkMutationTypesAndFieldsRole tn insPermM selFldsM updColsM delPermM pkeyCols constraints viM
|
||||||
|
in TyAgg (mkTyInfoMap allTypes <> mutationTypes)
|
||||||
|
(fieldMap <> mutationFields)
|
||||||
|
scalars ordByCtx
|
||||||
|
where
|
||||||
|
ordByCtx = fromMaybe Map.empty ordByCtxM
|
||||||
|
|
||||||
|
funcInpArgTys = bool [] (map TIInpObj funcArgInpObjs) $ isJust selFldsM
|
||||||
|
|
||||||
|
allTypes = queryTypes <> aggQueryTypes <> funcInpArgTys <> computedFieldFuncArgsInps
|
||||||
|
|
||||||
|
queryTypes = map TIObj selectObjects <>
|
||||||
|
catMaybes
|
||||||
|
[ TIInpObj <$> boolExpInpObjM
|
||||||
|
, TIInpObj <$> ordByInpObjM
|
||||||
|
, TIEnum <$> selColInpTyM
|
||||||
|
]
|
||||||
|
aggQueryTypes = map TIObj aggObjs <> map TIInpObj aggOrdByInps
|
||||||
|
|
||||||
|
fieldMap = Map.unions $ catMaybes [boolExpInpObjFldsM, selObjFldsM]
|
||||||
|
scalars = selByPkScalarSet <> funcArgScalarSet <> computedFieldFuncArgScalars
|
||||||
|
|
||||||
|
selFldsM = snd <$> selPermM
|
||||||
|
selColNamesM = map pgiName . getPGColumnFields <$> selFldsM
|
||||||
|
selColInpTyM = mkSelColumnTy tn <$> selColNamesM
|
||||||
|
-- boolexp input type
|
||||||
|
boolExpInpObjM = case selFldsM of
|
||||||
|
Just selFlds -> Just $ mkBoolExpInp tn selFlds
|
||||||
|
-- no select permission
|
||||||
|
Nothing ->
|
||||||
|
-- but update/delete is defined
|
||||||
|
if isJust updColsM || isJust delPermM
|
||||||
|
then Just $ mkBoolExpInp tn []
|
||||||
|
else Nothing
|
||||||
|
|
||||||
|
-- funcargs input type
|
||||||
|
funcArgInpObjs = flip mapMaybe funcs $ \func ->
|
||||||
|
mkFuncArgsInp (fiName func) (getInputArgs func)
|
||||||
|
-- funcArgCtx = Map.unions funcArgCtxs
|
||||||
|
funcArgScalarSet = funcs ^.. folded.to getInputArgs.folded.to (_qptName.faType)
|
||||||
|
|
||||||
|
-- helper
|
||||||
|
mkFldMap ty = Map.fromList . concatMap (mkFld ty)
|
||||||
|
mkFld ty = \case
|
||||||
|
SFPGColumn ci -> [((ty, pgiName ci), RFPGColumn ci)]
|
||||||
|
SFRelationship (RelationshipFieldInfo relInfo allowAgg cols permFilter permLimit maybePkCols _) ->
|
||||||
|
let relationshipName = riName relInfo
|
||||||
|
relFld = ( (ty, mkRelName relationshipName)
|
||||||
|
, RFRelationship $ RelationshipField relInfo RFKSimple cols permFilter permLimit
|
||||||
|
)
|
||||||
|
aggRelFld = ( (ty, mkAggRelName relationshipName)
|
||||||
|
, RFRelationship $ RelationshipField relInfo RFKAggregate cols permFilter permLimit
|
||||||
|
)
|
||||||
|
maybeConnFld = maybePkCols <&> \pkCols ->
|
||||||
|
( (ty, mkConnectionRelName relationshipName)
|
||||||
|
, RFRelationship $ RelationshipField relInfo
|
||||||
|
(RFKConnection pkCols) cols permFilter permLimit
|
||||||
|
)
|
||||||
|
in case riType relInfo of
|
||||||
|
ObjRel -> [relFld]
|
||||||
|
ArrRel -> bool [relFld] ([relFld, aggRelFld] <> maybe [] pure maybeConnFld) allowAgg
|
||||||
|
SFComputedField cf -> pure
|
||||||
|
( (ty, mkComputedFieldName $ _cfName cf)
|
||||||
|
, RFComputedField cf
|
||||||
|
)
|
||||||
|
SFRemoteRelationship remoteField -> pure
|
||||||
|
( (ty, G.Name (remoteRelationshipNameToText (_rfiName remoteField)))
|
||||||
|
, RFRemoteRelationship remoteField
|
||||||
|
)
|
||||||
|
|
||||||
|
-- the fields used in bool exp
|
||||||
|
boolExpInpObjFldsM = mkFldMap (mkBoolExpTy tn) <$> selFldsM
|
||||||
|
|
||||||
|
-- table obj
|
||||||
|
selectObjects = case selPermM of
|
||||||
|
Just (_, selFlds) ->
|
||||||
|
[ (mkRelayTableObj tn descM selFlds)
|
||||||
|
{_otiImplIFaces = Set.singleton nodeType}
|
||||||
|
, mkTableEdgeObj tn
|
||||||
|
, mkTableConnectionObj tn
|
||||||
|
]
|
||||||
|
Nothing -> []
|
||||||
|
|
||||||
|
-- aggregate objs and order by inputs
|
||||||
|
(aggObjs, aggOrdByInps) = case selPermM of
|
||||||
|
Just (True, selFlds) ->
|
||||||
|
let cols = getPGColumnFields selFlds
|
||||||
|
numCols = onlyNumCols cols
|
||||||
|
compCols = onlyComparableCols cols
|
||||||
|
objs = [ mkTableAggObj tn
|
||||||
|
, mkTableAggregateFieldsObj tn (numCols, numAggregateOps) (compCols, compAggregateOps)
|
||||||
|
] <> mkColAggregateFieldsObjs selFlds
|
||||||
|
ordByInps = mkTabAggOrdByInpObj tn (numCols, numAggregateOps) (compCols, compAggregateOps)
|
||||||
|
: mkTabAggregateOpOrdByInpObjs tn (numCols, numAggregateOps) (compCols, compAggregateOps)
|
||||||
|
in (objs, ordByInps)
|
||||||
|
_ -> ([], [])
|
||||||
|
|
||||||
|
getNumericCols = onlyNumCols . getPGColumnFields
|
||||||
|
getComparableCols = onlyComparableCols . getPGColumnFields
|
||||||
|
onlyFloat = const $ mkScalarTy PGFloat
|
||||||
|
|
||||||
|
mkTypeMaker "sum" = mkColumnType
|
||||||
|
mkTypeMaker _ = onlyFloat
|
||||||
|
|
||||||
|
mkColAggregateFieldsObjs flds =
|
||||||
|
let numCols = getNumericCols flds
|
||||||
|
compCols = getComparableCols flds
|
||||||
|
mkNumObjFld n = mkTableColAggregateFieldsObj tn n (mkTypeMaker n) numCols
|
||||||
|
mkCompObjFld n = mkTableColAggregateFieldsObj tn n mkColumnType compCols
|
||||||
|
numFldsObjs = bool (map mkNumObjFld numAggregateOps) [] $ null numCols
|
||||||
|
compFldsObjs = bool (map mkCompObjFld compAggregateOps) [] $ null compCols
|
||||||
|
in numFldsObjs <> compFldsObjs
|
||||||
|
-- the fields used in table object
|
||||||
|
nodeFieldM = RFNodeId tn . _pkColumns <$> pkeyCols
|
||||||
|
selObjFldsM = mkFldMap (mkTableTy tn) <$> selFldsM >>=
|
||||||
|
\fm -> nodeFieldM <&> \nodeField ->
|
||||||
|
Map.insert (mkTableTy tn, "id") nodeField fm
|
||||||
|
-- the scalar set for table_by_pk arguments
|
||||||
|
selByPkScalarSet = pkeyCols ^.. folded.to _pkColumns.folded.to pgiType._PGColumnScalar
|
||||||
|
|
||||||
|
ordByInpCtxM = mkOrdByInpObj tn <$> selFldsM
|
||||||
|
(ordByInpObjM, ordByCtxM) = case ordByInpCtxM of
|
||||||
|
Just (a, b) -> (Just a, Just b)
|
||||||
|
Nothing -> (Nothing, Nothing)
|
||||||
|
|
||||||
|
-- computed fields' function args input objects and scalar types
|
||||||
|
mkComputedFieldRequiredTypes computedFieldInfo =
|
||||||
|
let ComputedFieldFunction qf inputArgs _ _ _ = _cfFunction computedFieldInfo
|
||||||
|
scalarArgs = map (_qptName . faType) $ toList inputArgs
|
||||||
|
in (, scalarArgs) <$> mkFuncArgsInp qf inputArgs
|
||||||
|
|
||||||
|
computedFieldReqTypes = catMaybes $
|
||||||
|
maybe [] (map mkComputedFieldRequiredTypes . getComputedFields) selFldsM
|
||||||
|
|
||||||
|
computedFieldFuncArgsInps = map (TIInpObj . fst) computedFieldReqTypes
|
||||||
|
computedFieldFuncArgScalars = Set.fromList $ concatMap snd computedFieldReqTypes
|
||||||
|
|
||||||
|
mkSelectOpCtx
|
||||||
|
:: QualifiedTable
|
||||||
|
-> [PGColumnInfo]
|
||||||
|
-> (AnnBoolExpPartialSQL, Maybe Int, [T.Text]) -- select filter
|
||||||
|
-> SelOpCtx
|
||||||
|
mkSelectOpCtx tn allCols (fltr, pLimit, hdrs) =
|
||||||
|
SelOpCtx tn hdrs colGNameMap fltr pLimit
|
||||||
|
where
|
||||||
|
colGNameMap = mkPGColGNameMap allCols
|
||||||
|
|
||||||
|
getRelayQueryRootFieldsRole
|
||||||
|
:: QualifiedTable
|
||||||
|
-> Maybe (PrimaryKey PGColumnInfo)
|
||||||
|
-> FieldInfoMap FieldInfo
|
||||||
|
-> [FunctionInfo]
|
||||||
|
-> Maybe (AnnBoolExpPartialSQL, Maybe Int, [T.Text], Bool) -- select filter
|
||||||
|
-> QueryRootFieldMap
|
||||||
|
getRelayQueryRootFieldsRole tn primaryKey fields funcs selM =
|
||||||
|
makeFieldMap $
|
||||||
|
funcConnectionQueries
|
||||||
|
<> catMaybes
|
||||||
|
[ getSelConnectionDet <$> selM <*> maybePrimaryKeyColumns
|
||||||
|
]
|
||||||
|
where
|
||||||
|
maybePrimaryKeyColumns = fmap _pkColumns primaryKey
|
||||||
|
colGNameMap = mkPGColGNameMap $ getCols fields
|
||||||
|
|
||||||
|
funcConnectionQueries = fromMaybe [] $ getFuncQueryConnectionFlds
|
||||||
|
<$> selM <*> maybePrimaryKeyColumns
|
||||||
|
|
||||||
|
getSelConnectionDet (selFltr, pLimit, hdrs, _) primaryKeyColumns =
|
||||||
|
selFldHelper (QCSelectConnection primaryKeyColumns)
|
||||||
|
(mkSelFldConnection Nothing) selFltr pLimit hdrs
|
||||||
|
|
||||||
|
selFldHelper f g pFltr pLimit hdrs =
|
||||||
|
( f $ mkSelectOpCtx tn (getCols fields) (pFltr, pLimit, hdrs)
|
||||||
|
, g tn
|
||||||
|
)
|
||||||
|
|
||||||
|
getFuncQueryConnectionFlds (selFltr, pLimit, hdrs, _) primaryKeyColumns =
|
||||||
|
funcFldHelper (QCFuncConnection primaryKeyColumns) mkFuncQueryConnectionFld selFltr pLimit hdrs
|
||||||
|
|
||||||
|
funcFldHelper f g pFltr pLimit hdrs =
|
||||||
|
flip map funcs $ \fi ->
|
||||||
|
( f $ FuncQOpCtx (fiName fi) (mkFuncArgItemSeq fi) hdrs colGNameMap pFltr pLimit
|
||||||
|
, g fi $ fiDescription fi
|
||||||
|
)
|
||||||
|
|
||||||
|
mkNodeQueryRootFields :: RoleName -> [TableInfo] -> RootFields
|
||||||
|
mkNodeQueryRootFields roleName relayTables =
|
||||||
|
RootFields (mapFromL (_fiName . snd) [nodeQueryDet]) mempty
|
||||||
|
where
|
||||||
|
nodeQueryDet =
|
||||||
|
( QCNodeSelect nodeSelMap
|
||||||
|
, nodeQueryField
|
||||||
|
)
|
||||||
|
|
||||||
|
nodeQueryField =
|
||||||
|
let nodeParams = fromInpValL $ pure $
|
||||||
|
InpValInfo (Just $ G.Description "A globally unique id")
|
||||||
|
"id" Nothing nodeIdType
|
||||||
|
in mkHsraObjFldInfo Nothing "node" nodeParams $ G.toGT nodeType
|
||||||
|
|
||||||
|
nodeSelMap =
|
||||||
|
Map.fromList $ flip mapMaybe relayTables $ \table ->
|
||||||
|
let tableName = _tciName $ _tiCoreInfo table
|
||||||
|
allColumns = getCols $ _tciFieldInfoMap $ _tiCoreInfo table
|
||||||
|
selectPermM = _permSel <$> Map.lookup roleName
|
||||||
|
(_tiRolePermInfoMap table)
|
||||||
|
permDetailsM = join selectPermM <&> \perm ->
|
||||||
|
( spiFilter perm
|
||||||
|
, spiLimit perm
|
||||||
|
, spiRequiredHeaders perm
|
||||||
|
)
|
||||||
|
adminPermDetails = (noFilter, Nothing, [])
|
||||||
|
in (mkTableTy tableName,) . mkSelectOpCtx tableName allColumns
|
||||||
|
<$> bool permDetailsM (Just adminPermDetails) (isAdmin roleName)
|
@ -12,6 +12,7 @@ module Hasura.GraphQL.Resolve
|
|||||||
, QueryRootFldUnresolved
|
, QueryRootFldUnresolved
|
||||||
, QueryRootFldResolved
|
, QueryRootFldResolved
|
||||||
, toPGQuery
|
, toPGQuery
|
||||||
|
, toSQLFromItem
|
||||||
|
|
||||||
, RIntro.schemaR
|
, RIntro.schemaR
|
||||||
, RIntro.typeR
|
, RIntro.typeR
|
||||||
@ -36,14 +37,17 @@ import qualified Hasura.GraphQL.Resolve.Insert as RI
|
|||||||
import qualified Hasura.GraphQL.Resolve.Introspect as RIntro
|
import qualified Hasura.GraphQL.Resolve.Introspect as RIntro
|
||||||
import qualified Hasura.GraphQL.Resolve.Mutation as RM
|
import qualified Hasura.GraphQL.Resolve.Mutation as RM
|
||||||
import qualified Hasura.GraphQL.Resolve.Select as RS
|
import qualified Hasura.GraphQL.Resolve.Select as RS
|
||||||
|
import qualified Hasura.GraphQL.Schema.Common as GS
|
||||||
import qualified Hasura.GraphQL.Validate as V
|
import qualified Hasura.GraphQL.Validate as V
|
||||||
import qualified Hasura.RQL.DML.Select as DS
|
import qualified Hasura.RQL.DML.Select as DS
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
|
|
||||||
data QueryRootFldAST v
|
data QueryRootFldAST v
|
||||||
= QRFPk !(DS.AnnSimpleSelG v)
|
= QRFNode !(DS.AnnSimpleSelG v)
|
||||||
|
| QRFPk !(DS.AnnSimpleSelG v)
|
||||||
| QRFSimple !(DS.AnnSimpleSelG v)
|
| QRFSimple !(DS.AnnSimpleSelG v)
|
||||||
| QRFAgg !(DS.AnnAggSelG v)
|
| QRFAgg !(DS.AnnAggregateSelectG v)
|
||||||
|
| QRFConnection !(DS.ConnectionSelect v)
|
||||||
| QRFActionSelect !(DS.AnnSimpleSelG v)
|
| QRFActionSelect !(DS.AnnSimpleSelG v)
|
||||||
| QRFActionExecuteObject !(DS.AnnSimpleSelG v)
|
| QRFActionExecuteObject !(DS.AnnSimpleSelG v)
|
||||||
| QRFActionExecuteList !(DS.AnnSimpleSelG v)
|
| QRFActionExecuteList !(DS.AnnSimpleSelG v)
|
||||||
@ -58,21 +62,28 @@ traverseQueryRootFldAST
|
|||||||
-> QueryRootFldAST a
|
-> QueryRootFldAST a
|
||||||
-> f (QueryRootFldAST b)
|
-> f (QueryRootFldAST b)
|
||||||
traverseQueryRootFldAST f = \case
|
traverseQueryRootFldAST f = \case
|
||||||
QRFPk s -> QRFPk <$> DS.traverseAnnSimpleSel f s
|
QRFNode s -> QRFNode <$> DS.traverseAnnSimpleSelectect f s
|
||||||
QRFSimple s -> QRFSimple <$> DS.traverseAnnSimpleSel f s
|
QRFPk s -> QRFPk <$> DS.traverseAnnSimpleSelect f s
|
||||||
QRFAgg s -> QRFAgg <$> DS.traverseAnnAggSel f s
|
QRFSimple s -> QRFSimple <$> DS.traverseAnnSimpleSelect f s
|
||||||
QRFActionSelect s -> QRFActionSelect <$> DS.traverseAnnSimpleSel f s
|
QRFAgg s -> QRFAgg <$> DS.traverseAnnAggregateSelect f s
|
||||||
QRFActionExecuteObject s -> QRFActionExecuteObject <$> DS.traverseAnnSimpleSel f s
|
QRFActionSelect s -> QRFActionSelect <$> DS.traverseAnnSimpleSelect f s
|
||||||
QRFActionExecuteList s -> QRFActionExecuteList <$> DS.traverseAnnSimpleSel f s
|
QRFActionExecuteObject s -> QRFActionExecuteObject <$> DS.traverseAnnSimpleSelect f s
|
||||||
|
QRFActionExecuteList s -> QRFActionExecuteList <$> DS.traverseAnnSimpleSelect f s
|
||||||
|
QRFConnection s -> QRFConnection <$> DS.traverseConnectionSelect f s
|
||||||
|
|
||||||
toPGQuery :: QueryRootFldResolved -> Q.Query
|
toPGQuery :: QueryRootFldResolved -> Q.Query
|
||||||
toPGQuery = \case
|
toPGQuery = \case
|
||||||
QRFPk s -> DS.selectQuerySQL DS.JASSingleObject s
|
QRFNode s -> first (toQuery . DS.mkSQLSelect DS.JASSingleObject) $ RR.getRemoteJoins s
|
||||||
QRFSimple s -> DS.selectQuerySQL DS.JASMultipleRows s
|
QRFPk s -> first (toQuery . DS.mkSQLSelect DS.JASSingleObject) $ RR.getRemoteJoins s
|
||||||
QRFAgg s -> DS.selectAggQuerySQL s
|
QRFSimple s -> first (toQuery . DS.mkSQLSelect DS.JASMultipleRows) $ RR.getRemoteJoins s
|
||||||
QRFActionSelect s -> DS.selectQuerySQL DS.JASSingleObject s
|
QRFAgg s -> first (toQuery . DS.mkAggregateSelect) $ RR.getRemoteJoinsAggregateSelect s
|
||||||
QRFActionExecuteObject s -> DS.selectQuerySQL DS.JASSingleObject s
|
QRFActionSelect s -> first (toQuery . DS.mkSQLSelect DS.JASSingleObject) $ RR.getRemoteJoins s
|
||||||
QRFActionExecuteList s -> DS.selectQuerySQL DS.JASMultipleRows s
|
QRFActionExecuteObject s -> first (toQuery . DS.mkSQLSelect DS.JASSingleObject) $ RR.getRemoteJoins s
|
||||||
|
QRFActionExecuteList s -> first (toQuery . DS.mkSQLSelect DS.JASMultipleRows) $ RR.getRemoteJoins s
|
||||||
|
QRFConnection s -> first (toQuery . DS.mkConnectionSelect) $ RR.getRemoteJoinsConnectionSelect s
|
||||||
|
where
|
||||||
|
toQuery :: ToSQL a => a -> Q.Query
|
||||||
|
toQuery = Q.fromBuilder . toSQL
|
||||||
|
|
||||||
validateHdrs
|
validateHdrs
|
||||||
:: (Foldable t, QErrM m) => UserInfo -> t Text -> m ()
|
:: (Foldable t, QErrM m) => UserInfo -> t Text -> m ()
|
||||||
@ -101,6 +112,13 @@ queryFldToPGAST fld actionExecuter = do
|
|||||||
opCtx <- getOpCtx $ V._fName fld
|
opCtx <- getOpCtx $ V._fName fld
|
||||||
userInfo <- asks getter
|
userInfo <- asks getter
|
||||||
case opCtx of
|
case opCtx of
|
||||||
|
QCNodeSelect nodeSelectMap -> do
|
||||||
|
NodeIdData table pkeyColumnValues <- RS.resolveNodeId fld
|
||||||
|
case Map.lookup (GS.mkTableTy table) nodeSelectMap of
|
||||||
|
Nothing -> throwVE $ "table " <> table <<> " not found"
|
||||||
|
Just selOpCtx -> do
|
||||||
|
validateHdrs userInfo (_socHeaders selOpCtx)
|
||||||
|
QRFNode <$> RS.convertNodeSelect selOpCtx pkeyColumnValues fld
|
||||||
QCSelect ctx -> do
|
QCSelect ctx -> do
|
||||||
validateHdrs userInfo (_socHeaders ctx)
|
validateHdrs userInfo (_socHeaders ctx)
|
||||||
QRFSimple <$> RS.convertSelect ctx fld
|
QRFSimple <$> RS.convertSelect ctx fld
|
||||||
@ -125,13 +143,15 @@ queryFldToPGAST fld actionExecuter = do
|
|||||||
-- an SQL query, but in case of query actions it's converted into JSON
|
-- an SQL query, but in case of query actions it's converted into JSON
|
||||||
-- and included in the action's webhook payload.
|
-- and included in the action's webhook payload.
|
||||||
markNotReusable
|
markNotReusable
|
||||||
let f = case jsonAggType of
|
let jsonAggType = RA.mkJsonAggSelect $ _saecOutputType ctx
|
||||||
|
f = case jsonAggType of
|
||||||
DS.JASMultipleRows -> QRFActionExecuteList
|
DS.JASMultipleRows -> QRFActionExecuteList
|
||||||
DS.JASSingleObject -> QRFActionExecuteObject
|
DS.JASSingleObject -> QRFActionExecuteObject
|
||||||
f <$> actionExecuter (RA.resolveActionQuery fld ctx (userVars userInfo))
|
f <$> actionExecuter (RA.resolveActionQuery fld ctx (_uiSession userInfo))
|
||||||
where
|
QCSelectConnection pk ctx ->
|
||||||
outputType = _saecOutputType ctx
|
QRFConnection <$> RS.convertConnectionSelect pk ctx fld
|
||||||
jsonAggType = RA.mkJsonAggSelect outputType
|
QCFuncConnection pk ctx ->
|
||||||
|
QRFConnection <$> RS.convertConnectionFuncQuery pk ctx fld
|
||||||
|
|
||||||
mutFldToTx
|
mutFldToTx
|
||||||
:: ( HasVersion
|
:: ( HasVersion
|
||||||
@ -187,3 +207,17 @@ getOpCtx f = do
|
|||||||
opCtxMap <- asks getter
|
opCtxMap <- asks getter
|
||||||
onNothing (Map.lookup f opCtxMap) $ throw500 $
|
onNothing (Map.lookup f opCtxMap) $ throw500 $
|
||||||
"lookup failed: opctx: " <> showName f
|
"lookup failed: opctx: " <> showName f
|
||||||
|
|
||||||
|
toSQLFromItem :: S.Alias -> QueryRootFldResolved -> S.FromItem
|
||||||
|
toSQLFromItem alias = \case
|
||||||
|
QRFNode s -> fromSelect $ DS.mkSQLSelect DS.JASSingleObject s
|
||||||
|
QRFPk s -> fromSelect $ DS.mkSQLSelect DS.JASSingleObject s
|
||||||
|
QRFSimple s -> fromSelect $ DS.mkSQLSelect DS.JASMultipleRows s
|
||||||
|
QRFAgg s -> fromSelect $ DS.mkAggregateSelect s
|
||||||
|
QRFActionSelect s -> fromSelect $ DS.mkSQLSelect DS.JASSingleObject s
|
||||||
|
QRFActionExecuteObject s -> fromSelect $ DS.mkSQLSelect DS.JASSingleObject s
|
||||||
|
QRFActionExecuteList s -> fromSelect $ DS.mkSQLSelect DS.JASSingleObject s
|
||||||
|
QRFConnection s -> flip (S.FISelectWith (S.Lateral False)) alias
|
||||||
|
$ DS.mkConnectionSelect s
|
||||||
|
where
|
||||||
|
fromSelect = flip (S.FISelect (S.Lateral False)) alias
|
||||||
|
@ -36,6 +36,16 @@ import qualified Network.Wreq as Wreq
|
|||||||
|
|
||||||
import qualified Hasura.RQL.DML.Select as RS
|
import qualified Hasura.RQL.DML.Select as RS
|
||||||
|
|
||||||
|
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.ByteString.Lazy as BL
|
||||||
|
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 Hasura.EncJSON
|
import Hasura.EncJSON
|
||||||
import Hasura.GraphQL.Execute.Prepare
|
import Hasura.GraphQL.Execute.Prepare
|
||||||
import Hasura.GraphQL.Parser
|
import Hasura.GraphQL.Parser
|
||||||
@ -48,9 +58,34 @@ import Hasura.RQL.Types
|
|||||||
import Hasura.RQL.Types.Run
|
import Hasura.RQL.Types.Run
|
||||||
import Hasura.Server.Utils (mkClientHeadersForward, mkSetCookieHeaders)
|
import Hasura.Server.Utils (mkClientHeadersForward, mkSetCookieHeaders)
|
||||||
import Hasura.Server.Version (HasVersion)
|
import Hasura.Server.Version (HasVersion)
|
||||||
|
import Hasura.Session
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
import Hasura.SQL.Value (PGScalarValue (..), toTxtValue)
|
import Hasura.SQL.Value (PGScalarValue (..), toTxtValue)
|
||||||
|
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
|
||||||
|
import qualified Hasura.RQL.DML.RemoteJoin as RJ
|
||||||
|
import qualified Hasura.RQL.DML.Select as RS
|
||||||
|
|
||||||
|
import Hasura.EncJSON
|
||||||
|
-- import Hasura.GraphQL.Resolve.Context
|
||||||
|
-- import Hasura.GraphQL.Resolve.InputValue
|
||||||
|
-- import Hasura.GraphQL.Resolve.Select (processTableSelectionSet)
|
||||||
|
-- import Hasura.GraphQL.Validate.SelectionSet
|
||||||
|
import Hasura.HTTP
|
||||||
|
import Hasura.RQL.DDL.Headers (makeHeadersFromConf, toHeadersConf)
|
||||||
|
import Hasura.RQL.DDL.Schema.Cache
|
||||||
|
import Hasura.RQL.DML.Select (asSingleRowJsonResp)
|
||||||
|
import Hasura.RQL.Types
|
||||||
|
import Hasura.RQL.Types.Run
|
||||||
|
import Hasura.Server.Utils (mkClientHeadersForward, mkSetCookieHeaders)
|
||||||
|
import Hasura.Server.Version (HasVersion)
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
|
import Hasura.SQL.Types
|
||||||
|
import Hasura.SQL.Value (PGScalarValue (..), toTxtValue)
|
||||||
|
|
||||||
newtype ActionContext
|
newtype ActionContext
|
||||||
= ActionContext {_acName :: ActionName}
|
= ActionContext {_acName :: ActionName}
|
||||||
@ -136,10 +171,11 @@ resolveActionExecution
|
|||||||
, MonadError QErr m
|
, MonadError QErr m
|
||||||
, MonadIO m
|
, MonadIO m
|
||||||
)
|
)
|
||||||
=> AnnActionExecution UnpreparedValue
|
=> UserInfo
|
||||||
|
-> AnnActionExecution UnpreparedValue
|
||||||
-> ActionExecContext
|
-> ActionExecContext
|
||||||
-> m (RespTx, HTTP.ResponseHeaders)
|
-> m (RespTx, HTTP.ResponseHeaders)
|
||||||
resolveActionExecution annAction execContext = do
|
resolveActionExecution userInfo annAction execContext = do
|
||||||
let actionContext = ActionContext actionName
|
let actionContext = ActionContext actionName
|
||||||
handlerPayload = ActionWebhookPayload actionContext sessionVariables inputPayload
|
handlerPayload = ActionWebhookPayload actionContext sessionVariables inputPayload
|
||||||
(webhookRes, respHeaders) <- callWebhook manager outputType outputFields reqHeaders confHeaders
|
(webhookRes, respHeaders) <- callWebhook manager outputType outputFields reqHeaders confHeaders
|
||||||
@ -148,9 +184,17 @@ resolveActionExecution annAction execContext = do
|
|||||||
toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes
|
toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes
|
||||||
selectAstUnresolved = processOutputSelectionSet webhookResponseExpression
|
selectAstUnresolved = processOutputSelectionSet webhookResponseExpression
|
||||||
outputType definitionList annFields stringifyNum
|
outputType definitionList annFields stringifyNum
|
||||||
astResolved <- RS.traverseAnnSimpleSel (pure . unpreparedToTextSQL) selectAstUnresolved
|
astResolved <- RS.traverseAnnSimpleSelect (pure . unpreparedToTextSQL) selectAstUnresolved
|
||||||
let jsonAggType = mkJsonAggSelect outputType
|
let (astResolvedWithoutRemoteJoins,maybeRemoteJoins) = RJ.getRemoteJoins astResolved
|
||||||
return $ (,respHeaders) $ asSingleRowJsonResp (RS.selectQuerySQL jsonAggType astResolved) []
|
jsonAggType = mkJsonAggSelect outputType
|
||||||
|
return $ (,respHeaders) $
|
||||||
|
case maybeRemoteJoins of
|
||||||
|
Just remoteJoins ->
|
||||||
|
let query = Q.fromBuilder $ toSQL $
|
||||||
|
RS.mkSQLSelect jsonAggType astResolvedWithoutRemoteJoins
|
||||||
|
in RJ.executeQueryWithRemoteJoins manager reqHeaders userInfo query [] remoteJoins
|
||||||
|
Nothing ->
|
||||||
|
asSingleRowJsonResp (Q.fromBuilder $ toSQL $ RS.mkSQLSelect jsonAggType astResolved) []
|
||||||
where
|
where
|
||||||
AnnActionExecution actionName outputType annFields inputPayload
|
AnnActionExecution actionName outputType annFields inputPayload
|
||||||
outputFields definitionList resolvedWebhook confHeaders
|
outputFields definitionList resolvedWebhook confHeaders
|
||||||
@ -177,10 +221,17 @@ restrictActionExecuter errMsg _ =
|
|||||||
|
|
||||||
-- resolveActionQuery
|
-- resolveActionQuery
|
||||||
-- :: ( HasVersion
|
-- :: ( HasVersion
|
||||||
|
-- , MonadReusability m
|
||||||
-- , MonadError QErr m
|
-- , MonadError QErr m
|
||||||
|
-- , MonadReader r m
|
||||||
-- , MonadIO m
|
-- , MonadIO m
|
||||||
|
-- , Has FieldMap r
|
||||||
|
-- , Has OrdByCtx r
|
||||||
|
-- , Has SQLGenCtx r
|
||||||
-- )
|
-- )
|
||||||
-- => UserVars
|
-- => Field
|
||||||
|
-- -> ActionExecutionContext
|
||||||
|
-- -> SessionVariables
|
||||||
-- -> HTTP.Manager
|
-- -> HTTP.Manager
|
||||||
-- -> [HTTP.Header]
|
-- -> [HTTP.Header]
|
||||||
-- -> m (RS.AnnSimpleSelG UnresolvedVal)
|
-- -> m (RS.AnnSimpleSelG UnresolvedVal)
|
||||||
@ -192,9 +243,10 @@ restrictActionExecuter errMsg _ =
|
|||||||
-- forwardClientHeaders resolvedWebhook handlerPayload
|
-- forwardClientHeaders resolvedWebhook handlerPayload
|
||||||
-- let webhookResponseExpression = RS.AEInput $ UVSQL $
|
-- let webhookResponseExpression = RS.AEInput $ UVSQL $
|
||||||
-- toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes
|
-- toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes
|
||||||
|
-- selSet <- asObjectSelectionSet $ _fSelSet field
|
||||||
-- selectAstUnresolved <-
|
-- selectAstUnresolved <-
|
||||||
-- processOutputSelectionSet webhookResponseExpression outputType definitionList
|
-- processOutputSelectionSet webhookResponseExpression outputType definitionList
|
||||||
-- (_fType field) $ _fSelSet field
|
-- (_fType field) selSet
|
||||||
-- return selectAstUnresolved
|
-- return selectAstUnresolved
|
||||||
-- where
|
-- where
|
||||||
-- ActionExecutionContext actionName outputType outputFields definitionList resolvedWebhook confHeaders
|
-- ActionExecutionContext actionName outputType outputFields definitionList resolvedWebhook confHeaders
|
||||||
@ -254,12 +306,12 @@ resolveAsyncActionQuery
|
|||||||
-> RS.AnnSimpleSelG UnpreparedValue
|
-> RS.AnnSimpleSelG UnpreparedValue
|
||||||
resolveAsyncActionQuery userInfo annAction =
|
resolveAsyncActionQuery userInfo annAction =
|
||||||
let annotatedFields = asyncFields <&> second \case
|
let annotatedFields = asyncFields <&> second \case
|
||||||
AsyncTypename t -> RS.FExp t
|
AsyncTypename t -> RS.AFExpression t
|
||||||
AsyncOutput annFields ->
|
AsyncOutput annFields ->
|
||||||
-- See Note [Resolving async action query/subscription]
|
-- See Note [Resolving async action query/subscription]
|
||||||
let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload"
|
let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload"
|
||||||
jsonAggSelect = mkJsonAggSelect outputType
|
jsonAggSelect = mkJsonAggSelect outputType
|
||||||
in RS.FComputedField $ RS.CFSTable jsonAggSelect $
|
in RS.AFComputedField $ RS.CFSTable jsonAggSelect $
|
||||||
processOutputSelectionSet inputTableArgument outputType
|
processOutputSelectionSet inputTableArgument outputType
|
||||||
definitionList annFields stringifyNumerics
|
definitionList annFields stringifyNumerics
|
||||||
|
|
||||||
@ -268,20 +320,20 @@ resolveAsyncActionQuery userInfo annAction =
|
|||||||
AsyncErrors -> mkAnnFldFromPGCol "errors" PGJSONB
|
AsyncErrors -> mkAnnFldFromPGCol "errors" PGJSONB
|
||||||
|
|
||||||
tableFromExp = RS.FromTable actionLogTable
|
tableFromExp = RS.FromTable actionLogTable
|
||||||
tableArguments = RS.noTableArgs
|
tableArguments = RS.noSelectArgs
|
||||||
{ RS._taWhere = Just tableBoolExpression}
|
{ RS._saWhere = Just tableBoolExpression}
|
||||||
tablePermissions = RS.TablePerm annBoolExpTrue Nothing
|
tablePermissions = RS.TablePerm annBoolExpTrue Nothing
|
||||||
|
|
||||||
in RS.AnnSelG annotatedFields tableFromExp tablePermissions
|
in RS.AnnSelectG annotatedFields tableFromExp tablePermissions
|
||||||
tableArguments stringifyNumerics
|
tableArguments stringifyNumerics
|
||||||
where
|
where
|
||||||
AnnActionAsyncQuery actionName actionId outputType asyncFields definitionList stringifyNumerics = annAction
|
AnnActionAsyncQuery actionName actionId outputType asyncFields definitionList stringifyNumerics = annAction
|
||||||
actionLogTable = QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log")
|
actionLogTable = QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log")
|
||||||
|
|
||||||
-- TODO:- Avoid using PGColumnInfo
|
-- TODO:- Avoid using PGColumnInfo
|
||||||
mkAnnFldFromPGCol col columnType =
|
mkAnnFldFromPGCol column columnType =
|
||||||
flip RS.mkAnnColField Nothing $
|
flip RS.mkAnnColumnField Nothing $
|
||||||
PGColumnInfo (unsafePGCol col) (G.unsafeMkName col) 0 (PGColumnScalar columnType) True Nothing
|
PGColumnInfo (unsafePGCol column) (G.unsafeMkName column) 0 (PGColumnScalar columnType) True Nothing
|
||||||
|
|
||||||
tableBoolExpression =
|
tableBoolExpression =
|
||||||
let actionIdColumnInfo = PGColumnInfo (unsafePGCol "id") $$(G.litName "id")
|
let actionIdColumnInfo = PGColumnInfo (unsafePGCol "id") $$(G.litName "id")
|
||||||
@ -510,12 +562,12 @@ processOutputSelectionSet
|
|||||||
:: RS.ArgumentExp v
|
:: RS.ArgumentExp v
|
||||||
-> GraphQLType
|
-> GraphQLType
|
||||||
-> [(PGCol, PGScalarType)]
|
-> [(PGCol, PGScalarType)]
|
||||||
-> RS.AnnFldsG v
|
-> RS.AnnFieldsG v
|
||||||
-> Bool
|
-> Bool
|
||||||
-> RS.AnnSimpleSelG v
|
-> RS.AnnSimpleSelG v
|
||||||
processOutputSelectionSet tableRowInput actionOutputType definitionList
|
processOutputSelectionSet tableRowInput actionOutputType definitionList
|
||||||
annotatedFields =
|
annotatedFields =
|
||||||
RS.AnnSelG annotatedFields selectFrom RS.noTablePermissions RS.noTableArgs
|
RS.AnnSelectG annotatedFields selectFrom RS.noTablePermissions RS.noSelectArgs
|
||||||
where
|
where
|
||||||
jsonbToPostgresRecordFunction =
|
jsonbToPostgresRecordFunction =
|
||||||
QualifiedObject "pg_catalog" $ FunctionName $
|
QualifiedObject "pg_catalog" $ FunctionName $
|
||||||
|
@ -169,6 +169,10 @@ parseColExp nt n val = do
|
|||||||
fmapAnnBoolExp partialSQLExpToUnresolvedVal permExp
|
fmapAnnBoolExp partialSQLExpToUnresolvedVal permExp
|
||||||
RFComputedField _ -> throw500
|
RFComputedField _ -> throw500
|
||||||
"computed fields are not allowed in bool_exp"
|
"computed fields are not allowed in bool_exp"
|
||||||
|
RFRemoteRelationship _ -> throw500
|
||||||
|
"remote relationships are not allowed in bool_exp"
|
||||||
|
RFNodeId _ _ -> throw500
|
||||||
|
"node id is not allowed in bool_exp"
|
||||||
|
|
||||||
parseBoolExp
|
parseBoolExp
|
||||||
:: ( MonadReusability m
|
:: ( MonadReusability m
|
||||||
|
@ -23,7 +23,7 @@ module Hasura.GraphQL.Resolve.Context
|
|||||||
|
|
||||||
, txtConverter
|
, txtConverter
|
||||||
|
|
||||||
, withSelSet
|
, traverseObjectSelectionSet
|
||||||
, fieldAsPath
|
, fieldAsPath
|
||||||
, resolvePGCol
|
, resolvePGCol
|
||||||
, module Hasura.GraphQL.Utils
|
, module Hasura.GraphQL.Utils
|
||||||
@ -33,21 +33,21 @@ module Hasura.GraphQL.Resolve.Context
|
|||||||
import Data.Has
|
import Data.Has
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.HashMap.Strict as Map
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
import qualified Database.PG.Query as Q
|
import qualified Database.PG.Query as Q
|
||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
import Hasura.GraphQL.Resolve.Types
|
import Hasura.GraphQL.Resolve.Types
|
||||||
import Hasura.GraphQL.Utils
|
import Hasura.GraphQL.Utils
|
||||||
import Hasura.GraphQL.Validate.Field
|
import Hasura.GraphQL.Validate.SelectionSet
|
||||||
import Hasura.GraphQL.Validate.Types
|
import Hasura.GraphQL.Validate.Types
|
||||||
import Hasura.RQL.DML.Internal (currentSession, sessVarFromCurrentSetting)
|
import Hasura.RQL.DML.Internal (currentSession, sessVarFromCurrentSetting)
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
import Hasura.SQL.Value
|
import Hasura.SQL.Value
|
||||||
|
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
|
|
||||||
getFldInfo
|
getFldInfo
|
||||||
:: (MonadError QErr m, MonadReader r m, Has FieldMap r)
|
:: (MonadError QErr m, MonadReader r m, Has FieldMap r)
|
||||||
@ -65,9 +65,11 @@ getPGColInfo
|
|||||||
getPGColInfo nt n = do
|
getPGColInfo nt n = do
|
||||||
fldInfo <- getFldInfo nt n
|
fldInfo <- getFldInfo nt n
|
||||||
case fldInfo of
|
case fldInfo of
|
||||||
RFPGColumn pgColInfo -> return pgColInfo
|
RFPGColumn pgColInfo -> return pgColInfo
|
||||||
RFRelationship _ -> throw500 $ mkErrMsg "relation"
|
RFRelationship _ -> throw500 $ mkErrMsg "relation"
|
||||||
RFComputedField _ -> throw500 $ mkErrMsg "computed field"
|
RFComputedField _ -> throw500 $ mkErrMsg "computed field"
|
||||||
|
RFRemoteRelationship _ -> throw500 $ mkErrMsg "remote relationship"
|
||||||
|
RFNodeId _ _ -> throw500 $ mkErrMsg "node id"
|
||||||
where
|
where
|
||||||
mkErrMsg ty =
|
mkErrMsg ty =
|
||||||
"found " <> ty <> " when expecting pgcolinfo for "
|
"found " <> ty <> " when expecting pgcolinfo for "
|
||||||
@ -139,12 +141,6 @@ prepareColVal (WithScalarType scalarType colVal) = do
|
|||||||
txtConverter :: Applicative f => AnnPGVal -> f S.SQLExp
|
txtConverter :: Applicative f => AnnPGVal -> f S.SQLExp
|
||||||
txtConverter (AnnPGVal _ _ scalarValue) = pure $ toTxtValue scalarValue
|
txtConverter (AnnPGVal _ _ scalarValue) = pure $ toTxtValue scalarValue
|
||||||
|
|
||||||
withSelSet :: (Monad m) => SelSet -> (Field -> m a) -> m [(Text, a)]
|
|
||||||
withSelSet selSet f =
|
|
||||||
forM (toList selSet) $ \fld -> do
|
|
||||||
res <- f fld
|
|
||||||
return (G.unName $ G.unAlias $ _fAlias fld, res)
|
|
||||||
|
|
||||||
fieldAsPath :: (MonadError QErr m) => Field -> m a -> m a
|
fieldAsPath :: (MonadError QErr m) => Field -> m a -> m a
|
||||||
fieldAsPath = nameAsPath . _fName
|
fieldAsPath = nameAsPath . _fName
|
||||||
|
|
||||||
|
@ -8,34 +8,36 @@ import Data.Has
|
|||||||
import Hasura.EncJSON
|
import Hasura.EncJSON
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
|
|
||||||
import qualified Data.Aeson as J
|
import qualified Data.Aeson as J
|
||||||
import qualified Data.Aeson.Casing as J
|
import qualified Data.Aeson.Casing as J
|
||||||
import qualified Data.Aeson.TH as J
|
import qualified Data.Aeson.TH as J
|
||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.HashMap.Strict as Map
|
||||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
import qualified Database.PG.Query as Q
|
import qualified Database.PG.Query as Q
|
||||||
import qualified Hasura.RQL.DML.Insert as RI
|
import qualified Hasura.RQL.DML.Insert as RI
|
||||||
import qualified Hasura.RQL.DML.Returning as RR
|
import qualified Hasura.RQL.DML.Returning as RR
|
||||||
|
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
|
|
||||||
import Hasura.GraphQL.Resolve.BoolExp
|
import Hasura.GraphQL.Resolve.BoolExp
|
||||||
import Hasura.GraphQL.Resolve.Context
|
import Hasura.GraphQL.Resolve.Context
|
||||||
import Hasura.GraphQL.Resolve.InputValue
|
import Hasura.GraphQL.Resolve.InputValue
|
||||||
import Hasura.GraphQL.Resolve.Mutation
|
import Hasura.GraphQL.Resolve.Mutation
|
||||||
import Hasura.GraphQL.Resolve.Select
|
import Hasura.GraphQL.Resolve.Select
|
||||||
import Hasura.GraphQL.Validate.Field
|
import Hasura.GraphQL.Validate.SelectionSet
|
||||||
import Hasura.GraphQL.Validate.Types
|
import Hasura.GraphQL.Validate.Types
|
||||||
import Hasura.RQL.DML.Insert (insertOrUpdateCheckExpr)
|
import Hasura.RQL.DML.Insert (insertOrUpdateCheckExpr)
|
||||||
import Hasura.RQL.DML.Internal (convAnnBoolExpPartialSQL, convPartialSQLExp,
|
import Hasura.RQL.DML.Internal (convAnnBoolExpPartialSQL, convPartialSQLExp,
|
||||||
dmlTxErrorHandler, sessVarFromCurrentSetting)
|
sessVarFromCurrentSetting)
|
||||||
import Hasura.RQL.DML.Mutation
|
import Hasura.RQL.DML.Mutation
|
||||||
import Hasura.RQL.GBoolExp (toSQLBoolExp)
|
import Hasura.RQL.DML.RemoteJoin
|
||||||
|
import Hasura.RQL.GBoolExp (toSQLBoolExp)
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
|
import Hasura.Server.Version (HasVersion)
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
import Hasura.SQL.Value
|
import Hasura.SQL.Value
|
||||||
|
|
||||||
@ -473,7 +475,8 @@ convertInsert
|
|||||||
-> Field -- the mutation field
|
-> Field -- the mutation field
|
||||||
-> m RespTx
|
-> m RespTx
|
||||||
convertInsert role tn fld = prefixErrPath fld $ do
|
convertInsert role tn fld = prefixErrPath fld $ do
|
||||||
mutOutputUnres <- RR.MOutMultirowFields <$> resolveMutationFields (_fType fld) (_fSelSet fld)
|
selSet <- asObjectSelectionSet $ _fSelSet fld
|
||||||
|
mutOutputUnres <- RR.MOutMultirowFields <$> resolveMutationFields (_fType fld) selSet
|
||||||
mutOutputRes <- RR.traverseMutationOutput resolveValTxt mutOutputUnres
|
mutOutputRes <- RR.traverseMutationOutput resolveValTxt mutOutputUnres
|
||||||
annVals <- withArg arguments "objects" asArray
|
annVals <- withArg arguments "objects" asArray
|
||||||
-- if insert input objects is empty array then
|
-- if insert input objects is empty array then
|
||||||
@ -508,7 +511,8 @@ convertInsertOne
|
|||||||
-> Field -- the mutation field
|
-> Field -- the mutation field
|
||||||
-> m RespTx
|
-> m RespTx
|
||||||
convertInsertOne role qt field = prefixErrPath field $ do
|
convertInsertOne role qt field = prefixErrPath field $ do
|
||||||
tableSelFields <- processTableSelectionSet (_fType field) $ _fSelSet field
|
selSet <- asObjectSelectionSet $ _fSelSet field
|
||||||
|
tableSelFields <- processTableSelectionSet (_fType field) selSet
|
||||||
let mutationOutputUnresolved = RR.MOutSinglerowObject tableSelFields
|
let mutationOutputUnresolved = RR.MOutSinglerowObject tableSelFields
|
||||||
mutationOutputResolved <- RR.traverseMutationOutput resolveValTxt mutationOutputUnresolved
|
mutationOutputResolved <- RR.traverseMutationOutput resolveValTxt mutationOutputUnresolved
|
||||||
annInputObj <- withArg arguments "object" asObject
|
annInputObj <- withArg arguments "object" asObject
|
||||||
|
@ -6,17 +6,19 @@ module Hasura.GraphQL.Resolve.Introspect
|
|||||||
import Data.Has
|
import Data.Has
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
|
|
||||||
import qualified Data.Aeson as J
|
import qualified Data.Aeson as J
|
||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.HashMap.Strict as Map
|
||||||
import qualified Data.HashSet as Set
|
import qualified Data.HashSet as Set
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Hasura.SQL.Types as S
|
||||||
|
import qualified Hasura.SQL.Value as S
|
||||||
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
import Hasura.GraphQL.Resolve.Context
|
import Hasura.GraphQL.Resolve.Context
|
||||||
import Hasura.GraphQL.Resolve.InputValue
|
import Hasura.GraphQL.Resolve.InputValue
|
||||||
import Hasura.GraphQL.Validate.Context
|
import Hasura.GraphQL.Validate.Context
|
||||||
import Hasura.GraphQL.Validate.Field
|
|
||||||
import Hasura.GraphQL.Validate.InputValue
|
import Hasura.GraphQL.Validate.InputValue
|
||||||
|
import Hasura.GraphQL.Validate.SelectionSet
|
||||||
import Hasura.GraphQL.Validate.Types
|
import Hasura.GraphQL.Validate.Types
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
|
|
||||||
@ -35,14 +37,15 @@ instance J.ToJSON TypeKind where
|
|||||||
toJSON = J.toJSON . T.pack . drop 2 . show
|
toJSON = J.toJSON . T.pack . drop 2 . show
|
||||||
|
|
||||||
withSubFields
|
withSubFields
|
||||||
:: (Monad m)
|
:: (MonadError QErr m)
|
||||||
=> SelSet
|
=> SelectionSet
|
||||||
-> (Field -> m J.Value)
|
-> (Field -> m J.Value)
|
||||||
-> m J.Object
|
-> m J.Object
|
||||||
withSubFields selSet fn =
|
withSubFields selSet fn = do
|
||||||
fmap Map.fromList $ forM (toList selSet) $ \fld -> do
|
objectSelectionSet <- asObjectSelectionSet selSet
|
||||||
val <- fn fld
|
Map.fromList <$> traverseObjectSelectionSet objectSelectionSet fn
|
||||||
return (G.unName $ G.unAlias $ _fAlias fld, val)
|
-- val <- fn fld
|
||||||
|
-- return (G.unName $ G.unAlias $ _fAlias fld, val)
|
||||||
|
|
||||||
namedTyToTxt :: G.NamedType -> Text
|
namedTyToTxt :: G.NamedType -> Text
|
||||||
namedTyToTxt = G.unName . G.unNamedType
|
namedTyToTxt = G.unName . G.unNamedType
|
||||||
@ -101,9 +104,9 @@ notBuiltinFld f =
|
|||||||
|
|
||||||
getImplTypes :: (MonadReader t m, Has TypeMap t) => AsObjType -> m [ObjTyInfo]
|
getImplTypes :: (MonadReader t m, Has TypeMap t) => AsObjType -> m [ObjTyInfo]
|
||||||
getImplTypes aot = do
|
getImplTypes aot = do
|
||||||
tyInfo :: TypeMap <- asks getter
|
tyInfo <- asks getter
|
||||||
return $ sortOn _otiName $
|
return $ sortOn _otiName $
|
||||||
Map.elems $ getPossibleObjTypes' tyInfo aot
|
Map.elems $ getPossibleObjTypes tyInfo aot
|
||||||
|
|
||||||
-- 4.5.2.3
|
-- 4.5.2.3
|
||||||
unionR
|
unionR
|
||||||
@ -139,19 +142,24 @@ ifaceR'
|
|||||||
=> IFaceTyInfo
|
=> IFaceTyInfo
|
||||||
-> Field
|
-> Field
|
||||||
-> m J.Object
|
-> m J.Object
|
||||||
ifaceR' i@(IFaceTyInfo descM n flds) fld =
|
ifaceR' ifaceTyInfo fld = do
|
||||||
|
dummyReadIncludeDeprecated fld
|
||||||
withSubFields (_fSelSet fld) $ \subFld ->
|
withSubFields (_fSelSet fld) $ \subFld ->
|
||||||
case _fName subFld of
|
case _fName subFld of
|
||||||
"__typename" -> retJT "__Type"
|
"__typename" -> retJT "__Type"
|
||||||
"kind" -> retJ TKINTERFACE
|
"kind" -> retJ TKINTERFACE
|
||||||
"name" -> retJ $ namedTyToTxt n
|
"name" -> retJ $ namedTyToTxt name
|
||||||
"description" -> retJ $ fmap G.unDescription descM
|
"description" -> retJ $ fmap G.unDescription maybeDescription
|
||||||
"fields" -> fmap J.toJSON $ mapM (`fieldR` subFld) $
|
"fields" -> fmap J.toJSON $ mapM (`fieldR` subFld) $
|
||||||
sortOn _fiName $
|
sortOn _fiName $
|
||||||
filter notBuiltinFld $ Map.elems flds
|
filter notBuiltinFld $ Map.elems fields
|
||||||
"possibleTypes" -> fmap J.toJSON $ mapM (`objectTypeR` subFld)
|
"possibleTypes" -> fmap J.toJSON $ mapM (`objectTypeR` subFld)
|
||||||
=<< getImplTypes (AOTIFace i)
|
=<< getImplTypes (AOTIFace ifaceTyInfo)
|
||||||
_ -> return J.Null
|
_ -> return J.Null
|
||||||
|
where
|
||||||
|
maybeDescription = _ifDesc ifaceTyInfo
|
||||||
|
name = _ifName ifaceTyInfo
|
||||||
|
fields = _ifFields ifaceTyInfo
|
||||||
|
|
||||||
-- 4.5.2.5
|
-- 4.5.2.5
|
||||||
enumTypeR
|
enumTypeR
|
||||||
@ -161,14 +169,64 @@ enumTypeR
|
|||||||
-> m J.Object
|
-> m J.Object
|
||||||
enumTypeR (EnumTyInfo descM n vals _) fld =
|
enumTypeR (EnumTyInfo descM n vals _) fld =
|
||||||
withSubFields (_fSelSet fld) $ \subFld ->
|
withSubFields (_fSelSet fld) $ \subFld ->
|
||||||
case _fName subFld of
|
case _fName subFld of
|
||||||
"__typename" -> retJT "__Type"
|
"__typename" -> retJT "__Type"
|
||||||
"kind" -> retJ TKENUM
|
"kind" -> retJ TKENUM
|
||||||
"name" -> retJ $ namedTyToTxt n
|
"name" -> retJ $ namedTyToTxt n
|
||||||
"description" -> retJ $ fmap G.unDescription descM
|
"description" -> retJ $ fmap G.unDescription descM
|
||||||
"enumValues" -> fmap J.toJSON $ mapM (enumValueR subFld) $
|
"enumValues" -> do
|
||||||
sortOn _eviVal $ Map.elems (normalizeEnumValues vals)
|
includeDeprecated <- readIncludeDeprecated subFld
|
||||||
_ -> return J.Null
|
fmap J.toJSON $
|
||||||
|
mapM (enumValueR subFld) $
|
||||||
|
filter (\val -> includeDeprecated || not (_eviIsDeprecated val)) $
|
||||||
|
sortOn _eviVal $
|
||||||
|
Map.elems (normalizeEnumValues vals)
|
||||||
|
_ -> return J.Null
|
||||||
|
|
||||||
|
readIncludeDeprecated
|
||||||
|
:: ( Monad m, MonadReusability m, MonadError QErr m )
|
||||||
|
=> Field
|
||||||
|
-> m Bool
|
||||||
|
readIncludeDeprecated subFld = do
|
||||||
|
let argM = Map.lookup "includeDeprecated" (_fArguments subFld)
|
||||||
|
case argM of
|
||||||
|
Nothing -> pure False
|
||||||
|
Just arg -> asScalarVal arg S.PGBoolean >>= \case
|
||||||
|
S.PGValBoolean b -> pure b
|
||||||
|
_ -> throw500 "unexpected non-Boolean argument for includeDeprecated"
|
||||||
|
|
||||||
|
{- Note [Reusability of introspection queries with variables]
|
||||||
|
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
|
||||||
|
Introspection queries can have variables, too, in particular to influence one of
|
||||||
|
two arguments: the @name@ argument of the @__type@ field, and the
|
||||||
|
@includeDeprecated@ argument of the @fields@ and @enumValues@ fields. The
|
||||||
|
current code does not cache all introspection queries with variables correctly.
|
||||||
|
As a workaround to this, whenever a variable is passed to an @includeDeprecated@
|
||||||
|
argument, we mark the query as unreusable. This is the purpose of
|
||||||
|
'dummyReadIncludeDeprecated'.
|
||||||
|
|
||||||
|
Now @fields@ and @enumValues@ are intended to be used when introspecting,
|
||||||
|
respectively [object and interface types] and enum types. However, it does not
|
||||||
|
suffice to only call 'dummyReadIncludeDeprecated' for such types, since @fields@
|
||||||
|
and @enumValues@ are valid GraphQL fields regardless of what type we are looking
|
||||||
|
at. So precisely because @__Type@ is _thought of_ as a union, but _not
|
||||||
|
actually_ a union, we need to call 'dummyReadIncludeDeprecated' in all cases.
|
||||||
|
|
||||||
|
See also issue #4547.
|
||||||
|
-}
|
||||||
|
|
||||||
|
dummyReadIncludeDeprecated
|
||||||
|
:: ( Monad m, MonadReusability m, MonadError QErr m )
|
||||||
|
=> Field
|
||||||
|
-> m ()
|
||||||
|
dummyReadIncludeDeprecated fld = do
|
||||||
|
selSet <- unAliasedFields . unObjectSelectionSet
|
||||||
|
<$> asObjectSelectionSet (_fSelSet fld)
|
||||||
|
forM_ (toList selSet) $ \subFld ->
|
||||||
|
case _fName subFld of
|
||||||
|
"fields" -> readIncludeDeprecated subFld
|
||||||
|
"enumValues" -> readIncludeDeprecated subFld
|
||||||
|
_ -> return False
|
||||||
|
|
||||||
-- 4.5.2.6
|
-- 4.5.2.6
|
||||||
inputObjR
|
inputObjR
|
||||||
@ -276,7 +334,7 @@ inputValueR fld (InpValInfo descM n defM ty) =
|
|||||||
|
|
||||||
-- 4.5.5
|
-- 4.5.5
|
||||||
enumValueR
|
enumValueR
|
||||||
:: (Monad m)
|
:: (MonadError QErr m)
|
||||||
=> Field -> EnumValInfo -> m J.Object
|
=> Field -> EnumValInfo -> m J.Object
|
||||||
enumValueR fld (EnumValInfo descM enumVal isDeprecated) =
|
enumValueR fld (EnumValInfo descM enumVal isDeprecated) =
|
||||||
withSubFields (_fSelSet fld) $ \subFld ->
|
withSubFields (_fSelSet fld) $ \subFld ->
|
||||||
|
@ -33,7 +33,7 @@ import Hasura.GraphQL.Resolve.BoolExp
|
|||||||
import Hasura.GraphQL.Resolve.Context
|
import Hasura.GraphQL.Resolve.Context
|
||||||
import Hasura.GraphQL.Resolve.InputValue
|
import Hasura.GraphQL.Resolve.InputValue
|
||||||
import Hasura.GraphQL.Resolve.Select (processTableSelectionSet)
|
import Hasura.GraphQL.Resolve.Select (processTableSelectionSet)
|
||||||
import Hasura.GraphQL.Validate.Field
|
import Hasura.GraphQL.Validate.SelectionSet
|
||||||
import Hasura.GraphQL.Validate.Types
|
import Hasura.GraphQL.Validate.Types
|
||||||
import Hasura.RQL.DML.Internal (currentSession, sessVarFromCurrentSetting)
|
import Hasura.RQL.DML.Internal (currentSession, sessVarFromCurrentSetting)
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
@ -44,15 +44,16 @@ resolveMutationFields
|
|||||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
, Has OrdByCtx r, Has SQLGenCtx r
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
)
|
)
|
||||||
=> G.NamedType -> SelSet -> m (RR.MutFldsG UnresolvedVal)
|
=> G.NamedType -> ObjectSelectionSet -> m (RR.MutFldsG UnresolvedVal)
|
||||||
resolveMutationFields ty selSet = fmap (map (first FieldName)) $
|
resolveMutationFields ty selSet = fmap (map (first FieldName)) $
|
||||||
withSelSet selSet $ \fld -> case _fName fld of
|
traverseObjectSelectionSet selSet $ \fld -> case _fName fld of
|
||||||
"__typename" -> return $ RR.MExp $ G.unName $ G.unNamedType ty
|
"__typename" -> return $ RR.MExp $ G.unName $ G.unNamedType ty
|
||||||
"affected_rows" -> return RR.MCount
|
"affected_rows" -> return RR.MCount
|
||||||
"returning" -> do
|
"returning" -> do
|
||||||
annFlds <- processTableSelectionSet (_fType fld) $ _fSelSet fld
|
annFlds <- asObjectSelectionSet (_fSelSet fld)
|
||||||
|
>>= processTableSelectionSet (_fType fld)
|
||||||
annFldsResolved <- traverse
|
annFldsResolved <- traverse
|
||||||
(traverse (RS.traverseAnnFld convertPGValueToTextValue)) annFlds
|
(traverse (RS.traverseAnnField convertPGValueToTextValue)) annFlds
|
||||||
return $ RR.MRet annFldsResolved
|
return $ RR.MRet annFldsResolved
|
||||||
G.Name t -> throw500 $ "unexpected field in mutation resp : " <> t
|
G.Name t -> throw500 $ "unexpected field in mutation resp : " <> t
|
||||||
where
|
where
|
||||||
@ -321,8 +322,9 @@ mutationFieldsResolver
|
|||||||
, Has OrdByCtx r, Has SQLGenCtx r
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
)
|
)
|
||||||
=> Field -> m (RR.MutationOutputG UnresolvedVal)
|
=> Field -> m (RR.MutationOutputG UnresolvedVal)
|
||||||
mutationFieldsResolver field =
|
mutationFieldsResolver field = do
|
||||||
RR.MOutMultirowFields <$> resolveMutationFields (_fType field) (_fSelSet field)
|
asObjectSelectionSet (_fSelSet field) >>= \selSet ->
|
||||||
|
RR.MOutMultirowFields <$> resolveMutationFields (_fType field) selSet
|
||||||
|
|
||||||
tableSelectionAsMutationOutput
|
tableSelectionAsMutationOutput
|
||||||
:: ( MonadReusability m, MonadError QErr m
|
:: ( MonadReusability m, MonadError QErr m
|
||||||
@ -331,7 +333,8 @@ tableSelectionAsMutationOutput
|
|||||||
)
|
)
|
||||||
=> Field -> m (RR.MutationOutputG UnresolvedVal)
|
=> Field -> m (RR.MutationOutputG UnresolvedVal)
|
||||||
tableSelectionAsMutationOutput field =
|
tableSelectionAsMutationOutput field =
|
||||||
RR.MOutSinglerowObject <$> processTableSelectionSet (_fType field) (_fSelSet field)
|
asObjectSelectionSet (_fSelSet field) >>= \selSet ->
|
||||||
|
RR.MOutSinglerowObject <$> processTableSelectionSet (_fType field) selSet
|
||||||
|
|
||||||
-- | build mutation response for empty objects
|
-- | build mutation response for empty objects
|
||||||
buildEmptyMutResp :: RR.MutationOutput -> EncJSON
|
buildEmptyMutResp :: RR.MutationOutput -> EncJSON
|
||||||
|
@ -1,37 +1,47 @@
|
|||||||
module Hasura.GraphQL.Resolve.Select
|
module Hasura.GraphQL.Resolve.Select
|
||||||
( convertSelect
|
( convertSelect
|
||||||
|
, convertConnectionSelect
|
||||||
|
, convertConnectionFuncQuery
|
||||||
, convertSelectByPKey
|
, convertSelectByPKey
|
||||||
, convertAggSelect
|
, convertAggSelect
|
||||||
, convertFuncQuerySimple
|
, convertFuncQuerySimple
|
||||||
, convertFuncQueryAgg
|
, convertFuncQueryAgg
|
||||||
, parseColumns
|
, parseColumns
|
||||||
, processTableSelectionSet
|
, processTableSelectionSet
|
||||||
|
, resolveNodeId
|
||||||
|
, convertNodeSelect
|
||||||
, AnnSimpleSelect
|
, AnnSimpleSelect
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Lens ((^?), _2)
|
import Control.Lens (to, (^..), (^?), _2)
|
||||||
import Data.Has
|
import Data.Has
|
||||||
import Data.Parser.JSONPath
|
import Data.Parser.JSONPath
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.Aeson as J
|
||||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
import qualified Data.Aeson.Internal as J
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.HashMap.Strict as Map
|
||||||
import qualified Data.Text as T
|
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Data.List.NonEmpty as NE
|
||||||
|
import qualified Data.Sequence as Seq
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
import qualified Hasura.RQL.DML.Select as RS
|
import qualified Hasura.RQL.DML.Select as RS
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
|
|
||||||
import Hasura.GraphQL.Resolve.BoolExp
|
import Hasura.GraphQL.Resolve.BoolExp
|
||||||
import Hasura.GraphQL.Resolve.Context
|
import Hasura.GraphQL.Resolve.Context
|
||||||
import Hasura.GraphQL.Resolve.InputValue
|
import Hasura.GraphQL.Resolve.InputValue
|
||||||
import Hasura.GraphQL.Schema (isAggFld)
|
import Hasura.GraphQL.Schema (isAggregateField)
|
||||||
import Hasura.GraphQL.Validate.Field
|
import Hasura.GraphQL.Schema.Common (mkTableTy)
|
||||||
|
import Hasura.GraphQL.Validate
|
||||||
|
import Hasura.GraphQL.Validate.SelectionSet
|
||||||
import Hasura.GraphQL.Validate.Types
|
import Hasura.GraphQL.Validate.Types
|
||||||
import Hasura.RQL.DML.Internal (onlyPositiveInt)
|
import Hasura.RQL.DML.Internal (onlyPositiveInt)
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
|
import Hasura.Server.Utils
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
import Hasura.SQL.Value
|
import Hasura.SQL.Value
|
||||||
|
|
||||||
@ -45,27 +55,29 @@ jsonPathToColExp t = case parseJSONPath t of
|
|||||||
elToColExp (Index i) = S.SELit $ T.pack (show i)
|
elToColExp (Index i) = S.SELit $ T.pack (show i)
|
||||||
|
|
||||||
|
|
||||||
argsToColOp :: (MonadReusability m, MonadError QErr m) => ArgsMap -> m (Maybe RS.ColOp)
|
argsToColumnOp :: (MonadReusability m, MonadError QErr m) => ArgsMap -> m (Maybe RS.ColumnOp)
|
||||||
argsToColOp args = maybe (return Nothing) toOp $ Map.lookup "path" args
|
argsToColumnOp args = case Map.lookup "path" args of
|
||||||
where
|
Nothing -> return Nothing
|
||||||
toJsonPathExp = fmap (RS.ColOp S.jsonbPathOp) . jsonPathToColExp
|
Just txt -> do
|
||||||
toOp v = asPGColTextM v >>= traverse toJsonPathExp
|
mColTxt <- asPGColTextM txt
|
||||||
|
mColExps <- maybe (return Nothing) jsonPathToColExp mColTxt
|
||||||
|
pure $ RS.ColumnOp S.jsonbPathOp <$> mColExps
|
||||||
|
|
||||||
type AnnFlds = RS.AnnFldsG UnresolvedVal
|
type AnnFields = RS.AnnFieldsG UnresolvedVal
|
||||||
|
|
||||||
resolveComputedField
|
resolveComputedField
|
||||||
:: ( MonadReusability m, MonadReader r m, Has FieldMap r
|
:: ( MonadReusability m, MonadReader r m, Has FieldMap r
|
||||||
, Has OrdByCtx r, Has SQLGenCtx r, MonadError QErr m
|
, Has OrdByCtx r, Has SQLGenCtx r, MonadError QErr m
|
||||||
)
|
)
|
||||||
=> ComputedField -> Field -> m (RS.ComputedFieldSel UnresolvedVal)
|
=> ComputedField -> Field -> m (RS.ComputedFieldSelect UnresolvedVal)
|
||||||
resolveComputedField computedField fld = fieldAsPath fld $ do
|
resolveComputedField computedField fld = fieldAsPath fld $ do
|
||||||
funcArgs <- parseFunctionArgs argSeq argFn $ Map.lookup "args" $ _fArguments fld
|
funcArgs <- parseFunctionArgs argSeq argFn $ Map.lookup "args" $ _fArguments fld
|
||||||
let argsWithTableArgument = withTableArgument funcArgs
|
let argsWithTableArgument = withTableArgument funcArgs
|
||||||
case fieldType of
|
case fieldType of
|
||||||
CFTScalar scalarTy -> do
|
CFTScalar scalarTy -> do
|
||||||
colOpM <- argsToColOp $ _fArguments fld
|
colOpM <- argsToColumnOp $ _fArguments fld
|
||||||
pure $ RS.CFSScalar $
|
pure $ RS.CFSScalar $
|
||||||
RS.ComputedFieldScalarSel qf argsWithTableArgument scalarTy colOpM
|
RS.ComputedFieldScalarSelectect qf argsWithTableArgument scalarTy colOpM
|
||||||
CFTTable (ComputedFieldTable _ cols permFilter permLimit) -> do
|
CFTTable (ComputedFieldTable _ cols permFilter permLimit) -> do
|
||||||
let functionFrom = RS.FromFunction qf argsWithTableArgument Nothing
|
let functionFrom = RS.FromFunction qf argsWithTableArgument Nothing
|
||||||
RS.CFSTable RS.JASMultipleRows <$> fromField functionFrom cols permFilter permLimit fld
|
RS.CFSTable RS.JASMultipleRows <$> fromField functionFrom cols permFilter permLimit fld
|
||||||
@ -86,77 +98,142 @@ processTableSelectionSet
|
|||||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
, Has OrdByCtx r, Has SQLGenCtx r
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
)
|
)
|
||||||
=> G.NamedType -> SelSet -> m AnnFlds
|
=> G.NamedType -> ObjectSelectionSet -> m AnnFields
|
||||||
processTableSelectionSet fldTy flds =
|
processTableSelectionSet fldTy flds =
|
||||||
forM (toList flds) $ \fld -> do
|
fmap (map (\(a, b) -> (FieldName a, b))) $ traverseObjectSelectionSet flds $ \fld -> do
|
||||||
let fldName = _fName fld
|
let fldName = _fName fld
|
||||||
let rqlFldName = FieldName $ G.unName $ G.unAlias $ _fAlias fld
|
case fldName of
|
||||||
(rqlFldName,) <$> case fldName of
|
"__typename" -> return $ RS.AFExpression $ G.unName $ G.unNamedType fldTy
|
||||||
"__typename" -> return $ RS.FExp $ G.unName $ G.unNamedType fldTy
|
|
||||||
_ -> do
|
_ -> do
|
||||||
fldInfo <- getFldInfo fldTy fldName
|
fldInfo <- getFldInfo fldTy fldName
|
||||||
case fldInfo of
|
case fldInfo of
|
||||||
|
RFNodeId tn pkeys -> pure $ RS.AFNodeId tn pkeys
|
||||||
RFPGColumn colInfo ->
|
RFPGColumn colInfo ->
|
||||||
RS.mkAnnColField colInfo <$> argsToColOp (_fArguments fld)
|
RS.mkAnnColumnField colInfo <$> argsToColumnOp (_fArguments fld)
|
||||||
RFComputedField computedField ->
|
RFComputedField computedField ->
|
||||||
RS.FComputedField <$> resolveComputedField computedField fld
|
RS.AFComputedField <$> resolveComputedField computedField fld
|
||||||
RFRelationship (RelationshipField relInfo isAgg colGNameMap tableFilter tableLimit) -> do
|
RFRelationship (RelationshipField relInfo fieldKind colGNameMap tableFilter tableLimit) -> do
|
||||||
let relTN = riRTable relInfo
|
let relTN = riRTable relInfo
|
||||||
colMapping = riMapping relInfo
|
colMapping = riMapping relInfo
|
||||||
rn = riName relInfo
|
rn = riName relInfo
|
||||||
if isAgg then do
|
case fieldKind of
|
||||||
aggSel <- fromAggField (RS.FromTable relTN) colGNameMap tableFilter tableLimit fld
|
RFKSimple -> do
|
||||||
return $ RS.FArr $ RS.ASAgg $ RS.AnnRelG rn colMapping aggSel
|
annSel <- fromField (RS.FromTable relTN) colGNameMap tableFilter tableLimit fld
|
||||||
else do
|
let annRel = RS.AnnRelationSelectG rn colMapping annSel
|
||||||
annSel <- fromField (RS.FromTable relTN) colGNameMap tableFilter tableLimit fld
|
pure $ case riType relInfo of
|
||||||
let annRel = RS.AnnRelG rn colMapping annSel
|
ObjRel -> RS.AFObjectRelation annRel
|
||||||
return $ case riType relInfo of
|
ArrRel -> RS.AFArrayRelation $ RS.ASSimple annRel
|
||||||
ObjRel -> RS.FObj annRel
|
RFKAggregate -> do
|
||||||
ArrRel -> RS.FArr $ RS.ASSimple annRel
|
aggSel <- fromAggField (RS.FromTable relTN) colGNameMap tableFilter tableLimit fld
|
||||||
|
pure $ RS.AFArrayRelation $ RS.ASAggregate $ RS.AnnRelationSelectG rn colMapping aggSel
|
||||||
|
RFKConnection pkCols -> do
|
||||||
|
connSel <- fromConnectionField (RS.FromTable relTN) pkCols tableFilter tableLimit fld
|
||||||
|
pure $ RS.AFArrayRelation $ RS.ASConnection $ RS.AnnRelationSelectG rn colMapping connSel
|
||||||
|
|
||||||
type TableAggFlds = RS.TableAggFldsG UnresolvedVal
|
RFRemoteRelationship info ->
|
||||||
|
pure $ RS.AFRemote $ RS.RemoteSelect
|
||||||
|
(unValidateArgsMap $ _fArguments fld) -- Unvalidate the input arguments
|
||||||
|
(unValidateSelectionSet $ _fSelSet fld) -- Unvalidate the selection fields
|
||||||
|
(_rfiHasuraFields info)
|
||||||
|
(_rfiRemoteFields info)
|
||||||
|
(_rfiRemoteSchema info)
|
||||||
|
|
||||||
|
type TableAggregateFields = RS.TableAggregateFieldsG UnresolvedVal
|
||||||
|
|
||||||
fromAggSelSet
|
fromAggSelSet
|
||||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
, Has OrdByCtx r, Has SQLGenCtx r
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
)
|
)
|
||||||
=> PGColGNameMap -> G.NamedType -> SelSet -> m TableAggFlds
|
=> PGColGNameMap -> G.NamedType -> ObjectSelectionSet -> m TableAggregateFields
|
||||||
fromAggSelSet colGNameMap fldTy selSet = fmap toFields $
|
fromAggSelSet colGNameMap fldTy selSet = fmap toFields $
|
||||||
withSelSet selSet $ \f -> do
|
traverseObjectSelectionSet selSet $ \Field{..} ->
|
||||||
let fTy = _fType f
|
case _fName of
|
||||||
fSelSet = _fSelSet f
|
|
||||||
case _fName f of
|
|
||||||
"__typename" -> return $ RS.TAFExp $ G.unName $ G.unNamedType fldTy
|
"__typename" -> return $ RS.TAFExp $ G.unName $ G.unNamedType fldTy
|
||||||
"aggregate" -> RS.TAFAgg <$> convertAggFld colGNameMap fTy fSelSet
|
"aggregate" -> do
|
||||||
"nodes" -> RS.TAFNodes <$> processTableSelectionSet fTy fSelSet
|
objSelSet <- asObjectSelectionSet _fSelSet
|
||||||
|
RS.TAFAgg <$> convertAggregateField colGNameMap _fType objSelSet
|
||||||
|
"nodes" -> do
|
||||||
|
objSelSet <- asObjectSelectionSet _fSelSet
|
||||||
|
RS.TAFNodes <$> processTableSelectionSet _fType objSelSet
|
||||||
G.Name t -> throw500 $ "unexpected field in _agg node: " <> t
|
G.Name t -> throw500 $ "unexpected field in _agg node: " <> t
|
||||||
|
|
||||||
type TableArgs = RS.TableArgsG UnresolvedVal
|
fromConnectionSelSet
|
||||||
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
|
)
|
||||||
|
=> G.NamedType -> ObjectSelectionSet -> m (RS.ConnectionFields UnresolvedVal)
|
||||||
|
fromConnectionSelSet fldTy selSet = fmap toFields $
|
||||||
|
traverseObjectSelectionSet selSet $ \Field{..} ->
|
||||||
|
case _fName of
|
||||||
|
"__typename" -> return $ RS.ConnectionTypename $ G.unName $ G.unNamedType fldTy
|
||||||
|
"pageInfo" -> do
|
||||||
|
fSelSet <- asObjectSelectionSet _fSelSet
|
||||||
|
RS.ConnectionPageInfo <$> parsePageInfoSelectionSet _fType fSelSet
|
||||||
|
"edges" -> do
|
||||||
|
fSelSet <- asObjectSelectionSet _fSelSet
|
||||||
|
RS.ConnectionEdges <$> parseEdgeSelectionSet _fType fSelSet
|
||||||
|
-- "aggregate" -> RS.TAFAgg <$> convertAggregateField colGNameMap fTy fSelSet
|
||||||
|
-- "nodes" -> RS.TAFNodes <$> processTableSelectionSet fTy fSelSet
|
||||||
|
G.Name t -> throw500 $ "unexpected field in _connection node: " <> t
|
||||||
|
|
||||||
parseTableArgs
|
parseEdgeSelectionSet
|
||||||
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
|
)
|
||||||
|
=> G.NamedType -> ObjectSelectionSet -> m (RS.EdgeFields UnresolvedVal)
|
||||||
|
parseEdgeSelectionSet fldTy selSet = fmap toFields $
|
||||||
|
traverseObjectSelectionSet selSet $ \f -> do
|
||||||
|
let fTy = _fType f
|
||||||
|
case _fName f of
|
||||||
|
"__typename" -> pure $ RS.EdgeTypename $ G.unName $ G.unNamedType fldTy
|
||||||
|
"cursor" -> pure RS.EdgeCursor
|
||||||
|
"node" -> do
|
||||||
|
fSelSet <- asObjectSelectionSet $ _fSelSet f
|
||||||
|
RS.EdgeNode <$> processTableSelectionSet fTy fSelSet
|
||||||
|
G.Name t -> throw500 $ "unexpected field in Edge node: " <> t
|
||||||
|
|
||||||
|
parsePageInfoSelectionSet
|
||||||
|
:: ( MonadReusability m, MonadError QErr m)
|
||||||
|
=> G.NamedType -> ObjectSelectionSet -> m RS.PageInfoFields
|
||||||
|
parsePageInfoSelectionSet fldTy selSet =
|
||||||
|
fmap toFields $ traverseObjectSelectionSet selSet $ \f ->
|
||||||
|
case _fName f of
|
||||||
|
"__typename" -> pure $ RS.PageInfoTypename $ G.unName $ G.unNamedType fldTy
|
||||||
|
"hasNextPage" -> pure RS.PageInfoHasNextPage
|
||||||
|
"hasPreviousPage" -> pure RS.PageInfoHasPreviousPage
|
||||||
|
"startCursor" -> pure RS.PageInfoStartCursor
|
||||||
|
"endCursor" -> pure RS.PageInfoEndCursor
|
||||||
|
-- "aggregate" -> RS.TAFAgg <$> convertAggregateField colGNameMap fTy fSelSet
|
||||||
|
-- "nodes" -> RS.TAFNodes <$> processTableSelectionSet fTy fSelSet
|
||||||
|
G.Name t -> throw500 $ "unexpected field in PageInfo node: " <> t
|
||||||
|
|
||||||
|
type SelectArgs = RS.SelectArgsG UnresolvedVal
|
||||||
|
|
||||||
|
parseSelectArgs
|
||||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m
|
||||||
, Has FieldMap r, Has OrdByCtx r
|
, Has FieldMap r, Has OrdByCtx r
|
||||||
)
|
)
|
||||||
=> PGColGNameMap -> ArgsMap -> m TableArgs
|
=> PGColGNameMap -> ArgsMap -> m SelectArgs
|
||||||
parseTableArgs colGNameMap args = do
|
parseSelectArgs colGNameMap args = do
|
||||||
whereExpM <- withArgM args "where" parseBoolExp
|
whereExpM <- withArgM args "where" parseBoolExp
|
||||||
ordByExpML <- withArgM args "order_by" parseOrderBy
|
ordByExpML <- withArgM args "order_by" parseOrderBy
|
||||||
let ordByExpM = NE.nonEmpty =<< ordByExpML
|
let ordByExpM = NE.nonEmpty =<< ordByExpML
|
||||||
limitExpM <- withArgM args "limit" parseLimit
|
limitExpM <- withArgM args "limit" $
|
||||||
|
parseNonNegativeInt "expecting Integer value for \"limit\""
|
||||||
offsetExpM <- withArgM args "offset" $ asPGColumnValue >=> openOpaqueValue >=> txtConverter
|
offsetExpM <- withArgM args "offset" $ asPGColumnValue >=> openOpaqueValue >=> txtConverter
|
||||||
distOnColsML <- withArgM args "distinct_on" $ parseColumns colGNameMap
|
distOnColsML <- withArgM args "distinct_on" $ parseColumns colGNameMap
|
||||||
let distOnColsM = NE.nonEmpty =<< distOnColsML
|
let distOnColsM = NE.nonEmpty =<< distOnColsML
|
||||||
mapM_ (validateDistOn ordByExpM) distOnColsM
|
mapM_ (validateDistOn ordByExpM) distOnColsM
|
||||||
return $ RS.TableArgs whereExpM ordByExpM limitExpM offsetExpM distOnColsM
|
return $ RS.SelectArgs whereExpM ordByExpM limitExpM offsetExpM distOnColsM
|
||||||
where
|
where
|
||||||
validateDistOn Nothing _ = return ()
|
validateDistOn Nothing _ = return ()
|
||||||
validateDistOn (Just ordBys) cols = withPathK "args" $ do
|
validateDistOn (Just ordBys) cols = withPathK "args" $ do
|
||||||
let colsLen = length cols
|
let colsLen = length cols
|
||||||
initOrdBys = take colsLen $ toList ordBys
|
initOrdBys = take colsLen $ toList ordBys
|
||||||
initOrdByCols = flip mapMaybe initOrdBys $ \ob ->
|
initOrdByCols = flip mapMaybe initOrdBys $ \ob ->
|
||||||
case obiColumn ob of
|
case obiColumn ob of
|
||||||
RS.AOCPG pgCol -> Just pgCol
|
RS.AOCColumn pgCol -> Just $ pgiColumn pgCol
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
isValid = (colsLen == length initOrdByCols)
|
isValid = (colsLen == length initOrdByCols)
|
||||||
&& all (`elem` initOrdByCols) (toList cols)
|
&& all (`elem` initOrdByCols) (toList cols)
|
||||||
|
|
||||||
@ -175,12 +252,13 @@ fromField
|
|||||||
-> Maybe Int
|
-> Maybe Int
|
||||||
-> Field -> m AnnSimpleSelect
|
-> Field -> m AnnSimpleSelect
|
||||||
fromField selFrom colGNameMap permFilter permLimitM fld = fieldAsPath fld $ do
|
fromField selFrom colGNameMap permFilter permLimitM fld = fieldAsPath fld $ do
|
||||||
tableArgs <- parseTableArgs colGNameMap args
|
tableArgs <- parseSelectArgs colGNameMap args
|
||||||
annFlds <- processTableSelectionSet (_fType fld) $ _fSelSet fld
|
selSet <- asObjectSelectionSet $ _fSelSet fld
|
||||||
|
annFlds <- processTableSelectionSet (_fType fld) selSet
|
||||||
let unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter
|
let unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter
|
||||||
let tabPerm = RS.TablePerm unresolvedPermFltr permLimitM
|
let tabPerm = RS.TablePerm unresolvedPermFltr permLimitM
|
||||||
strfyNum <- stringifyNum <$> asks getter
|
strfyNum <- stringifyNum <$> asks getter
|
||||||
return $ RS.AnnSelG annFlds selFrom tabPerm tableArgs strfyNum
|
return $ RS.AnnSelectG annFlds selFrom tabPerm tableArgs strfyNum
|
||||||
where
|
where
|
||||||
args = _fArguments fld
|
args = _fArguments fld
|
||||||
|
|
||||||
@ -201,7 +279,8 @@ parseOrderBy
|
|||||||
, MonadReader r m
|
, MonadReader r m
|
||||||
, Has OrdByCtx r
|
, Has OrdByCtx r
|
||||||
)
|
)
|
||||||
=> AnnInpVal -> m [RS.AnnOrderByItemG UnresolvedVal]
|
=> AnnInpVal
|
||||||
|
-> m [RS.AnnOrderByItemG UnresolvedVal]
|
||||||
parseOrderBy = fmap concat . withArray f
|
parseOrderBy = fmap concat . withArray f
|
||||||
where
|
where
|
||||||
f _ = mapM (withObject (getAnnObItems id))
|
f _ = mapM (withObject (getAnnObItems id))
|
||||||
@ -212,7 +291,7 @@ getAnnObItems
|
|||||||
, MonadReader r m
|
, MonadReader r m
|
||||||
, Has OrdByCtx r
|
, Has OrdByCtx r
|
||||||
)
|
)
|
||||||
=> (RS.AnnObColG UnresolvedVal -> RS.AnnObColG UnresolvedVal)
|
=> (RS.AnnOrderByElement UnresolvedVal -> RS.AnnOrderByElement UnresolvedVal)
|
||||||
-> G.NamedType
|
-> G.NamedType
|
||||||
-> AnnGObject
|
-> AnnGObject
|
||||||
-> m [RS.AnnOrderByItemG UnresolvedVal]
|
-> m [RS.AnnOrderByItemG UnresolvedVal]
|
||||||
@ -224,7 +303,7 @@ getAnnObItems f nt obj = do
|
|||||||
<> showNamedTy nt <> " map"
|
<> showNamedTy nt <> " map"
|
||||||
case ordByItem of
|
case ordByItem of
|
||||||
OBIPGCol ci -> do
|
OBIPGCol ci -> do
|
||||||
let aobCol = f $ RS.AOCPG $ pgiColumn ci
|
let aobCol = f $ RS.AOCColumn ci
|
||||||
(_, enumValM) <- asEnumValM v
|
(_, enumValM) <- asEnumValM v
|
||||||
ordByItemM <- forM enumValM $ \enumVal -> do
|
ordByItemM <- forM enumValM $ \enumVal -> do
|
||||||
(ordTy, nullsOrd) <- parseOrderByEnum enumVal
|
(ordTy, nullsOrd) <- parseOrderByEnum enumVal
|
||||||
@ -233,13 +312,13 @@ getAnnObItems f nt obj = do
|
|||||||
|
|
||||||
OBIRel ri fltr -> do
|
OBIRel ri fltr -> do
|
||||||
let unresolvedFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal fltr
|
let unresolvedFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal fltr
|
||||||
let annObColFn = f . RS.AOCObj ri unresolvedFltr
|
let annObColFn = f . RS.AOCObjectRelation ri unresolvedFltr
|
||||||
flip withObjectM v $ \nameTy objM ->
|
flip withObjectM v $ \nameTy objM ->
|
||||||
maybe (pure []) (getAnnObItems annObColFn nameTy) objM
|
maybe (pure []) (getAnnObItems annObColFn nameTy) objM
|
||||||
|
|
||||||
OBIAgg ri relColGNameMap fltr -> do
|
OBIAgg ri relColGNameMap fltr -> do
|
||||||
let unresolvedFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal fltr
|
let unresolvedFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal fltr
|
||||||
let aobColFn = f . RS.AOCAgg ri unresolvedFltr
|
let aobColFn = f . RS.AOCArrayAggregation ri unresolvedFltr
|
||||||
flip withObjectM v $ \_ objM ->
|
flip withObjectM v $ \_ objM ->
|
||||||
maybe (pure []) (parseAggOrdBy relColGNameMap aobColFn) objM
|
maybe (pure []) (parseAggOrdBy relColGNameMap aobColFn) objM
|
||||||
|
|
||||||
@ -250,7 +329,7 @@ mkOrdByItemG ordTy aobCol nullsOrd =
|
|||||||
parseAggOrdBy
|
parseAggOrdBy
|
||||||
:: (MonadReusability m, MonadError QErr m)
|
:: (MonadReusability m, MonadError QErr m)
|
||||||
=> PGColGNameMap
|
=> PGColGNameMap
|
||||||
-> (RS.AnnAggOrdBy -> RS.AnnObColG UnresolvedVal)
|
-> (RS.AnnAggregateOrderBy -> RS.AnnOrderByElement UnresolvedVal)
|
||||||
-> AnnGObject
|
-> AnnGObject
|
||||||
-> m [RS.AnnOrderByItemG UnresolvedVal]
|
-> m [RS.AnnOrderByItemG UnresolvedVal]
|
||||||
parseAggOrdBy colGNameMap f annObj =
|
parseAggOrdBy colGNameMap f annObj =
|
||||||
@ -263,14 +342,14 @@ parseAggOrdBy colGNameMap f annObj =
|
|||||||
return $ mkOrdByItemG ordTy (f RS.AAOCount) nullsOrd
|
return $ mkOrdByItemG ordTy (f RS.AAOCount) nullsOrd
|
||||||
return $ maybe [] pure ordByItemM
|
return $ maybe [] pure ordByItemM
|
||||||
|
|
||||||
G.Name opT ->
|
G.Name opText ->
|
||||||
flip withObject obVal $ \_ opObObj -> fmap catMaybes $
|
flip withObject obVal $ \_ opObObj -> fmap catMaybes $
|
||||||
forM (OMap.toList opObObj) $ \(colName, eVal) -> do
|
forM (OMap.toList opObObj) $ \(colName, eVal) -> do
|
||||||
(_, enumValM) <- asEnumValM eVal
|
(_, enumValM) <- asEnumValM eVal
|
||||||
forM enumValM $ \enumVal -> do
|
forM enumValM $ \enumVal -> do
|
||||||
(ordTy, nullsOrd) <- parseOrderByEnum enumVal
|
(ordTy, nullsOrd) <- parseOrderByEnum enumVal
|
||||||
col <- pgiColumn <$> resolvePGCol colGNameMap colName
|
col <- resolvePGCol colGNameMap colName
|
||||||
let aobCol = f $ RS.AAOOp opT col
|
let aobCol = f $ RS.AAOOp opText col
|
||||||
return $ mkOrdByItemG ordTy aobCol nullsOrd
|
return $ mkOrdByItemG ordTy aobCol nullsOrd
|
||||||
|
|
||||||
parseOrderByEnum
|
parseOrderByEnum
|
||||||
@ -287,15 +366,14 @@ parseOrderByEnum = \case
|
|||||||
G.EnumValue v -> throw500 $
|
G.EnumValue v -> throw500 $
|
||||||
"enum value " <> showName v <> " not found in type order_by"
|
"enum value " <> showName v <> " not found in type order_by"
|
||||||
|
|
||||||
parseLimit :: (MonadReusability m, MonadError QErr m) => AnnInpVal -> m Int
|
parseNonNegativeInt
|
||||||
parseLimit v = do
|
:: (MonadReusability m, MonadError QErr m) => Text -> AnnInpVal -> m Int
|
||||||
|
parseNonNegativeInt errMsg v = do
|
||||||
pgColVal <- openOpaqueValue =<< asPGColumnValue v
|
pgColVal <- openOpaqueValue =<< asPGColumnValue v
|
||||||
limit <- maybe noIntErr return . pgColValueToInt . pstValue $ _apvValue pgColVal
|
limit <- maybe (throwVE errMsg) return . pgColValueToInt . pstValue $ _apvValue pgColVal
|
||||||
-- validate int value
|
-- validate int value
|
||||||
onlyPositiveInt limit
|
onlyPositiveInt limit
|
||||||
return limit
|
return limit
|
||||||
where
|
|
||||||
noIntErr = throwVE "expecting Integer value for \"limit\""
|
|
||||||
|
|
||||||
type AnnSimpleSel = RS.AnnSimpleSelG UnresolvedVal
|
type AnnSimpleSel = RS.AnnSimpleSelG UnresolvedVal
|
||||||
|
|
||||||
@ -311,14 +389,15 @@ fromFieldByPKey
|
|||||||
-> AnnBoolExpPartialSQL -> Field -> m AnnSimpleSel
|
-> AnnBoolExpPartialSQL -> Field -> m AnnSimpleSel
|
||||||
fromFieldByPKey tn colArgMap permFilter fld = fieldAsPath fld $ do
|
fromFieldByPKey tn colArgMap permFilter fld = fieldAsPath fld $ do
|
||||||
boolExp <- pgColValToBoolExp colArgMap $ _fArguments fld
|
boolExp <- pgColValToBoolExp colArgMap $ _fArguments fld
|
||||||
annFlds <- processTableSelectionSet fldTy $ _fSelSet fld
|
selSet <- asObjectSelectionSet $ _fSelSet fld
|
||||||
|
annFlds <- processTableSelectionSet fldTy selSet
|
||||||
let tabFrom = RS.FromTable tn
|
let tabFrom = RS.FromTable tn
|
||||||
unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal
|
unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal
|
||||||
permFilter
|
permFilter
|
||||||
tabPerm = RS.TablePerm unresolvedPermFltr Nothing
|
tabPerm = RS.TablePerm unresolvedPermFltr Nothing
|
||||||
tabArgs = RS.noTableArgs { RS._taWhere = Just boolExp}
|
tabArgs = RS.noSelectArgs { RS._saWhere = Just boolExp}
|
||||||
strfyNum <- stringifyNum <$> asks getter
|
strfyNum <- stringifyNum <$> asks getter
|
||||||
return $ RS.AnnSelG annFlds tabFrom tabPerm tabArgs strfyNum
|
return $ RS.AnnSelectG annFlds tabFrom tabPerm tabArgs strfyNum
|
||||||
where
|
where
|
||||||
fldTy = _fType fld
|
fldTy = _fType fld
|
||||||
|
|
||||||
@ -345,14 +424,18 @@ convertSelectByPKey opCtx fld =
|
|||||||
SelPkOpCtx qt _ permFilter colArgMap = opCtx
|
SelPkOpCtx qt _ permFilter colArgMap = opCtx
|
||||||
|
|
||||||
-- agg select related
|
-- agg select related
|
||||||
parseColumns :: (MonadReusability m, MonadError QErr m) => PGColGNameMap -> AnnInpVal -> m [PGCol]
|
parseColumns
|
||||||
|
:: (MonadReusability m, MonadError QErr m)
|
||||||
|
=> PGColGNameMap -> AnnInpVal -> m [PGCol]
|
||||||
parseColumns allColFldMap val =
|
parseColumns allColFldMap val =
|
||||||
flip withArray val $ \_ vals ->
|
flip withArray val $ \_ vals ->
|
||||||
forM vals $ \v -> do
|
forM vals $ \v -> do
|
||||||
(_, G.EnumValue enumVal) <- asEnumVal v
|
(_, G.EnumValue enumVal) <- asEnumVal v
|
||||||
pgiColumn <$> resolvePGCol allColFldMap enumVal
|
pgiColumn <$> resolvePGCol allColFldMap enumVal
|
||||||
|
|
||||||
convertCount :: (MonadReusability m, MonadError QErr m) => PGColGNameMap -> ArgsMap -> m S.CountType
|
convertCount
|
||||||
|
:: (MonadReusability m, MonadError QErr m)
|
||||||
|
=> PGColGNameMap -> ArgsMap -> m S.CountType
|
||||||
convertCount colGNameMap args = do
|
convertCount colGNameMap args = do
|
||||||
columnsM <- withArgM args "columns" $ parseColumns colGNameMap
|
columnsM <- withArgM args "columns" $ parseColumns colGNameMap
|
||||||
isDistinct <- or <$> withArgM args "distinct" parseDistinct
|
isDistinct <- or <$> withArgM args "distinct" parseDistinct
|
||||||
@ -371,34 +454,33 @@ convertCount colGNameMap args = do
|
|||||||
toFields :: [(T.Text, a)] -> RS.Fields a
|
toFields :: [(T.Text, a)] -> RS.Fields a
|
||||||
toFields = map (first FieldName)
|
toFields = map (first FieldName)
|
||||||
|
|
||||||
convertColFlds
|
convertColumnFields
|
||||||
:: (MonadError QErr m)
|
:: (MonadError QErr m)
|
||||||
=> PGColGNameMap -> G.NamedType -> SelSet -> m RS.ColFlds
|
=> PGColGNameMap -> G.NamedType -> ObjectSelectionSet -> m RS.ColumnFields
|
||||||
convertColFlds colGNameMap ty selSet = fmap toFields $
|
convertColumnFields colGNameMap ty selSet = fmap toFields $
|
||||||
withSelSet selSet $ \fld ->
|
traverseObjectSelectionSet selSet $ \fld ->
|
||||||
case _fName fld of
|
case _fName fld of
|
||||||
"__typename" -> return $ RS.PCFExp $ G.unName $ G.unNamedType ty
|
"__typename" -> return $ RS.PCFExp $ G.unName $ G.unNamedType ty
|
||||||
n -> (RS.PCFCol . pgiColumn) <$> resolvePGCol colGNameMap n
|
n -> RS.PCFCol . pgiColumn <$> resolvePGCol colGNameMap n
|
||||||
|
|
||||||
convertAggFld
|
convertAggregateField
|
||||||
:: (MonadReusability m, MonadError QErr m)
|
:: (MonadReusability m, MonadError QErr m)
|
||||||
=> PGColGNameMap -> G.NamedType -> SelSet -> m RS.AggFlds
|
=> PGColGNameMap -> G.NamedType -> ObjectSelectionSet -> m RS.AggregateFields
|
||||||
convertAggFld colGNameMap ty selSet = fmap toFields $
|
convertAggregateField colGNameMap ty selSet = fmap toFields $
|
||||||
withSelSet selSet $ \fld -> do
|
traverseObjectSelectionSet selSet $ \Field{..} ->
|
||||||
let fType = _fType fld
|
case _fName of
|
||||||
fSelSet = _fSelSet fld
|
|
||||||
case _fName fld of
|
|
||||||
"__typename" -> return $ RS.AFExp $ G.unName $ G.unNamedType ty
|
"__typename" -> return $ RS.AFExp $ G.unName $ G.unNamedType ty
|
||||||
"count" -> RS.AFCount <$> convertCount colGNameMap (_fArguments fld)
|
"count" -> RS.AFCount <$> convertCount colGNameMap (_fArguments fld)
|
||||||
n -> do
|
n -> do
|
||||||
colFlds <- convertColFlds colGNameMap fType fSelSet
|
fSelSet <- asObjectSelectionSet _fSelSet
|
||||||
unless (isAggFld n) $ throwInvalidFld n
|
colFlds <- convertColumnFields colGNameMap _fType fSelSet
|
||||||
return $ RS.AFOp $ RS.AggOp (G.unName n) colFlds
|
unless (isAggregateField n) $ throwInvalidFld n
|
||||||
|
return $ RS.AFOp $ RS.AggregateOp (G.unName n) colFlds
|
||||||
where
|
where
|
||||||
throwInvalidFld (G.Name t) =
|
throwInvalidFld (G.Name t) =
|
||||||
throw500 $ "unexpected field in _aggregate node: " <> t
|
throw500 $ "unexpected field in _aggregate node: " <> t
|
||||||
|
|
||||||
type AnnAggSel = RS.AnnAggSelG UnresolvedVal
|
type AnnAggregateSelect = RS.AnnAggregateSelectG UnresolvedVal
|
||||||
|
|
||||||
fromAggField
|
fromAggField
|
||||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
@ -408,29 +490,162 @@ fromAggField
|
|||||||
-> PGColGNameMap
|
-> PGColGNameMap
|
||||||
-> AnnBoolExpPartialSQL
|
-> AnnBoolExpPartialSQL
|
||||||
-> Maybe Int
|
-> Maybe Int
|
||||||
-> Field -> m AnnAggSel
|
-> Field -> m AnnAggregateSelect
|
||||||
fromAggField selectFrom colGNameMap permFilter permLimit fld = fieldAsPath fld $ do
|
fromAggField selectFrom colGNameMap permFilter permLimit fld = fieldAsPath fld $ do
|
||||||
tableArgs <- parseTableArgs colGNameMap args
|
tableArgs <- parseSelectArgs colGNameMap args
|
||||||
aggSelFlds <- fromAggSelSet colGNameMap (_fType fld) (_fSelSet fld)
|
selSet <- asObjectSelectionSet $ _fSelSet fld
|
||||||
|
aggSelFlds <- fromAggSelSet colGNameMap (_fType fld) selSet
|
||||||
let unresolvedPermFltr =
|
let unresolvedPermFltr =
|
||||||
fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter
|
fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter
|
||||||
let tabPerm = RS.TablePerm unresolvedPermFltr permLimit
|
let tabPerm = RS.TablePerm unresolvedPermFltr permLimit
|
||||||
strfyNum <- stringifyNum <$> asks getter
|
strfyNum <- stringifyNum <$> asks getter
|
||||||
return $ RS.AnnSelG aggSelFlds selectFrom tabPerm tableArgs strfyNum
|
return $ RS.AnnSelectG aggSelFlds selectFrom tabPerm tableArgs strfyNum
|
||||||
where
|
where
|
||||||
args = _fArguments fld
|
args = _fArguments fld
|
||||||
|
|
||||||
|
fromConnectionField
|
||||||
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
|
)
|
||||||
|
=> RS.SelectFromG UnresolvedVal
|
||||||
|
-> NonEmpty PGColumnInfo
|
||||||
|
-> AnnBoolExpPartialSQL
|
||||||
|
-> Maybe Int
|
||||||
|
-> Field -> m (RS.ConnectionSelect UnresolvedVal)
|
||||||
|
fromConnectionField selectFrom pkCols permFilter permLimit fld = fieldAsPath fld $ do
|
||||||
|
(tableArgs, slice, split) <- parseConnectionArgs pkCols args
|
||||||
|
selSet <- asObjectSelectionSet $ _fSelSet fld
|
||||||
|
connSelFlds <- fromConnectionSelSet (_fType fld) selSet
|
||||||
|
strfyNum <- stringifyNum <$> asks getter
|
||||||
|
let unresolvedPermFltr =
|
||||||
|
fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter
|
||||||
|
tabPerm = RS.TablePerm unresolvedPermFltr permLimit
|
||||||
|
annSel = RS.AnnSelectG connSelFlds selectFrom tabPerm tableArgs strfyNum
|
||||||
|
pure $ RS.ConnectionSelect pkCols split slice annSel
|
||||||
|
where
|
||||||
|
args = _fArguments fld
|
||||||
|
|
||||||
|
parseConnectionArgs
|
||||||
|
:: forall r m.
|
||||||
|
( MonadReusability m, MonadError QErr m, MonadReader r m
|
||||||
|
, Has FieldMap r, Has OrdByCtx r
|
||||||
|
)
|
||||||
|
=> NonEmpty PGColumnInfo
|
||||||
|
-> ArgsMap
|
||||||
|
-> m ( SelectArgs
|
||||||
|
, Maybe RS.ConnectionSlice
|
||||||
|
, Maybe (NE.NonEmpty (RS.ConnectionSplit UnresolvedVal))
|
||||||
|
)
|
||||||
|
parseConnectionArgs pKeyColumns args = do
|
||||||
|
whereExpM <- withArgM args "where" parseBoolExp
|
||||||
|
ordByExpML <- withArgM args "order_by" parseOrderBy
|
||||||
|
|
||||||
|
slice <- case (Map.lookup "first" args, Map.lookup "last" args) of
|
||||||
|
(Nothing, Nothing) -> pure Nothing
|
||||||
|
(Just _, Just _) -> throwVE "\"first\" and \"last\" are not allowed at once"
|
||||||
|
(Just v, Nothing) -> Just . RS.SliceFirst <$> parseNonNegativeInt
|
||||||
|
"expecting Integer value for \"first\"" v
|
||||||
|
(Nothing, Just v) -> Just . RS.SliceLast <$> parseNonNegativeInt
|
||||||
|
"expecting Integer value for \"last\"" v
|
||||||
|
|
||||||
|
maybeSplit <- case (Map.lookup "after" args, Map.lookup "before" args) of
|
||||||
|
(Nothing, Nothing) -> pure Nothing
|
||||||
|
(Just _, Just _) -> throwVE "\"after\" and \"before\" are not allowed at once"
|
||||||
|
(Just v, Nothing) -> fmap ((RS.CSKAfter,) . base64Decode) <$> asPGColTextM v
|
||||||
|
(Nothing, Just v) -> fmap ((RS.CSKBefore,) . base64Decode) <$> asPGColTextM v
|
||||||
|
|
||||||
|
let ordByExpM = NE.nonEmpty =<< appendPrimaryKeyOrderBy <$> ordByExpML
|
||||||
|
tableArgs = RS.SelectArgs whereExpM ordByExpM Nothing Nothing Nothing
|
||||||
|
|
||||||
|
split <- mapM (uncurry (validateConnectionSplit ordByExpM)) maybeSplit
|
||||||
|
pure (tableArgs, slice, split)
|
||||||
|
where
|
||||||
|
appendPrimaryKeyOrderBy :: [RS.AnnOrderByItemG v] -> [RS.AnnOrderByItemG v]
|
||||||
|
appendPrimaryKeyOrderBy orderBys =
|
||||||
|
let orderByColumnNames =
|
||||||
|
orderBys ^.. traverse . to obiColumn . RS._AOCColumn . to pgiColumn
|
||||||
|
pkeyOrderBys = flip mapMaybe (toList pKeyColumns) $ \pgColumnInfo ->
|
||||||
|
if pgiColumn pgColumnInfo `elem` orderByColumnNames then Nothing
|
||||||
|
else Just $ OrderByItemG Nothing (RS.AOCColumn pgColumnInfo) Nothing
|
||||||
|
in orderBys <> pkeyOrderBys
|
||||||
|
|
||||||
|
validateConnectionSplit
|
||||||
|
:: Maybe (NonEmpty (RS.AnnOrderByItemG UnresolvedVal))
|
||||||
|
-> RS.ConnectionSplitKind
|
||||||
|
-> BL.ByteString
|
||||||
|
-> m (NonEmpty (RS.ConnectionSplit UnresolvedVal))
|
||||||
|
validateConnectionSplit maybeOrderBys splitKind cursorSplit = do
|
||||||
|
cursorValue <- either (const throwInvalidCursor) pure $
|
||||||
|
J.eitherDecode cursorSplit
|
||||||
|
case maybeOrderBys of
|
||||||
|
Nothing -> forM pKeyColumns $
|
||||||
|
\pgColumnInfo -> do
|
||||||
|
let columnJsonPath = [J.Key $ getPGColTxt $ pgiColumn pgColumnInfo]
|
||||||
|
pgColumnValue <- maybe throwInvalidCursor pure $ iResultToMaybe $
|
||||||
|
executeJSONPath columnJsonPath cursorValue
|
||||||
|
pgValue <- parsePGScalarValue (pgiType pgColumnInfo) pgColumnValue
|
||||||
|
let unresolvedValue = UVPG $ AnnPGVal Nothing False pgValue
|
||||||
|
pure $ RS.ConnectionSplit splitKind unresolvedValue $
|
||||||
|
OrderByItemG Nothing (RS.AOCColumn pgColumnInfo) Nothing
|
||||||
|
Just orderBys ->
|
||||||
|
forM orderBys $ \orderBy -> do
|
||||||
|
let OrderByItemG orderType annObCol nullsOrder = orderBy
|
||||||
|
orderByItemValue <- maybe throwInvalidCursor pure $ iResultToMaybe $
|
||||||
|
executeJSONPath (getPathFromOrderBy annObCol) cursorValue
|
||||||
|
pgValue <- parsePGScalarValue (getOrderByColumnType annObCol) orderByItemValue
|
||||||
|
let unresolvedValue = UVPG $ AnnPGVal Nothing False pgValue
|
||||||
|
pure $ RS.ConnectionSplit splitKind unresolvedValue $
|
||||||
|
OrderByItemG orderType (() <$ annObCol) nullsOrder
|
||||||
|
where
|
||||||
|
throwInvalidCursor = throwVE "the \"after\" or \"before\" cursor is invalid"
|
||||||
|
|
||||||
|
iResultToMaybe = \case
|
||||||
|
J.ISuccess v -> Just v
|
||||||
|
J.IError{} -> Nothing
|
||||||
|
|
||||||
|
getPathFromOrderBy = \case
|
||||||
|
RS.AOCColumn pgColInfo ->
|
||||||
|
let pathElement = J.Key $ getPGColTxt $ pgiColumn pgColInfo
|
||||||
|
in [pathElement]
|
||||||
|
RS.AOCObjectRelation relInfo _ obCol ->
|
||||||
|
let pathElement = J.Key $ relNameToTxt $ riName relInfo
|
||||||
|
in pathElement : getPathFromOrderBy obCol
|
||||||
|
RS.AOCArrayAggregation relInfo _ aggOb ->
|
||||||
|
let fieldName = J.Key $ relNameToTxt (riName relInfo) <> "_aggregate"
|
||||||
|
in fieldName : case aggOb of
|
||||||
|
RS.AAOCount -> [J.Key "count"]
|
||||||
|
RS.AAOOp t col -> [J.Key t, J.Key $ getPGColTxt $ pgiColumn col]
|
||||||
|
|
||||||
|
getOrderByColumnType = \case
|
||||||
|
RS.AOCColumn pgColInfo -> pgiType pgColInfo
|
||||||
|
RS.AOCObjectRelation _ _ obCol -> getOrderByColumnType obCol
|
||||||
|
RS.AOCArrayAggregation _ _ aggOb ->
|
||||||
|
case aggOb of
|
||||||
|
RS.AAOCount -> PGColumnScalar PGInteger
|
||||||
|
RS.AAOOp _ colInfo -> pgiType colInfo
|
||||||
|
|
||||||
convertAggSelect
|
convertAggSelect
|
||||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
, Has OrdByCtx r, Has SQLGenCtx r
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
)
|
)
|
||||||
=> SelOpCtx -> Field -> m (RS.AnnAggSelG UnresolvedVal)
|
=> SelOpCtx -> Field -> m (RS.AnnAggregateSelectG UnresolvedVal)
|
||||||
convertAggSelect opCtx fld =
|
convertAggSelect opCtx fld =
|
||||||
withPathK "selectionSet" $
|
withPathK "selectionSet" $
|
||||||
fromAggField (RS.FromTable qt) colGNameMap permFilter permLimit fld
|
fromAggField (RS.FromTable qt) colGNameMap permFilter permLimit fld
|
||||||
where
|
where
|
||||||
SelOpCtx qt _ colGNameMap permFilter permLimit = opCtx
|
SelOpCtx qt _ colGNameMap permFilter permLimit = opCtx
|
||||||
|
|
||||||
|
convertConnectionSelect
|
||||||
|
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||||
|
, Has OrdByCtx r, Has SQLGenCtx r
|
||||||
|
)
|
||||||
|
=> NonEmpty PGColumnInfo -> SelOpCtx -> Field -> m (RS.ConnectionSelect UnresolvedVal)
|
||||||
|
convertConnectionSelect pkCols opCtx fld =
|
||||||
|
withPathK "selectionSet" $
|
||||||
|
fromConnectionField (RS.FromTable qt) pkCols permFilter permLimit fld
|
||||||
|
where
|
||||||
|
SelOpCtx qt _ _ permFilter permLimit = opCtx
|
||||||
|
|
||||||
parseFunctionArgs
|
parseFunctionArgs
|
||||||
:: (MonadReusability m, MonadError QErr m)
|
:: (MonadReusability m, MonadError QErr m)
|
||||||
=> Seq.Seq a
|
=> Seq.Seq a
|
||||||
@ -506,10 +721,77 @@ convertFuncQueryAgg
|
|||||||
, Has OrdByCtx r
|
, Has OrdByCtx r
|
||||||
, Has SQLGenCtx r
|
, Has SQLGenCtx r
|
||||||
)
|
)
|
||||||
=> FuncQOpCtx -> Field -> m AnnAggSel
|
=> FuncQOpCtx -> Field -> m AnnAggregateSelect
|
||||||
convertFuncQueryAgg funcOpCtx fld =
|
convertFuncQueryAgg funcOpCtx fld =
|
||||||
withPathK "selectionSet" $ fieldAsPath fld $ do
|
withPathK "selectionSet" $ fieldAsPath fld $ do
|
||||||
selectFrom <- makeFunctionSelectFrom qf argSeq fld
|
selectFrom <- makeFunctionSelectFrom qf argSeq fld
|
||||||
fromAggField selectFrom colGNameMap permFilter permLimit fld
|
fromAggField selectFrom colGNameMap permFilter permLimit fld
|
||||||
where
|
where
|
||||||
FuncQOpCtx qf argSeq _ colGNameMap permFilter permLimit = funcOpCtx
|
FuncQOpCtx qf argSeq _ colGNameMap permFilter permLimit = funcOpCtx
|
||||||
|
|
||||||
|
convertConnectionFuncQuery
|
||||||
|
:: ( MonadReusability m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReader r m
|
||||||
|
, Has FieldMap r
|
||||||
|
, Has OrdByCtx r
|
||||||
|
, Has SQLGenCtx r
|
||||||
|
)
|
||||||
|
=> NonEmpty PGColumnInfo -> FuncQOpCtx -> Field -> m (RS.ConnectionSelect UnresolvedVal)
|
||||||
|
convertConnectionFuncQuery pkCols funcOpCtx fld =
|
||||||
|
withPathK "selectionSet" $ fieldAsPath fld $ do
|
||||||
|
selectFrom <- makeFunctionSelectFrom qf argSeq fld
|
||||||
|
fromConnectionField selectFrom pkCols permFilter permLimit fld
|
||||||
|
where
|
||||||
|
FuncQOpCtx qf argSeq _ _ permFilter permLimit = funcOpCtx
|
||||||
|
|
||||||
|
resolveNodeId
|
||||||
|
:: forall m. ( MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
)
|
||||||
|
=> Field -> m NodeIdData
|
||||||
|
resolveNodeId field =
|
||||||
|
withPathK "selectionSet" $ fieldAsPath field $ do
|
||||||
|
nodeIdText <- asPGColText =<< getArg (_fArguments field) "id"
|
||||||
|
either (const throwInvalidNodeId) pure $
|
||||||
|
J.eitherDecode $ base64Decode nodeIdText
|
||||||
|
where
|
||||||
|
throwInvalidNodeId = throwVE "the node id is invalid"
|
||||||
|
|
||||||
|
convertNodeSelect
|
||||||
|
:: ( MonadReusability m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReader r m
|
||||||
|
, Has FieldMap r
|
||||||
|
, Has OrdByCtx r
|
||||||
|
, Has SQLGenCtx r
|
||||||
|
)
|
||||||
|
=> SelOpCtx
|
||||||
|
-> Map.HashMap PGCol J.Value
|
||||||
|
-> Field
|
||||||
|
-> m (RS.AnnSimpleSelG UnresolvedVal)
|
||||||
|
convertNodeSelect selOpCtx pkeyColumnValues field =
|
||||||
|
withPathK "selectionSet" $ fieldAsPath field $ do
|
||||||
|
-- Parse selection set as interface
|
||||||
|
ifaceSelectionSet <- asInterfaceSelectionSet $ _fSelSet field
|
||||||
|
let tableObjectType = mkTableTy table
|
||||||
|
selSet = getMemberSelectionSet tableObjectType ifaceSelectionSet
|
||||||
|
unresolvedPermFilter = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter
|
||||||
|
tablePerm = RS.TablePerm unresolvedPermFilter permLimit
|
||||||
|
-- Resolve the table selection set
|
||||||
|
annFields <- processTableSelectionSet tableObjectType selSet
|
||||||
|
-- Resolve the Node id primary key column values
|
||||||
|
unresolvedPkeyValues <- flip Map.traverseWithKey pkeyColumnValues $
|
||||||
|
\pgColumn jsonValue -> case Map.lookup pgColumn pgColumnMap of
|
||||||
|
Nothing -> throwVE $ "column " <> pgColumn <<> " not found"
|
||||||
|
Just columnInfo -> (,columnInfo) . UVPG . AnnPGVal Nothing False <$>
|
||||||
|
parsePGScalarValue (pgiType columnInfo) jsonValue
|
||||||
|
-- Generate the bool expression from the primary key column values
|
||||||
|
let pkeyBoolExp = BoolAnd $ flip map (Map.elems unresolvedPkeyValues) $
|
||||||
|
\(unresolvedValue, columnInfo) -> (BoolFld . AVCol columnInfo) [AEQ True unresolvedValue]
|
||||||
|
selectArgs = RS.noSelectArgs{RS._saWhere = Just pkeyBoolExp}
|
||||||
|
strfyNum <- stringifyNum <$> asks getter
|
||||||
|
pure $ RS.AnnSelectG annFields (RS.FromTable table) tablePerm selectArgs strfyNum
|
||||||
|
where
|
||||||
|
SelOpCtx table _ allColumns permFilter permLimit = selOpCtx
|
||||||
|
pgColumnMap = mapFromL pgiColumn $ Map.elems allColumns
|
||||||
|
@ -7,6 +7,9 @@ module Hasura.GraphQL.Resolve.Types
|
|||||||
import Control.Lens.TH
|
import Control.Lens.TH
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
|
|
||||||
|
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.HashMap.Strict as Map
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
@ -27,12 +30,17 @@ import Hasura.SQL.Value
|
|||||||
|
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
|
|
||||||
|
type NodeSelectMap = Map.HashMap G.NamedType SelOpCtx
|
||||||
|
|
||||||
data QueryCtx
|
data QueryCtx
|
||||||
= QCSelect !SelOpCtx
|
= QCNodeSelect !NodeSelectMap
|
||||||
|
| QCSelect !SelOpCtx
|
||||||
|
| QCSelectConnection !(NonEmpty PGColumnInfo) !SelOpCtx
|
||||||
| QCSelectPkey !SelPkOpCtx
|
| QCSelectPkey !SelPkOpCtx
|
||||||
| QCSelectAgg !SelOpCtx
|
| QCSelectAgg !SelOpCtx
|
||||||
| QCFuncQuery !FuncQOpCtx
|
| QCFuncQuery !FuncQOpCtx
|
||||||
| QCFuncAggQuery !FuncQOpCtx
|
| QCFuncAggQuery !FuncQOpCtx
|
||||||
|
| QCFuncConnection !(NonEmpty PGColumnInfo) !FuncQOpCtx
|
||||||
| QCAsyncActionFetch !ActionSelectOpContext
|
| QCAsyncActionFetch !ActionSelectOpContext
|
||||||
| QCAction !ActionExecutionContext
|
| QCAction !ActionExecutionContext
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
@ -130,10 +138,16 @@ data ActionSelectOpContext
|
|||||||
-- used in resolvers
|
-- used in resolvers
|
||||||
type PGColGNameMap = Map.HashMap G.Name PGColumnInfo
|
type PGColGNameMap = Map.HashMap G.Name PGColumnInfo
|
||||||
|
|
||||||
|
data RelationshipFieldKind
|
||||||
|
= RFKAggregate
|
||||||
|
| RFKSimple
|
||||||
|
| RFKConnection !(NonEmpty PGColumnInfo)
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data RelationshipField
|
data RelationshipField
|
||||||
= RelationshipField
|
= RelationshipField
|
||||||
{ _rfInfo :: !RelInfo
|
{ _rfInfo :: !RelInfo
|
||||||
, _rfIsAgg :: !Bool
|
, _rfIsAgg :: !RelationshipFieldKind
|
||||||
, _rfCols :: !PGColGNameMap
|
, _rfCols :: !PGColGNameMap
|
||||||
, _rfPermFilter :: !AnnBoolExpPartialSQL
|
, _rfPermFilter :: !AnnBoolExpPartialSQL
|
||||||
, _rfPermLimit :: !(Maybe Int)
|
, _rfPermLimit :: !(Maybe Int)
|
||||||
@ -166,6 +180,8 @@ data ResolveField
|
|||||||
= RFPGColumn !PGColumnInfo
|
= RFPGColumn !PGColumnInfo
|
||||||
| RFRelationship !RelationshipField
|
| RFRelationship !RelationshipField
|
||||||
| RFComputedField !ComputedField
|
| RFComputedField !ComputedField
|
||||||
|
| RFRemoteRelationship !RemoteFieldInfo
|
||||||
|
| RFNodeId !QualifiedTable !(NonEmpty PGColumnInfo)
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
type FieldMap = Map.HashMap (G.NamedType, G.Name) ResolveField
|
type FieldMap = Map.HashMap (G.NamedType, G.Name) ResolveField
|
||||||
@ -245,6 +261,13 @@ data InputFunctionArgument
|
|||||||
| IFAUnknown !FunctionArgItem -- ^ Unknown value, need to be parsed
|
| IFAUnknown !FunctionArgItem -- ^ Unknown value, need to be parsed
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
data NodeIdData
|
||||||
|
= NodeIdData
|
||||||
|
{ _nidTable :: !QualifiedTable
|
||||||
|
, _nidColumns :: !(Map.HashMap PGCol J.Value)
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
$(J.deriveFromJSON (J.aesonDrop 4 J.snakeCase) ''NodeIdData)
|
||||||
|
|
||||||
-- template haskell related
|
-- template haskell related
|
||||||
$(makePrisms ''ResolveField)
|
$(makePrisms ''ResolveField)
|
||||||
$(makeLenses ''ComputedField)
|
$(makeLenses ''ComputedField)
|
||||||
|
@ -132,7 +132,7 @@ actionIdParser =
|
|||||||
actionOutputFields
|
actionOutputFields
|
||||||
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m, Has QueryContext r)
|
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m, Has QueryContext r)
|
||||||
=> AnnotatedObjectType
|
=> AnnotatedObjectType
|
||||||
-> MaybeT m (Parser 'Output n (RQL.AnnFldsG UnpreparedValue))
|
-> MaybeT m (Parser 'Output n (RQL.AnnFieldsG UnpreparedValue))
|
||||||
actionOutputFields outputObject = do
|
actionOutputFields outputObject = do
|
||||||
let scalarOrEnumFields = map scalarOrEnumFieldParser $ toList $ _otdFields outputObject
|
let scalarOrEnumFields = map scalarOrEnumFieldParser $ toList $ _otdFields outputObject
|
||||||
relationshipFields <- forM (_otdRelationships outputObject) $ traverse relationshipFieldParser
|
relationshipFields <- forM (_otdRelationships outputObject) $ traverse relationshipFieldParser
|
||||||
@ -141,11 +141,11 @@ actionOutputFields outputObject = do
|
|||||||
outputTypeName = unObjectTypeName $ _otdName outputObject
|
outputTypeName = unObjectTypeName $ _otdName outputObject
|
||||||
outputTypeDescription = _otdDescription outputObject
|
outputTypeDescription = _otdDescription outputObject
|
||||||
pure $ P.selectionSet outputTypeName outputTypeDescription allFieldParsers
|
pure $ P.selectionSet outputTypeName outputTypeDescription allFieldParsers
|
||||||
<&> parsedSelectionsToFields RQL.FExp
|
<&> parsedSelectionsToFields RQL.AFExpression
|
||||||
where
|
where
|
||||||
scalarOrEnumFieldParser
|
scalarOrEnumFieldParser
|
||||||
:: ObjectFieldDefinition (G.GType, AnnotatedObjectFieldType)
|
:: ObjectFieldDefinition (G.GType, AnnotatedObjectFieldType)
|
||||||
-> FieldParser n (RQL.AnnFldG UnpreparedValue)
|
-> FieldParser n (RQL.AnnFieldG UnpreparedValue)
|
||||||
scalarOrEnumFieldParser (ObjectFieldDefinition name _ description ty) =
|
scalarOrEnumFieldParser (ObjectFieldDefinition name _ description ty) =
|
||||||
let (gType, objectFieldType) = ty
|
let (gType, objectFieldType) = ty
|
||||||
fieldName = unObjectFieldName name
|
fieldName = unObjectFieldName name
|
||||||
@ -157,11 +157,11 @@ actionOutputFields outputObject = do
|
|||||||
AOFTEnum def -> customEnumParser def
|
AOFTEnum def -> customEnumParser def
|
||||||
in bool P.nonNullableField id (G.isNullable gType) $
|
in bool P.nonNullableField id (G.isNullable gType) $
|
||||||
P.selection_ (unObjectFieldName name) description fieldParser
|
P.selection_ (unObjectFieldName name) description fieldParser
|
||||||
$> RQL.mkAnnColField pgColumnInfo Nothing
|
$> RQL.mkAnnColumnField pgColumnInfo Nothing
|
||||||
|
|
||||||
relationshipFieldParser
|
relationshipFieldParser
|
||||||
:: TypeRelationship TableInfo PGColumnInfo
|
:: TypeRelationship TableInfo PGColumnInfo
|
||||||
-> MaybeT m (FieldParser n (RQL.AnnFldG UnpreparedValue))
|
-> MaybeT m (FieldParser n (RQL.AnnFieldG UnpreparedValue))
|
||||||
relationshipFieldParser typeRelationship = do
|
relationshipFieldParser typeRelationship = do
|
||||||
let TypeRelationship relName relType tableInfo fieldMapping = typeRelationship
|
let TypeRelationship relName relType tableInfo fieldMapping = typeRelationship
|
||||||
tableName = _tciName $ _tiCoreInfo tableInfo
|
tableName = _tciName $ _tiCoreInfo tableInfo
|
||||||
@ -175,10 +175,10 @@ actionOutputFields outputObject = do
|
|||||||
[ (unsafePGCol $ G.unName $ unObjectFieldName k, pgiColumn v)
|
[ (unsafePGCol $ G.unName $ unObjectFieldName k, pgiColumn v)
|
||||||
| (k, v) <- Map.toList fieldMapping
|
| (k, v) <- Map.toList fieldMapping
|
||||||
]
|
]
|
||||||
annotatedRelationship = RQL.AnnRelG tableRelName columnMapping selectExp
|
annotatedRelationship = RQL.AnnRelationSelectG tableRelName columnMapping selectExp
|
||||||
in case relType of
|
in case relType of
|
||||||
ObjRel -> RQL.FObj annotatedRelationship
|
ObjRel -> RQL.AFObjectRelation annotatedRelationship
|
||||||
ArrRel -> RQL.FArr $ RQL.ASSimple annotatedRelationship
|
ArrRel -> RQL.AFArrayRelation $ RQL.ASSimple annotatedRelationship
|
||||||
|
|
||||||
mkDefinitionList :: AnnotatedObjectType -> [(PGCol, PGScalarType)]
|
mkDefinitionList :: AnnotatedObjectType -> [(PGCol, PGScalarType)]
|
||||||
mkDefinitionList annotatedOutputType =
|
mkDefinitionList annotatedOutputType =
|
||||||
|
@ -52,7 +52,7 @@ orderByExp table selectPermissions = memoizeOn 'orderByExp table $ do
|
|||||||
FIColumn columnInfo -> do
|
FIColumn columnInfo -> do
|
||||||
let fieldName = pgiName columnInfo
|
let fieldName = pgiName columnInfo
|
||||||
pure $ P.fieldOptional fieldName Nothing orderByOperator
|
pure $ P.fieldOptional fieldName Nothing orderByOperator
|
||||||
<&> fmap (pure . mkOrderByItemG (RQL.AOCPG $ pgiColumn columnInfo)) . join
|
<&> fmap (pure . mkOrderByItemG (RQL.AOCColumn columnInfo)) . join
|
||||||
FIRelationship relationshipInfo -> do
|
FIRelationship relationshipInfo -> do
|
||||||
let remoteTable = riRTable relationshipInfo
|
let remoteTable = riRTable relationshipInfo
|
||||||
fieldName <- MaybeT $ pure $ G.mkName $ relNameToTxt $ riName relationshipInfo
|
fieldName <- MaybeT $ pure $ G.mkName $ relNameToTxt $ riName relationshipInfo
|
||||||
@ -63,13 +63,13 @@ orderByExp table selectPermissions = memoizeOn 'orderByExp table $ do
|
|||||||
otherTableParser <- lift $ orderByExp remoteTable perms
|
otherTableParser <- lift $ orderByExp remoteTable perms
|
||||||
pure $ do
|
pure $ do
|
||||||
otherTableOrderBy <- join <$> P.fieldOptional fieldName Nothing (P.nullable otherTableParser)
|
otherTableOrderBy <- join <$> P.fieldOptional fieldName Nothing (P.nullable otherTableParser)
|
||||||
pure $ fmap (map $ fmap $ RQL.AOCObj relationshipInfo newPerms) otherTableOrderBy
|
pure $ fmap (map $ fmap $ RQL.AOCObjectRelation relationshipInfo newPerms) otherTableOrderBy
|
||||||
ArrRel -> do
|
ArrRel -> do
|
||||||
let aggregateFieldName = fieldName <> $$(G.litName "_aggregate")
|
let aggregateFieldName = fieldName <> $$(G.litName "_aggregate")
|
||||||
aggregationParser <- lift $ orderByAggregation remoteTable perms
|
aggregationParser <- lift $ orderByAggregation remoteTable perms
|
||||||
pure $ do
|
pure $ do
|
||||||
aggregationOrderBy <- join <$> P.fieldOptional aggregateFieldName Nothing (P.nullable aggregationParser)
|
aggregationOrderBy <- join <$> P.fieldOptional aggregateFieldName Nothing (P.nullable aggregationParser)
|
||||||
pure $ fmap (map $ fmap $ RQL.AOCAgg relationshipInfo newPerms) aggregationOrderBy
|
pure $ fmap (map $ fmap $ RQL.AOCArrayAggregation relationshipInfo newPerms) aggregationOrderBy
|
||||||
FIComputedField _ -> empty
|
FIComputedField _ -> empty
|
||||||
FIRemoteRelationship _ -> empty
|
FIRemoteRelationship _ -> empty
|
||||||
|
|
||||||
@ -84,7 +84,7 @@ orderByAggregation
|
|||||||
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
||||||
=> QualifiedTable
|
=> QualifiedTable
|
||||||
-> SelPermInfo
|
-> SelPermInfo
|
||||||
-> m (Parser 'Input n [OrderByItemG RQL.AnnAggOrdBy])
|
-> m (Parser 'Input n [OrderByItemG RQL.AnnAggregateOrderBy])
|
||||||
orderByAggregation table selectPermissions = do
|
orderByAggregation table selectPermissions = do
|
||||||
-- WIP NOTE
|
-- WIP NOTE
|
||||||
-- there is heavy duplication between this and Select.tableAggregationFields
|
-- there is heavy duplication between this and Select.tableAggregationFields
|
||||||
@ -113,16 +113,16 @@ orderByAggregation table selectPermissions = do
|
|||||||
description = G.Description $ "order by aggregate values of table \"" <> table <<> "\""
|
description = G.Description $ "order by aggregate values of table \"" <> table <<> "\""
|
||||||
pure $ P.object objectName (Just description) aggFields
|
pure $ P.object objectName (Just description) aggFields
|
||||||
where
|
where
|
||||||
mkField :: PGColumnInfo -> InputFieldsParser n (Maybe (PGCol, OrderInfo))
|
mkField :: PGColumnInfo -> InputFieldsParser n (Maybe (PGColumnInfo, OrderInfo))
|
||||||
mkField columnInfo =
|
mkField columnInfo =
|
||||||
P.fieldOptional (pgiName columnInfo) (pgiDescription columnInfo) orderByOperator
|
P.fieldOptional (pgiName columnInfo) (pgiDescription columnInfo) orderByOperator
|
||||||
<&> fmap (pgiColumn columnInfo,) . join
|
<&> fmap (columnInfo,) . join
|
||||||
|
|
||||||
parseOperator
|
parseOperator
|
||||||
:: G.Name
|
:: G.Name
|
||||||
-> G.Name
|
-> G.Name
|
||||||
-> InputFieldsParser n [(PGCol, OrderInfo)]
|
-> InputFieldsParser n [(PGColumnInfo, OrderInfo)]
|
||||||
-> InputFieldsParser n (Maybe [OrderByItemG RQL.AnnAggOrdBy])
|
-> InputFieldsParser n (Maybe [OrderByItemG RQL.AnnAggregateOrderBy])
|
||||||
parseOperator operator tableName columns =
|
parseOperator operator tableName columns =
|
||||||
let opText = G.unName operator
|
let opText = G.unName operator
|
||||||
-- FIXME: isn't G.Name a Monoid?
|
-- FIXME: isn't G.Name a Monoid?
|
||||||
|
@ -51,11 +51,11 @@ import Hasura.SQL.Value
|
|||||||
|
|
||||||
|
|
||||||
type SelectExp = RQL.AnnSimpleSelG UnpreparedValue
|
type SelectExp = RQL.AnnSimpleSelG UnpreparedValue
|
||||||
type AggSelectExp = RQL.AnnAggSelG UnpreparedValue
|
type AggSelectExp = RQL.AnnAggregateSelectG UnpreparedValue
|
||||||
type TableArgs = RQL.TableArgsG UnpreparedValue
|
type SelectArgs = RQL.SelectArgsG UnpreparedValue
|
||||||
type TablePerms = RQL.TablePermG UnpreparedValue
|
type TablePerms = RQL.TablePermG UnpreparedValue
|
||||||
type AnnotatedFields = RQL.AnnFldsG UnpreparedValue
|
type AnnotatedFields = RQL.AnnFieldsG UnpreparedValue
|
||||||
type AnnotatedField = RQL.AnnFldG UnpreparedValue
|
type AnnotatedField = RQL.AnnFieldG UnpreparedValue
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -83,7 +83,7 @@ selectTable table fieldName description selectPermissions = do
|
|||||||
tableArgsParser <- tableArgs table selectPermissions
|
tableArgsParser <- tableArgs table selectPermissions
|
||||||
selectionSetParser <- tableSelectionSet table selectPermissions Nothing
|
selectionSetParser <- tableSelectionSet table selectPermissions Nothing
|
||||||
pure $ P.subselection fieldName description tableArgsParser selectionSetParser
|
pure $ P.subselection fieldName description tableArgsParser selectionSetParser
|
||||||
<&> \(args, fields) -> RQL.AnnSelG
|
<&> \(args, fields) -> RQL.AnnSelectG
|
||||||
{ RQL._asnFields = fields
|
{ RQL._asnFields = fields
|
||||||
, RQL._asnFrom = RQL.FromTable table
|
, RQL._asnFrom = RQL.FromTable table
|
||||||
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
||||||
@ -121,13 +121,13 @@ selectTableByPk table fieldName description selectPermissions = runMaybeT do
|
|||||||
<&> \(boolExpr, fields) ->
|
<&> \(boolExpr, fields) ->
|
||||||
let defaultPerms = tablePermissionsInfo selectPermissions
|
let defaultPerms = tablePermissionsInfo selectPermissions
|
||||||
whereExpr = Just $ BoolAnd $ toList boolExpr
|
whereExpr = Just $ BoolAnd $ toList boolExpr
|
||||||
in RQL.AnnSelG
|
in RQL.AnnSelectG
|
||||||
{ RQL._asnFields = fields
|
{ RQL._asnFields = fields
|
||||||
, RQL._asnFrom = RQL.FromTable table
|
, RQL._asnFrom = RQL.FromTable table
|
||||||
, RQL._asnPerm = defaultPerms { RQL._tpLimit = Nothing }
|
, RQL._asnPerm = defaultPerms { RQL._tpLimit = Nothing }
|
||||||
-- TODO: check whether this is necessary: ^^^^^^^
|
-- TODO: check whether this is necessary: ^^^^^^^
|
||||||
-- This is how it was in legacy code.
|
-- This is how it was in legacy code.
|
||||||
, RQL._asnArgs = RQL.noTableArgs { RQL._taWhere = whereExpr }
|
, RQL._asnArgs = RQL.noSelectArgs { RQL._saWhere = whereExpr }
|
||||||
, RQL._asnStrfyNum = stringifyNum
|
, RQL._asnStrfyNum = stringifyNum
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -161,7 +161,7 @@ selectTableAggregate table fieldName description selectPermissions = runMaybeT d
|
|||||||
, RQL.TAFAgg <$> P.subselection_ $$(G.litName "aggregate") Nothing aggregateParser
|
, RQL.TAFAgg <$> P.subselection_ $$(G.litName "aggregate") Nothing aggregateParser
|
||||||
]
|
]
|
||||||
pure $ P.subselection fieldName description tableArgsParser aggregationParser
|
pure $ P.subselection fieldName description tableArgsParser aggregationParser
|
||||||
<&> \(args, fields) -> RQL.AnnSelG
|
<&> \(args, fields) -> RQL.AnnSelectG
|
||||||
{ RQL._asnFields = fields
|
{ RQL._asnFields = fields
|
||||||
, RQL._asnFrom = RQL.FromTable table
|
, RQL._asnFrom = RQL.FromTable table
|
||||||
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
||||||
@ -249,7 +249,7 @@ tableSelectionSet table selectPermissions interfaceM = memoizeOn 'tableSelection
|
|||||||
|
|
||||||
let description = G.Description . getPGDescription <$> _tciDescription tableInfo
|
let description = G.Description . getPGDescription <$> _tciDescription tableInfo
|
||||||
pure $ P.selectionSetObject tableName description fieldParsers (toList interfaceM)
|
pure $ P.selectionSetObject tableName description fieldParsers (toList interfaceM)
|
||||||
<&> parsedSelectionsToFields RQL.FExp
|
<&> parsedSelectionsToFields RQL.AFExpression
|
||||||
|
|
||||||
|
|
||||||
-- | User-defined function (AKA custom function)
|
-- | User-defined function (AKA custom function)
|
||||||
@ -268,7 +268,7 @@ selectFunction function fieldName description selectPermissions = do
|
|||||||
selectionSetParser <- tableSelectionSet table selectPermissions Nothing
|
selectionSetParser <- tableSelectionSet table selectPermissions Nothing
|
||||||
let argsParser = liftA2 (,) functionArgsParser tableArgsParser
|
let argsParser = liftA2 (,) functionArgsParser tableArgsParser
|
||||||
pure $ P.subselection fieldName description argsParser selectionSetParser
|
pure $ P.subselection fieldName description argsParser selectionSetParser
|
||||||
<&> \((funcArgs, tableArgs'), fields) -> RQL.AnnSelG
|
<&> \((funcArgs, tableArgs'), fields) -> RQL.AnnSelectG
|
||||||
{ RQL._asnFields = fields
|
{ RQL._asnFields = fields
|
||||||
, RQL._asnFrom = RQL.FromFunction (fiName function) funcArgs Nothing
|
, RQL._asnFrom = RQL.FromFunction (fiName function) funcArgs Nothing
|
||||||
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
||||||
@ -299,7 +299,7 @@ selectFunctionAggregate function fieldName description selectPermissions = runMa
|
|||||||
, RQL.TAFAgg <$> P.subselection_ $$(G.litName "aggregate") Nothing aggregateParser
|
, RQL.TAFAgg <$> P.subselection_ $$(G.litName "aggregate") Nothing aggregateParser
|
||||||
]
|
]
|
||||||
pure $ P.subselection fieldName description argsParser aggregationParser
|
pure $ P.subselection fieldName description argsParser aggregationParser
|
||||||
<&> \((funcArgs, tableArgs'), fields) -> RQL.AnnSelG
|
<&> \((funcArgs, tableArgs'), fields) -> RQL.AnnSelectG
|
||||||
{ RQL._asnFields = fields
|
{ RQL._asnFields = fields
|
||||||
, RQL._asnFrom = RQL.FromFunction (fiName function) funcArgs Nothing
|
, RQL._asnFrom = RQL.FromFunction (fiName function) funcArgs Nothing
|
||||||
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
||||||
@ -323,7 +323,7 @@ tableArgs
|
|||||||
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
||||||
=> QualifiedTable
|
=> QualifiedTable
|
||||||
-> SelPermInfo
|
-> SelPermInfo
|
||||||
-> m (InputFieldsParser n TableArgs)
|
-> m (InputFieldsParser n SelectArgs)
|
||||||
tableArgs table selectPermissions = do
|
tableArgs table selectPermissions = do
|
||||||
boolExpParser <- boolExp table (Just selectPermissions)
|
boolExpParser <- boolExp table (Just selectPermissions)
|
||||||
orderByParser <- orderByExp table selectPermissions
|
orderByParser <- orderByExp table selectPermissions
|
||||||
@ -342,7 +342,7 @@ tableArgs table selectPermissions = do
|
|||||||
-- despite the schema explicitly declaring it as an int; the suspected goal
|
-- despite the schema explicitly declaring it as an int; the suspected goal
|
||||||
-- of this was to allow for bigint offsets, but there's no surviving commit
|
-- of this was to allow for bigint offsets, but there's no surviving commit
|
||||||
-- message or documentation that states it explicity. A visible artefact of
|
-- message or documentation that states it explicity. A visible artefact of
|
||||||
-- this is the fact that in the TableArgs we store a SQL expression for the
|
-- this is the fact that in the SelectArgs we store a SQL expression for the
|
||||||
-- offet while the limit is stored as a normal int.
|
-- offet while the limit is stored as a normal int.
|
||||||
--
|
--
|
||||||
-- While it would be possible to write a custom parser that advertises
|
-- While it would be possible to write a custom parser that advertises
|
||||||
@ -352,12 +352,12 @@ tableArgs table selectPermissions = do
|
|||||||
-- TODO: distinct_on must be validated ungainst order_by
|
-- TODO: distinct_on must be validated ungainst order_by
|
||||||
-- the check at Resolve/Select.hs:152 must be ported here
|
-- the check at Resolve/Select.hs:152 must be ported here
|
||||||
|
|
||||||
pure $ RQL.TableArgs
|
pure $ RQL.SelectArgs
|
||||||
{ RQL._taWhere = whereF
|
{ RQL._saWhere = whereF
|
||||||
, RQL._taOrderBy = nonEmpty . concat =<< orderBy
|
, RQL._saOrderBy = nonEmpty . concat =<< orderBy
|
||||||
, RQL._taLimit = fromIntegral <$> limit
|
, RQL._saLimit = fromIntegral <$> limit
|
||||||
, RQL._taOffset = txtEncoder . PGValInteger <$> offset
|
, RQL._saOffset = txtEncoder . PGValInteger <$> offset
|
||||||
, RQL._taDistCols = nonEmpty =<< distinct
|
, RQL._saDistinct = nonEmpty =<< distinct
|
||||||
}
|
}
|
||||||
where
|
where
|
||||||
-- TH splices mess up ApplicativeDo
|
-- TH splices mess up ApplicativeDo
|
||||||
@ -398,7 +398,7 @@ tableAggregationFields
|
|||||||
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
||||||
=> QualifiedTable
|
=> QualifiedTable
|
||||||
-> SelPermInfo
|
-> SelPermInfo
|
||||||
-> m (Parser 'Output n RQL.AggFlds)
|
-> m (Parser 'Output n RQL.AggregateFields)
|
||||||
tableAggregationFields table selectPermissions = do
|
tableAggregationFields table selectPermissions = do
|
||||||
tableName <- qualifiedObjectToName table
|
tableName <- qualifiedObjectToName table
|
||||||
allColumns <- tableSelectColumns table selectPermissions
|
allColumns <- tableSelectColumns table selectPermissions
|
||||||
@ -447,7 +447,7 @@ tableAggregationFields table selectPermissions = do
|
|||||||
:: G.Name
|
:: G.Name
|
||||||
-> G.Name
|
-> G.Name
|
||||||
-> [FieldParser n RQL.PGColFld]
|
-> [FieldParser n RQL.PGColFld]
|
||||||
-> FieldParser n RQL.AggFld
|
-> FieldParser n RQL.AggregateField
|
||||||
parseOperator operator tableName columns =
|
parseOperator operator tableName columns =
|
||||||
let opText = G.unName operator
|
let opText = G.unName operator
|
||||||
setName = tableName <> $$(G.litName "_") <> operator <> $$(G.litName "_fields")
|
setName = tableName <> $$(G.litName "_") <> operator <> $$(G.litName "_fields")
|
||||||
@ -455,7 +455,7 @@ tableAggregationFields table selectPermissions = do
|
|||||||
subselectionParser = P.selectionSet setName setDesc columns
|
subselectionParser = P.selectionSet setName setDesc columns
|
||||||
<&> parsedSelectionsToFields RQL.PCFExp
|
<&> parsedSelectionsToFields RQL.PCFExp
|
||||||
in P.subselection_ operator Nothing subselectionParser
|
in P.subselection_ operator Nothing subselectionParser
|
||||||
<&> (RQL.AFOp . RQL.AggOp opText)
|
<&> (RQL.AFOp . RQL.AggregateOp opText)
|
||||||
|
|
||||||
lookupRemoteField'
|
lookupRemoteField'
|
||||||
:: (MonadSchema n m, MonadTableInfo r m)
|
:: (MonadSchema n m, MonadTableInfo r m)
|
||||||
@ -499,7 +499,7 @@ fieldSelection fieldInfo selectPermissions = do
|
|||||||
pathArg = jsonPathArg $ pgiType columnInfo
|
pathArg = jsonPathArg $ pgiType columnInfo
|
||||||
field <- lift $ P.column (pgiType columnInfo) (G.Nullability $ pgiIsNullable columnInfo)
|
field <- lift $ P.column (pgiType columnInfo) (G.Nullability $ pgiIsNullable columnInfo)
|
||||||
pure $ P.selection fieldName (pgiDescription columnInfo) pathArg field
|
pure $ P.selection fieldName (pgiDescription columnInfo) pathArg field
|
||||||
<&> RQL.mkAnnColField columnInfo
|
<&> RQL.mkAnnColumnField columnInfo
|
||||||
|
|
||||||
FIRelationship relationshipInfo -> concat . maybeToList <$> runMaybeT do
|
FIRelationship relationshipInfo -> concat . maybeToList <$> runMaybeT do
|
||||||
-- TODO: move this to a separate function?
|
-- TODO: move this to a separate function?
|
||||||
@ -514,10 +514,10 @@ fieldSelection fieldInfo selectPermissions = do
|
|||||||
relFieldName <- lift $ textToName $ relNameToTxt relName
|
relFieldName <- lift $ textToName $ relNameToTxt relName
|
||||||
otherTableParser <- lift $ selectTable otherTable relFieldName desc remotePerms
|
otherTableParser <- lift $ selectTable otherTable relFieldName desc remotePerms
|
||||||
let field = otherTableParser <&> \selectExp ->
|
let field = otherTableParser <&> \selectExp ->
|
||||||
let annotatedRelationship = RQL.AnnRelG relName colMapping selectExp
|
let annotatedRelationship = RQL.AnnRelationSelectG relName colMapping selectExp
|
||||||
in case riType relationshipInfo of
|
in case riType relationshipInfo of
|
||||||
ObjRel -> RQL.FObj annotatedRelationship
|
ObjRel -> RQL.AFObjectRelation annotatedRelationship
|
||||||
ArrRel -> RQL.FArr $ RQL.ASSimple annotatedRelationship
|
ArrRel -> RQL.AFArrayRelation $ RQL.ASSimple annotatedRelationship
|
||||||
case riType relationshipInfo of
|
case riType relationshipInfo of
|
||||||
ObjRel -> pure [field]
|
ObjRel -> pure [field]
|
||||||
ArrRel -> do
|
ArrRel -> do
|
||||||
@ -525,7 +525,7 @@ fieldSelection fieldInfo selectPermissions = do
|
|||||||
relAggDesc = Just $ G.Description "An aggregate relationship"
|
relAggDesc = Just $ G.Description "An aggregate relationship"
|
||||||
remoteAggField <- lift $ selectTableAggregate otherTable relAggFieldName relAggDesc remotePerms
|
remoteAggField <- lift $ selectTableAggregate otherTable relAggFieldName relAggDesc remotePerms
|
||||||
pure $ catMaybes [ Just field
|
pure $ catMaybes [ Just field
|
||||||
, fmap (RQL.FArr . RQL.ASAgg . RQL.AnnRelG relName colMapping) <$> remoteAggField
|
, fmap (RQL.AFArrayRelation . RQL.ASAggregate . RQL.AnnRelationSelectG relName colMapping) <$> remoteAggField
|
||||||
]
|
]
|
||||||
|
|
||||||
FIComputedField computedFieldInfo ->
|
FIComputedField computedFieldInfo ->
|
||||||
@ -562,7 +562,7 @@ fieldSelection fieldInfo selectPermissions = do
|
|||||||
pure $ pure $ P.unsafeRawField (P.mkDefinition fieldName Nothing fieldInfo')
|
pure $ pure $ P.unsafeRawField (P.mkDefinition fieldName Nothing fieldInfo')
|
||||||
`P.bindField` \G.Field{ G._fArguments = args, G._fSelectionSet = selSet } -> do
|
`P.bindField` \G.Field{ G._fArguments = args, G._fSelectionSet = selSet } -> do
|
||||||
remoteArgs <- P.ifParser remoteFieldsArgumentsParser args
|
remoteArgs <- P.ifParser remoteFieldsArgumentsParser args
|
||||||
pure $ RQL.FRemote $ RQL.RemoteSelect
|
pure $ RQL.AFRemote $ RQL.RemoteSelect
|
||||||
{ _rselArgs = remoteArgs
|
{ _rselArgs = remoteArgs
|
||||||
, _rselSelection = selSet
|
, _rselSelection = selSet
|
||||||
, _rselHasuraColumns = _rfiHasuraFields remoteFieldInfo
|
, _rselHasuraColumns = _rfiHasuraFields remoteFieldInfo
|
||||||
@ -697,7 +697,7 @@ computedFieldFunctionArgs ComputedFieldFunction{..} =
|
|||||||
|
|
||||||
|
|
||||||
-- FIXME: move to common?
|
-- FIXME: move to common?
|
||||||
jsonPathArg :: MonadParse n => PGColumnType -> InputFieldsParser n (Maybe RQL.ColOp)
|
jsonPathArg :: MonadParse n => PGColumnType -> InputFieldsParser n (Maybe RQL.ColumnOp)
|
||||||
jsonPathArg columnType
|
jsonPathArg columnType
|
||||||
| isScalarColumnWhere isJSONType columnType =
|
| isScalarColumnWhere isJSONType columnType =
|
||||||
P.fieldOptional fieldName description P.string `P.bindFields` traverse toColExp
|
P.fieldOptional fieldName description P.string `P.bindFields` traverse toColExp
|
||||||
@ -707,7 +707,7 @@ jsonPathArg columnType
|
|||||||
description = Just "JSON select path"
|
description = Just "JSON select path"
|
||||||
toColExp textValue = case parseJSONPath textValue of
|
toColExp textValue = case parseJSONPath textValue of
|
||||||
Left err -> parseError $ T.pack $ "parse json path error: " ++ err
|
Left err -> parseError $ T.pack $ "parse json path error: " ++ err
|
||||||
Right jPaths -> return $ RQL.ColOp SQL.jsonbPathOp $ SQL.SEArray $ map elToColExp jPaths
|
Right jPaths -> return $ RQL.ColumnOp SQL.jsonbPathOp $ SQL.SEArray $ map elToColExp jPaths
|
||||||
elToColExp (Key k) = SQL.SELit k
|
elToColExp (Key k) = SQL.SELit k
|
||||||
elToColExp (Index i) = SQL.SELit $ T.pack (show i)
|
elToColExp (Index i) = SQL.SELit $ T.pack (show i)
|
||||||
|
|
||||||
@ -726,7 +726,7 @@ computedField ComputedFieldInfo{..} selectPermissions = runMaybeT do
|
|||||||
let fieldArgsParser = do
|
let fieldArgsParser = do
|
||||||
args <- functionArgsParser
|
args <- functionArgsParser
|
||||||
colOp <- jsonPathArg $ PGColumnScalar scalarReturnType
|
colOp <- jsonPathArg $ PGColumnScalar scalarReturnType
|
||||||
pure $ RQL.FComputedField $ RQL.CFSScalar $ RQL.ComputedFieldScalarSel
|
pure $ RQL.AFComputedField $ RQL.CFSScalar $ RQL.ComputedFieldScalarSelect
|
||||||
{ RQL._cfssFunction = _cffName _cfiFunction
|
{ RQL._cfssFunction = _cffName _cfiFunction
|
||||||
, RQL._cfssType = scalarReturnType
|
, RQL._cfssType = scalarReturnType
|
||||||
, RQL._cfssColumnOp = colOp
|
, RQL._cfssColumnOp = colOp
|
||||||
@ -741,7 +741,7 @@ computedField ComputedFieldInfo{..} selectPermissions = runMaybeT do
|
|||||||
let fieldArgsParser = liftA2 (,) functionArgsParser selectArgsParser
|
let fieldArgsParser = liftA2 (,) functionArgsParser selectArgsParser
|
||||||
pure $ P.subselection fieldName Nothing fieldArgsParser selectionSetParser <&>
|
pure $ P.subselection fieldName Nothing fieldArgsParser selectionSetParser <&>
|
||||||
\((functionArgs', args), fields) ->
|
\((functionArgs', args), fields) ->
|
||||||
RQL.FComputedField $ RQL.CFSTable RQL.JASMultipleRows $ RQL.AnnSelG
|
RQL.AFComputedField $ RQL.CFSTable RQL.JASMultipleRows $ RQL.AnnSelectG
|
||||||
{ RQL._asnFields = fields
|
{ RQL._asnFields = fields
|
||||||
, RQL._asnFrom = RQL.FromFunction (_cffName _cfiFunction) functionArgs' Nothing
|
, RQL._asnFrom = RQL.FromFunction (_cffName _cfiFunction) functionArgs' Nothing
|
||||||
, RQL._asnPerm = tablePermissionsInfo remotePerms
|
, RQL._asnPerm = tablePermissionsInfo remotePerms
|
||||||
@ -891,16 +891,16 @@ nodeField allTables = do
|
|||||||
(perms, pkeyColumns, fields) <-
|
(perms, pkeyColumns, fields) <-
|
||||||
onNothing (Map.lookup table parseds) $ throwInvalidNodeId $ "the table " <>> ident
|
onNothing (Map.lookup table parseds) $ throwInvalidNodeId $ "the table " <>> ident
|
||||||
whereExp <- buildNodeIdBoolExp columnValues pkeyColumns
|
whereExp <- buildNodeIdBoolExp columnValues pkeyColumns
|
||||||
return $ RQL.AnnSelG
|
return $ RQL.AnnSelectG
|
||||||
{ RQL._asnFields = fields
|
{ RQL._asnFields = fields
|
||||||
, RQL._asnFrom = RQL.FromTable table
|
, RQL._asnFrom = RQL.FromTable table
|
||||||
, RQL._asnPerm = tablePermissionsInfo perms
|
, RQL._asnPerm = tablePermissionsInfo perms
|
||||||
, RQL._asnArgs = RQL.TableArgs
|
, RQL._asnArgs = RQL.SelectArgs
|
||||||
{ RQL._taWhere = Just whereExp
|
{ RQL._saWhere = Just whereExp
|
||||||
, RQL._taOrderBy = Nothing
|
, RQL._saOrderBy = Nothing
|
||||||
, RQL._taLimit = Nothing
|
, RQL._saLimit = Nothing
|
||||||
, RQL._taOffset = Nothing
|
, RQL._saOffset = Nothing
|
||||||
, RQL._taDistCols = Nothing
|
, RQL._saDistinct = Nothing
|
||||||
}
|
}
|
||||||
, RQL._asnStrfyNum = stringifyNum
|
, RQL._asnStrfyNum = stringifyNum
|
||||||
}
|
}
|
||||||
|
@ -44,7 +44,7 @@ runGQ reqId userInfo reqHdrs queryType req = do
|
|||||||
(telemTimeTot_DT, (telemCacheHit, telemLocality, (telemTimeIO_DT, telemQueryType, !resp))) <- withElapsedTime $ do
|
(telemTimeTot_DT, (telemCacheHit, telemLocality, (telemTimeIO_DT, telemQueryType, !resp))) <- withElapsedTime $ do
|
||||||
E.ExecutionCtx _ sqlGenCtx pgExecCtx planCache sc scVer httpManager enableAL <- ask
|
E.ExecutionCtx _ sqlGenCtx pgExecCtx planCache sc scVer httpManager enableAL <- ask
|
||||||
(telemCacheHit, execPlan) <- E.getResolvedExecPlan pgExecCtx planCache
|
(telemCacheHit, execPlan) <- E.getResolvedExecPlan pgExecCtx planCache
|
||||||
userInfo sqlGenCtx enableAL sc scVer queryType httpManager reqHdrs req
|
userInfo sqlGenCtx enableAL sc scVer queryType httpManager reqHdrs req
|
||||||
case execPlan of
|
case execPlan of
|
||||||
E.QueryExecutionPlan queryPlan -> do
|
E.QueryExecutionPlan queryPlan -> do
|
||||||
case queryPlan of
|
case queryPlan of
|
||||||
@ -76,8 +76,8 @@ runGQ reqId userInfo reqHdrs queryType req = do
|
|||||||
return (telemCacheHit, Telem.Local, (telemTimeIO, telemQueryType, HttpResponse resp respHdrs))
|
return (telemCacheHit, Telem.Local, (telemTimeIO, telemQueryType, HttpResponse resp respHdrs))
|
||||||
E.GExPRemote rsi opDef -> do
|
E.GExPRemote rsi opDef -> do
|
||||||
let telemQueryType | G._todType opDef == G.OperationTypeMutation = Telem.Mutation
|
let telemQueryType | G._todType opDef == G.OperationTypeMutation = Telem.Mutation
|
||||||
| otherwise = Telem.Query
|
| otherwise = Telem.Query
|
||||||
(telemTimeIO, resp) <- E.execRemoteGQ reqId userInfo reqHdrs req rsi opDef
|
(telemTimeIO, resp) <- E.execRemoteGQ reqId userInfo reqHdrs req rsi $ G._todType opDef
|
||||||
return (telemCacheHit, Telem.Remote, (telemTimeIO, telemQueryType, resp))
|
return (telemCacheHit, Telem.Remote, (telemTimeIO, telemQueryType, resp))
|
||||||
-}
|
-}
|
||||||
let telemTimeIO = fromUnits telemTimeIO_DT
|
let telemTimeIO = fromUnits telemTimeIO_DT
|
||||||
|
@ -1,8 +1,8 @@
|
|||||||
module Hasura.GraphQL.Validate
|
module Hasura.GraphQL.Validate
|
||||||
( validateGQ
|
( validateGQ
|
||||||
, showVars
|
, showVars
|
||||||
, RootSelSet(..)
|
, RootSelectionSet(..)
|
||||||
, SelSet
|
, SelectionSet(..)
|
||||||
, Field(..)
|
, Field(..)
|
||||||
, getTypedOp
|
, getTypedOp
|
||||||
, QueryParts(..)
|
, QueryParts(..)
|
||||||
@ -13,6 +13,9 @@ module Hasura.GraphQL.Validate
|
|||||||
, validateVariablesForReuse
|
, validateVariablesForReuse
|
||||||
|
|
||||||
, isQueryInAllowlist
|
, isQueryInAllowlist
|
||||||
|
, unValidateArgsMap
|
||||||
|
, unValidateSelectionSet
|
||||||
|
, unValidateField
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
@ -22,16 +25,24 @@ import Data.Has
|
|||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.HashMap.Strict as Map
|
||||||
import qualified Data.HashSet as HS
|
import qualified Data.HashSet as HS
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.Sequence as Seq
|
||||||
|
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 Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
|
import Hasura.GraphQL.NormalForm
|
||||||
|
import Hasura.GraphQL.Resolve.InputValue (annInpValueToJson)
|
||||||
import Hasura.GraphQL.Schema
|
import Hasura.GraphQL.Schema
|
||||||
import Hasura.GraphQL.Transport.HTTP.Protocol
|
import Hasura.GraphQL.Transport.HTTP.Protocol
|
||||||
import Hasura.GraphQL.Validate.Context
|
import Hasura.GraphQL.Validate.Context
|
||||||
import Hasura.GraphQL.Validate.Field
|
|
||||||
import Hasura.GraphQL.Validate.InputValue
|
import Hasura.GraphQL.Validate.InputValue
|
||||||
|
import Hasura.GraphQL.Validate.SelectionSet
|
||||||
import Hasura.GraphQL.Validate.Types
|
import Hasura.GraphQL.Validate.Types
|
||||||
|
import Hasura.RQL.DML.Select.Types
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
import Hasura.RQL.Types.QueryCollection
|
import Hasura.RQL.Types.QueryCollection
|
||||||
|
import Hasura.SQL.Time
|
||||||
|
import Hasura.SQL.Value
|
||||||
|
|
||||||
data QueryParts
|
data QueryParts
|
||||||
= QueryParts
|
= QueryParts
|
||||||
@ -137,19 +148,12 @@ validateFrag
|
|||||||
validateFrag (G.FragmentDefinition n onTy dirs selSet) = do
|
validateFrag (G.FragmentDefinition n onTy dirs selSet) = do
|
||||||
unless (null dirs) $ throwVE
|
unless (null dirs) $ throwVE
|
||||||
"unexpected directives at fragment definition"
|
"unexpected directives at fragment definition"
|
||||||
tyInfo <- getTyInfoVE onTy
|
fragmentTypeInfo <- getFragmentTyInfo onTy
|
||||||
objTyInfo <- onNothing (getObjTyM tyInfo) $ throwVE
|
return $ FragDef n fragmentTypeInfo selSet
|
||||||
"fragments can only be defined on object types"
|
|
||||||
return $ FragDef n objTyInfo selSet
|
|
||||||
|
|
||||||
data RootSelSet
|
|
||||||
= RQuery !SelSet
|
|
||||||
| RMutation !SelSet
|
|
||||||
| RSubscription !Field
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
validateGQ
|
validateGQ
|
||||||
:: (MonadError QErr m, MonadReader GCtx m, MonadReusability m) => QueryParts -> m RootSelSet
|
:: (MonadError QErr m, MonadReader GCtx m, MonadReusability m)
|
||||||
|
=> QueryParts -> m RootSelectionSet
|
||||||
validateGQ (QueryParts opDef opRoot fragDefsL varValsM) = do
|
validateGQ (QueryParts opDef opRoot fragDefsL varValsM) = do
|
||||||
ctx <- ask
|
ctx <- ask
|
||||||
|
|
||||||
@ -165,19 +169,22 @@ validateGQ (QueryParts opDef opRoot fragDefsL varValsM) = do
|
|||||||
-- build a validation ctx
|
-- build a validation ctx
|
||||||
let valCtx = ValidationCtx (_gTypes ctx) annVarVals annFragDefs
|
let valCtx = ValidationCtx (_gTypes ctx) annVarVals annFragDefs
|
||||||
|
|
||||||
selSet <- flip runReaderT valCtx $ denormSelSet [] opRoot $
|
selSet <- flip runReaderT valCtx $ parseObjectSelectionSet valCtx opRoot $
|
||||||
G._todSelectionSet opDef
|
G._todSelectionSet opDef
|
||||||
|
|
||||||
case G._todType opDef of
|
case G._todType opDef of
|
||||||
G.OperationTypeQuery -> return $ RQuery selSet
|
G.OperationTypeQuery -> return $ RQuery selSet
|
||||||
G.OperationTypeMutation -> return $ RMutation selSet
|
G.OperationTypeMutation -> return $ RMutation selSet
|
||||||
G.OperationTypeSubscription ->
|
G.OperationTypeSubscription ->
|
||||||
case Seq.viewl selSet of
|
case OMap.toList $ unAliasedFields $ unObjectSelectionSet selSet of
|
||||||
Seq.EmptyL -> throw500 "empty selset for subscription"
|
[] -> throw500 "empty selset for subscription"
|
||||||
fld Seq.:< rst -> do
|
(_:rst) -> do
|
||||||
unless (null rst) $
|
-- As an internal testing feature, we support subscribing to multiple
|
||||||
throwVE "subscription must select only one top level field"
|
-- selection sets. First check if the corresponding directive is set.
|
||||||
return $ RSubscription fld
|
let multipleAllowed = G.Directive "_multiple_top_level_fields" [] `elem` G._todDirectives opDef
|
||||||
|
unless (multipleAllowed || null rst) $
|
||||||
|
throwVE "subscriptions must select one top level field"
|
||||||
|
return $ RSubscription selSet
|
||||||
|
|
||||||
isQueryInAllowlist :: GQLExecDoc -> HS.HashSet GQLQuery -> Bool
|
isQueryInAllowlist :: GQLExecDoc -> HS.HashSet GQLQuery -> Bool
|
||||||
isQueryInAllowlist q = HS.member gqlQuery
|
isQueryInAllowlist q = HS.member gqlQuery
|
||||||
@ -204,3 +211,119 @@ getQueryParts (GQLReq opNameM q varValsM) = do
|
|||||||
return $ QueryParts opDef opRoot fragDefsL varValsM
|
return $ QueryParts opDef opRoot fragDefsL varValsM
|
||||||
where
|
where
|
||||||
(selSets, opDefs, fragDefsL) = G.partitionExDefs $ unGQLExecDoc q
|
(selSets, opDefs, fragDefsL) = G.partitionExDefs $ unGQLExecDoc q
|
||||||
|
|
||||||
|
-- | Convert the validated arguments to GraphQL parser AST arguments
|
||||||
|
unValidateArgsMap :: ArgsMap -> [RemoteFieldArgument]
|
||||||
|
unValidateArgsMap argsMap =
|
||||||
|
map (\(n, inpVal) ->
|
||||||
|
let _rfaArgument = G.Argument n $ unValidateInpVal inpVal
|
||||||
|
_rfaVariable = unValidateInpVariable inpVal
|
||||||
|
in RemoteFieldArgument {..})
|
||||||
|
. Map.toList $ argsMap
|
||||||
|
|
||||||
|
-- | Convert the validated field to GraphQL parser AST field
|
||||||
|
unValidateField :: G.Alias -> Field -> G.Field
|
||||||
|
unValidateField alias (Field name _ argsMap selSet) =
|
||||||
|
let args = map (\(n, inpVal) -> G.Argument n $ unValidateInpVal inpVal) $
|
||||||
|
Map.toList argsMap
|
||||||
|
in G.Field (Just alias) name args [] $ unValidateSelectionSet selSet
|
||||||
|
|
||||||
|
-- | Convert the validated selection set to GraphQL parser AST selection set
|
||||||
|
unValidateSelectionSet :: SelectionSet -> G.SelectionSet
|
||||||
|
unValidateSelectionSet = \case
|
||||||
|
SelectionSetObject selectionSet -> fromSelectionSet selectionSet
|
||||||
|
SelectionSetInterface selectionSet -> fromScopedSelectionSet selectionSet
|
||||||
|
SelectionSetUnion selectionSet -> fromScopedSelectionSet selectionSet
|
||||||
|
SelectionSetNone -> mempty
|
||||||
|
where
|
||||||
|
fromAliasedFields :: (IsField f) => AliasedFields f -> G.SelectionSet
|
||||||
|
fromAliasedFields =
|
||||||
|
map (G.SelectionField . uncurry unValidateField) .
|
||||||
|
OMap.toList . fmap toField . unAliasedFields
|
||||||
|
fromSelectionSet =
|
||||||
|
fromAliasedFields . unObjectSelectionSet
|
||||||
|
toInlineSelection typeName =
|
||||||
|
G.SelectionInlineFragment . G.InlineFragment (Just typeName) mempty .
|
||||||
|
fromSelectionSet
|
||||||
|
fromScopedSelectionSet (ScopedSelectionSet base specific) =
|
||||||
|
map (uncurry toInlineSelection) (Map.toList specific) <> fromAliasedFields base
|
||||||
|
|
||||||
|
-- | Get the variable definition and it's value (if exists)
|
||||||
|
unValidateInpVariable :: AnnInpVal -> Maybe [(G.VariableDefinition,A.Value)]
|
||||||
|
unValidateInpVariable inputValue =
|
||||||
|
case (_aivValue inputValue) of
|
||||||
|
AGScalar _ _ -> mkVariableDefnValueTuple inputValue
|
||||||
|
AGEnum _ _ -> mkVariableDefnValueTuple inputValue
|
||||||
|
AGObject _ o ->
|
||||||
|
(\obj ->
|
||||||
|
let listObjects = OMap.toList obj
|
||||||
|
in concat $
|
||||||
|
mapMaybe (\(_, inpVal) -> unValidateInpVariable inpVal) listObjects)
|
||||||
|
<$> o
|
||||||
|
AGArray _ _ -> mkVariableDefnValueTuple inputValue
|
||||||
|
where
|
||||||
|
mkVariableDefnValueTuple val = maybe Nothing (\vars -> Just [vars]) $
|
||||||
|
variableDefnValueTuple val
|
||||||
|
|
||||||
|
variableDefnValueTuple :: AnnInpVal -> Maybe (G.VariableDefinition,A.Value)
|
||||||
|
variableDefnValueTuple inpVal@AnnInpVal {..} =
|
||||||
|
let varDefn = G.VariableDefinition <$> _aivVariable <*> Just _aivType <*> Just Nothing
|
||||||
|
in (,) <$> varDefn <*> Just (annInpValueToJson inpVal)
|
||||||
|
|
||||||
|
-- | Convert the validated input value to GraphQL value, if the input value
|
||||||
|
-- is a variable then it will be returned without resolving it, otherwise it
|
||||||
|
-- will be resolved
|
||||||
|
unValidateInpVal :: AnnInpVal -> G.Value
|
||||||
|
unValidateInpVal (AnnInpVal _ var val) = fromMaybe G.VNull $
|
||||||
|
-- if a variable is found, then directly return that, if not found then
|
||||||
|
-- convert it into a G.Value and return it
|
||||||
|
case var of
|
||||||
|
Just var' -> Just $ G.VVariable var'
|
||||||
|
Nothing ->
|
||||||
|
case val of
|
||||||
|
AGScalar _ v -> pgScalarToGValue <$> v
|
||||||
|
AGEnum _ v -> pgEnumToGEnum v
|
||||||
|
AGObject _ o ->
|
||||||
|
(G.VObject . G.ObjectValueG
|
||||||
|
. map (uncurry G.ObjectFieldG . (second unValidateInpVal))
|
||||||
|
. OMap.toList
|
||||||
|
) <$> o
|
||||||
|
AGArray _ vs -> (G.VList . G.ListValueG . map unValidateInpVal) <$> vs
|
||||||
|
|
||||||
|
where
|
||||||
|
pgEnumToGEnum :: AnnGEnumValue -> Maybe G.Value
|
||||||
|
pgEnumToGEnum = \case
|
||||||
|
AGESynthetic v -> G.VEnum <$> v
|
||||||
|
AGEReference _ v -> (G.VEnum . G.EnumValue . G.Name . getEnumValue) <$> v
|
||||||
|
|
||||||
|
pgScalarToGValue :: PGScalarValue -> G.Value
|
||||||
|
pgScalarToGValue = \case
|
||||||
|
PGValInteger i -> G.VInt $ fromIntegral i
|
||||||
|
PGValSmallInt i -> G.VInt $ fromIntegral i
|
||||||
|
PGValBigInt i -> G.VInt $ fromIntegral i
|
||||||
|
PGValFloat f -> G.VFloat $ realToFrac f
|
||||||
|
PGValDouble d -> G.VFloat $ realToFrac d
|
||||||
|
-- TODO: Scientific is a danger zone; use its safe conv function.
|
||||||
|
PGValNumeric sc -> G.VFloat $ realToFrac sc
|
||||||
|
PGValMoney m -> G.VFloat $ realToFrac m
|
||||||
|
PGValBoolean b -> G.VBoolean b
|
||||||
|
PGValChar t -> toStringValue $ T.singleton t
|
||||||
|
PGValVarchar t -> toStringValue t
|
||||||
|
PGValText t -> toStringValue t
|
||||||
|
PGValCitext t -> toStringValue t
|
||||||
|
PGValDate d -> toStringValue $ T.pack $ showGregorian d
|
||||||
|
PGValTimeStampTZ u -> toStringValue $ T.pack $
|
||||||
|
formatTime defaultTimeLocale "%FT%T%QZ" u
|
||||||
|
PGValTimeStamp u -> toStringValue $ T.pack $
|
||||||
|
formatTime defaultTimeLocale "%FT%T%QZ" u
|
||||||
|
PGValTimeTZ (ZonedTimeOfDay tod tz) ->
|
||||||
|
toStringValue $ T.pack (show tod ++ timeZoneOffsetString tz)
|
||||||
|
PGNull _ -> G.VNull
|
||||||
|
PGValJSON (Q.JSON v) -> jsonValueToGValue v
|
||||||
|
PGValJSONB (Q.JSONB v) -> jsonValueToGValue v
|
||||||
|
PGValGeo v -> jsonValueToGValue $ A.toJSON v
|
||||||
|
PGValRaster v -> jsonValueToGValue $ A.toJSON v
|
||||||
|
PGValUUID u -> toStringValue $ UUID.toText u
|
||||||
|
PGValUnknown t -> toStringValue t
|
||||||
|
where
|
||||||
|
toStringValue = G.VString . G.StringValue
|
||||||
|
@ -4,6 +4,7 @@ module Hasura.GraphQL.Validate.Context
|
|||||||
, getInpFieldInfo
|
, getInpFieldInfo
|
||||||
, getTyInfo
|
, getTyInfo
|
||||||
, getTyInfoVE
|
, getTyInfoVE
|
||||||
|
, getFragmentTyInfo
|
||||||
, module Hasura.GraphQL.Utils
|
, module Hasura.GraphQL.Utils
|
||||||
) where
|
) where
|
||||||
|
|
||||||
@ -19,11 +20,11 @@ import Hasura.RQL.Types
|
|||||||
|
|
||||||
getFieldInfo
|
getFieldInfo
|
||||||
:: ( MonadError QErr m)
|
:: ( MonadError QErr m)
|
||||||
=> ObjTyInfo -> G.Name -> m ObjFldInfo
|
=> G.NamedType -> ObjFieldMap -> G.Name -> m ObjFldInfo
|
||||||
getFieldInfo oti fldName =
|
getFieldInfo typeName fieldMap fldName =
|
||||||
onNothing (Map.lookup fldName $ _otiFields oti) $ throwVE $
|
onNothing (Map.lookup fldName fieldMap) $ throwVE $
|
||||||
"field " <> showName fldName <>
|
"field " <> showName fldName <>
|
||||||
" not found in type: " <> showNamedTy (_otiName oti)
|
" not found in type: " <> showNamedTy typeName
|
||||||
|
|
||||||
getInpFieldInfo
|
getInpFieldInfo
|
||||||
:: ( MonadError QErr m)
|
:: ( MonadError QErr m)
|
||||||
@ -65,3 +66,13 @@ getTyInfoVE namedTy = do
|
|||||||
tyMap <- asks getter
|
tyMap <- asks getter
|
||||||
onNothing (Map.lookup namedTy tyMap) $
|
onNothing (Map.lookup namedTy tyMap) $
|
||||||
throwVE $ "no such type exists in the schema: " <> showNamedTy namedTy
|
throwVE $ "no such type exists in the schema: " <> showNamedTy namedTy
|
||||||
|
|
||||||
|
getFragmentTyInfo
|
||||||
|
:: (MonadReader r m, Has TypeMap r, MonadError QErr m)
|
||||||
|
=> G.NamedType -> m FragmentTypeInfo
|
||||||
|
getFragmentTyInfo onType =
|
||||||
|
getTyInfoVE onType >>= \case
|
||||||
|
TIObj tyInfo -> pure $ FragmentTyObject tyInfo
|
||||||
|
TIIFace tyInfo -> pure $ FragmentTyInterface tyInfo
|
||||||
|
TIUnion tyInfo -> pure $ FragmentTyUnion tyInfo
|
||||||
|
_ -> throwVE "fragments can only be defined on object/interface/union types"
|
||||||
|
550
server/src-lib/Hasura/GraphQL/Validate/SelectionSet.hs
Normal file
550
server/src-lib/Hasura/GraphQL/Validate/SelectionSet.hs
Normal file
@ -0,0 +1,550 @@
|
|||||||
|
{-# LANGUAGE RecordWildCards #-}
|
||||||
|
{-# LANGUAGE TypeFamilyDependencies #-}
|
||||||
|
module Hasura.GraphQL.Validate.SelectionSet
|
||||||
|
( ArgsMap
|
||||||
|
, Field(..)
|
||||||
|
, AliasedFields(..)
|
||||||
|
, SelectionSet(..)
|
||||||
|
, ObjectSelectionSet(..)
|
||||||
|
, traverseObjectSelectionSet
|
||||||
|
, InterfaceSelectionSet
|
||||||
|
, UnionSelectionSet
|
||||||
|
, RootSelectionSet(..)
|
||||||
|
, parseObjectSelectionSet
|
||||||
|
, asObjectSelectionSet
|
||||||
|
, asInterfaceSelectionSet
|
||||||
|
, getMemberSelectionSet
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Hasura.Prelude
|
||||||
|
|
||||||
|
import qualified Data.HashMap.Strict as Map
|
||||||
|
import qualified Data.HashMap.Strict.InsOrd.Extended as OMap
|
||||||
|
import qualified Data.HashSet as Set
|
||||||
|
import qualified Data.List as L
|
||||||
|
import qualified Data.Sequence.NonEmpty as NE
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
|
import Hasura.GraphQL.NormalForm
|
||||||
|
import Hasura.GraphQL.Validate.Context
|
||||||
|
import Hasura.GraphQL.Validate.InputValue
|
||||||
|
import Hasura.GraphQL.Validate.Types
|
||||||
|
import Hasura.RQL.Types
|
||||||
|
import Hasura.SQL.Value
|
||||||
|
|
||||||
|
class HasSelectionSet a where
|
||||||
|
|
||||||
|
getTypename :: a -> G.NamedType
|
||||||
|
getMemberTypes :: a -> Set.HashSet G.NamedType
|
||||||
|
|
||||||
|
fieldToSelectionSet
|
||||||
|
:: G.Alias -> NormalizedField a -> NormalizedSelectionSet a
|
||||||
|
|
||||||
|
parseField_
|
||||||
|
:: ( MonadReader ValidationCtx m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
, MonadState [G.Name] m
|
||||||
|
)
|
||||||
|
=> a
|
||||||
|
-> G.Field
|
||||||
|
-> m (Maybe (NormalizedField a))
|
||||||
|
|
||||||
|
mergeNormalizedSelectionSets
|
||||||
|
:: ( MonadReader ValidationCtx m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
)
|
||||||
|
=> [NormalizedSelectionSet a]
|
||||||
|
-> m (NormalizedSelectionSet a)
|
||||||
|
|
||||||
|
fromObjectSelectionSet
|
||||||
|
:: G.NamedType
|
||||||
|
-- ^ parent typename
|
||||||
|
-> G.NamedType
|
||||||
|
-- ^ fragment typename
|
||||||
|
-> Set.HashSet G.NamedType
|
||||||
|
-- ^ common types
|
||||||
|
-> NormalizedSelectionSet ObjTyInfo
|
||||||
|
-> NormalizedSelectionSet a
|
||||||
|
|
||||||
|
fromInterfaceSelectionSet
|
||||||
|
:: G.NamedType
|
||||||
|
-- ^ parent typename
|
||||||
|
-> G.NamedType
|
||||||
|
-- ^ fragment typename
|
||||||
|
-> Set.HashSet G.NamedType
|
||||||
|
-> NormalizedSelectionSet IFaceTyInfo
|
||||||
|
-> NormalizedSelectionSet a
|
||||||
|
|
||||||
|
fromUnionSelectionSet
|
||||||
|
:: G.NamedType
|
||||||
|
-- ^ parent typename
|
||||||
|
-> G.NamedType
|
||||||
|
-- ^ fragment typename
|
||||||
|
-> Set.HashSet G.NamedType
|
||||||
|
-- ^ common types
|
||||||
|
-> NormalizedSelectionSet UnionTyInfo
|
||||||
|
-> NormalizedSelectionSet a
|
||||||
|
|
||||||
|
parseObjectSelectionSet
|
||||||
|
:: ( MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
)
|
||||||
|
=> ValidationCtx
|
||||||
|
-> ObjTyInfo
|
||||||
|
-> G.SelectionSet
|
||||||
|
-> m ObjectSelectionSet
|
||||||
|
parseObjectSelectionSet validationCtx objectTypeInfo selectionSet =
|
||||||
|
flip evalStateT [] $ flip runReaderT validationCtx $
|
||||||
|
parseSelectionSet objectTypeInfo selectionSet
|
||||||
|
|
||||||
|
selectionToSelectionSet
|
||||||
|
:: HasSelectionSet a
|
||||||
|
=> NormalizedSelection a -> NormalizedSelectionSet a
|
||||||
|
selectionToSelectionSet = \case
|
||||||
|
SelectionField alias fld -> fieldToSelectionSet alias fld
|
||||||
|
SelectionInlineFragmentSpread selectionSet -> selectionSet
|
||||||
|
SelectionFragmentSpread _ selectionSet -> selectionSet
|
||||||
|
|
||||||
|
parseSelectionSet
|
||||||
|
:: ( MonadReader ValidationCtx m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
, HasSelectionSet a
|
||||||
|
, MonadState [G.Name] m
|
||||||
|
)
|
||||||
|
=> a
|
||||||
|
-> G.SelectionSet
|
||||||
|
-> m (NormalizedSelectionSet a)
|
||||||
|
parseSelectionSet fieldTypeInfo selectionSet = do
|
||||||
|
visitedFragments <- get
|
||||||
|
withPathK "selectionSet" $ do
|
||||||
|
-- The visited fragments state shouldn't accumulate over a selection set.
|
||||||
|
normalizedSelections <-
|
||||||
|
catMaybes <$> mapM (parseSelection visitedFragments fieldTypeInfo) selectionSet
|
||||||
|
mergeNormalizedSelections normalizedSelections
|
||||||
|
where
|
||||||
|
mergeNormalizedSelections = mergeNormalizedSelectionSets . map selectionToSelectionSet
|
||||||
|
|
||||||
|
-- | While interfaces and objects have fields, unions do not, so
|
||||||
|
-- this is a specialized function for every Object type
|
||||||
|
parseSelection
|
||||||
|
:: ( MonadReader ValidationCtx m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
, HasSelectionSet a
|
||||||
|
)
|
||||||
|
=> [G.Name]
|
||||||
|
-> a -- parent type info
|
||||||
|
-> G.Selection
|
||||||
|
-> m (Maybe (NormalizedSelection a))
|
||||||
|
parseSelection visitedFragments parentTypeInfo =
|
||||||
|
flip evalStateT visitedFragments . \case
|
||||||
|
G.SelectionField fld -> withPathK (G.unName $ G._fName fld) $ do
|
||||||
|
let fieldName = G._fName fld
|
||||||
|
fieldAlias = fromMaybe (G.Alias fieldName) $ G._fAlias fld
|
||||||
|
fmap (SelectionField fieldAlias) <$> parseField_ parentTypeInfo fld
|
||||||
|
G.SelectionFragmentSpread (G.FragmentSpread name directives) -> do
|
||||||
|
FragDef _ fragmentTyInfo fragmentSelectionSet <- getFragmentInfo name
|
||||||
|
withPathK (G.unName name) $
|
||||||
|
fmap (SelectionFragmentSpread name) <$>
|
||||||
|
parseFragment parentTypeInfo fragmentTyInfo directives fragmentSelectionSet
|
||||||
|
G.SelectionInlineFragment G.InlineFragment{..} -> do
|
||||||
|
let fragmentType = fromMaybe (getTypename parentTypeInfo) _ifTypeCondition
|
||||||
|
fragmentTyInfo <- getFragmentTyInfo fragmentType
|
||||||
|
withPathK "inlineFragment" $ fmap SelectionInlineFragmentSpread <$>
|
||||||
|
parseFragment parentTypeInfo fragmentTyInfo _ifDirectives _ifSelectionSet
|
||||||
|
|
||||||
|
parseFragment
|
||||||
|
:: ( MonadReader ValidationCtx m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
, MonadState [G.Name] m
|
||||||
|
, HasSelectionSet a
|
||||||
|
)
|
||||||
|
=> a
|
||||||
|
-> FragmentTypeInfo
|
||||||
|
-> [G.Directive]
|
||||||
|
-> G.SelectionSet
|
||||||
|
-> m (Maybe (NormalizedSelectionSet a))
|
||||||
|
parseFragment parentTyInfo fragmentTyInfo directives fragmentSelectionSet = do
|
||||||
|
commonTypes <- validateSpread
|
||||||
|
case fragmentTyInfo of
|
||||||
|
FragmentTyObject objTyInfo ->
|
||||||
|
withDirectives directives $
|
||||||
|
fmap (fromObjectSelectionSet parentType fragmentType commonTypes) $
|
||||||
|
parseSelectionSet objTyInfo fragmentSelectionSet
|
||||||
|
FragmentTyInterface interfaceTyInfo ->
|
||||||
|
withDirectives directives $
|
||||||
|
fmap (fromInterfaceSelectionSet parentType fragmentType commonTypes) $
|
||||||
|
parseSelectionSet interfaceTyInfo fragmentSelectionSet
|
||||||
|
FragmentTyUnion unionTyInfo ->
|
||||||
|
withDirectives directives $
|
||||||
|
fmap (fromUnionSelectionSet parentType fragmentType commonTypes) $
|
||||||
|
parseSelectionSet unionTyInfo fragmentSelectionSet
|
||||||
|
where
|
||||||
|
validateSpread = do
|
||||||
|
let commonTypes = parentTypeMembers `Set.intersection` fragmentTypeMembers
|
||||||
|
if null commonTypes then
|
||||||
|
-- TODO: better error location by capturing the fragment source -
|
||||||
|
-- named or otherwise
|
||||||
|
-- throwVE $ "cannot spread fragment " <> showName name <> " defined on " <>
|
||||||
|
throwVE $ "cannot spread fragment defined on " <> showNamedTy fragmentType
|
||||||
|
<> " when selecting fields of type " <> showNamedTy parentType
|
||||||
|
else pure commonTypes
|
||||||
|
|
||||||
|
parentType = getTypename parentTyInfo
|
||||||
|
parentTypeMembers = getMemberTypes parentTyInfo
|
||||||
|
|
||||||
|
fragmentType = case fragmentTyInfo of
|
||||||
|
FragmentTyObject tyInfo -> getTypename tyInfo
|
||||||
|
FragmentTyInterface tyInfo -> getTypename tyInfo
|
||||||
|
FragmentTyUnion tyInfo -> getTypename tyInfo
|
||||||
|
fragmentTypeMembers = case fragmentTyInfo of
|
||||||
|
FragmentTyObject tyInfo -> getMemberTypes tyInfo
|
||||||
|
FragmentTyInterface tyInfo -> getMemberTypes tyInfo
|
||||||
|
FragmentTyUnion tyInfo -> getMemberTypes tyInfo
|
||||||
|
|
||||||
|
class IsField f => MergeableField f where
|
||||||
|
|
||||||
|
checkFieldMergeability
|
||||||
|
:: (MonadError QErr m) => G.Alias -> NE.NESeq f -> m f
|
||||||
|
|
||||||
|
instance MergeableField Field where
|
||||||
|
|
||||||
|
checkFieldMergeability alias fields = do
|
||||||
|
let groupedFlds = toList $ NE.toSeq fields
|
||||||
|
fldNames = L.nub $ map getFieldName groupedFlds
|
||||||
|
args = L.nub $ map getFieldArguments groupedFlds
|
||||||
|
when (length fldNames > 1) $
|
||||||
|
throwVE $ "cannot merge different fields under the same alias ("
|
||||||
|
<> showName (G.unAlias alias) <> "): "
|
||||||
|
<> showNames fldNames
|
||||||
|
when (length args > 1) $
|
||||||
|
throwVE $ "cannot merge fields with different arguments"
|
||||||
|
<> " under the same alias: "
|
||||||
|
<> showName (G.unAlias alias)
|
||||||
|
let fld = NE.head fields
|
||||||
|
mergedGroupSelectionSet <- mergeSelectionSets $ fmap _fSelSet fields
|
||||||
|
return $ fld { _fSelSet = mergedGroupSelectionSet }
|
||||||
|
|
||||||
|
instance MergeableField Typename where
|
||||||
|
|
||||||
|
checkFieldMergeability _ fields = pure $ NE.head fields
|
||||||
|
|
||||||
|
parseArguments
|
||||||
|
:: ( MonadReader ValidationCtx m
|
||||||
|
, MonadError QErr m
|
||||||
|
)
|
||||||
|
=> ParamMap
|
||||||
|
-> [G.Argument]
|
||||||
|
-> m ArgsMap
|
||||||
|
parseArguments fldParams argsL = do
|
||||||
|
|
||||||
|
args <- onLeft (mkMapWith G._aName argsL) $ \dups ->
|
||||||
|
throwVE $ "the following arguments are defined more than once: " <>
|
||||||
|
showNames dups
|
||||||
|
|
||||||
|
let requiredParams = Map.filter (G.isNotNull . _iviType) fldParams
|
||||||
|
|
||||||
|
inpArgs <- forM args $ \(G.Argument argName argVal) ->
|
||||||
|
withPathK (G.unName argName) $ do
|
||||||
|
argTy <- getArgTy argName
|
||||||
|
validateInputValue valueParser argTy argVal
|
||||||
|
|
||||||
|
forM_ requiredParams $ \argDef -> do
|
||||||
|
let param = _iviName argDef
|
||||||
|
onNothing (Map.lookup param inpArgs) $ throwVE $ mconcat
|
||||||
|
[ "the required argument ", showName param, " is missing"]
|
||||||
|
|
||||||
|
return inpArgs
|
||||||
|
|
||||||
|
where
|
||||||
|
getArgTy argName =
|
||||||
|
onNothing (_iviType <$> Map.lookup argName fldParams) $ throwVE $
|
||||||
|
"no such argument " <> showName argName <> " is expected"
|
||||||
|
|
||||||
|
mergeFields
|
||||||
|
:: ( MonadError QErr m
|
||||||
|
, MergeableField f
|
||||||
|
)
|
||||||
|
-- => Seq.Seq Field
|
||||||
|
=> [AliasedFields f]
|
||||||
|
-> m (AliasedFields f)
|
||||||
|
mergeFields flds =
|
||||||
|
AliasedFields <$> OMap.traverseWithKey checkFieldMergeability groups
|
||||||
|
where
|
||||||
|
groups = foldr (OMap.unionWith (<>)) mempty $
|
||||||
|
map (fmap NE.init . unAliasedFields) flds
|
||||||
|
|
||||||
|
appendSelectionSets
|
||||||
|
:: (MonadError QErr m) => SelectionSet -> SelectionSet -> m SelectionSet
|
||||||
|
appendSelectionSets = curry \case
|
||||||
|
(SelectionSetObject s1, SelectionSetObject s2) ->
|
||||||
|
SelectionSetObject <$> mergeObjectSelectionSets [s1, s2]
|
||||||
|
(SelectionSetInterface s1, SelectionSetInterface s2) ->
|
||||||
|
SelectionSetInterface <$> appendScopedSelectionSet s1 s2
|
||||||
|
(SelectionSetUnion s1, SelectionSetUnion s2) ->
|
||||||
|
SelectionSetUnion <$> appendScopedSelectionSet s1 s2
|
||||||
|
(SelectionSetNone, SelectionSetNone) -> pure SelectionSetNone
|
||||||
|
(_, _) -> throw500 $ "mergeSelectionSets: 'same kind' assertion failed"
|
||||||
|
|
||||||
|
|
||||||
|
-- query q {
|
||||||
|
-- author {
|
||||||
|
-- id
|
||||||
|
-- }
|
||||||
|
-- author {
|
||||||
|
-- name
|
||||||
|
-- }
|
||||||
|
-- }
|
||||||
|
--
|
||||||
|
-- | When we are merging two selection sets down two different trees they
|
||||||
|
-- should be of the same type, however, as it is not enforced in the type
|
||||||
|
-- system, an internal error is thrown when this assumption is violated
|
||||||
|
mergeSelectionSets
|
||||||
|
:: (MonadError QErr m) => NE.NESeq SelectionSet -> m SelectionSet
|
||||||
|
-- mergeSelectionSets = curry $ \case
|
||||||
|
mergeSelectionSets selectionSets =
|
||||||
|
foldM appendSelectionSets (NE.head selectionSets) $ NE.tail selectionSets
|
||||||
|
|
||||||
|
mergeObjectSelectionSets
|
||||||
|
:: (MonadError QErr m) => [ObjectSelectionSet] -> m ObjectSelectionSet
|
||||||
|
mergeObjectSelectionSets =
|
||||||
|
fmap ObjectSelectionSet . mergeFields . map unObjectSelectionSet
|
||||||
|
|
||||||
|
mergeObjectSelectionSetMaps
|
||||||
|
:: (MonadError QErr m) => [ObjectSelectionSetMap] -> m ObjectSelectionSetMap
|
||||||
|
mergeObjectSelectionSetMaps selectionSetMaps =
|
||||||
|
traverse mergeObjectSelectionSets $
|
||||||
|
foldr (Map.unionWith (<>)) mempty $ map (fmap (:[])) selectionSetMaps
|
||||||
|
|
||||||
|
appendScopedSelectionSet
|
||||||
|
:: (MonadError QErr m, MergeableField f)
|
||||||
|
=> ScopedSelectionSet f -> ScopedSelectionSet f -> m (ScopedSelectionSet f)
|
||||||
|
appendScopedSelectionSet s1 s2 =
|
||||||
|
ScopedSelectionSet
|
||||||
|
<$> mergeFields [_sssBaseSelectionSet s1, _sssBaseSelectionSet s2]
|
||||||
|
<*> mergeObjectSelectionSetMaps [s1MembersUnified, s2MembersUnified]
|
||||||
|
|
||||||
|
where
|
||||||
|
s1Base = fmap toField $ _sssBaseSelectionSet s1
|
||||||
|
s2Base = fmap toField $ _sssBaseSelectionSet s2
|
||||||
|
|
||||||
|
s1MembersUnified =
|
||||||
|
(_sssMemberSelectionSets s1)
|
||||||
|
<> fmap (const (ObjectSelectionSet s1Base)) (_sssMemberSelectionSets s2)
|
||||||
|
|
||||||
|
s2MembersUnified =
|
||||||
|
(_sssMemberSelectionSets s2)
|
||||||
|
<> fmap (const (ObjectSelectionSet s2Base)) (_sssMemberSelectionSets s1)
|
||||||
|
|
||||||
|
mergeScopedSelectionSets
|
||||||
|
:: (MonadError QErr m, MergeableField f)
|
||||||
|
=> [ScopedSelectionSet f] -> m (ScopedSelectionSet f)
|
||||||
|
mergeScopedSelectionSets selectionSets =
|
||||||
|
foldM appendScopedSelectionSet emptyScopedSelectionSet selectionSets
|
||||||
|
|
||||||
|
withDirectives
|
||||||
|
:: ( MonadReader ValidationCtx m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
)
|
||||||
|
=> [G.Directive]
|
||||||
|
-> m a
|
||||||
|
-> m (Maybe a)
|
||||||
|
withDirectives dirs act = do
|
||||||
|
procDirs <- withPathK "directives" $ do
|
||||||
|
dirDefs <- onLeft (mkMapWith G._dName dirs) $ \dups ->
|
||||||
|
throwVE $ "the following directives are used more than once: " <>
|
||||||
|
showNames dups
|
||||||
|
|
||||||
|
flip Map.traverseWithKey dirDefs $ \name dir ->
|
||||||
|
withPathK (G.unName name) $ do
|
||||||
|
dirInfo <- onNothing (Map.lookup (G._dName dir) defDirectivesMap) $
|
||||||
|
throwVE $ "unexpected directive: " <> showName name
|
||||||
|
procArgs <- withPathK "args" $ parseArguments (_diParams dirInfo)
|
||||||
|
(G._dArguments dir)
|
||||||
|
getIfArg procArgs
|
||||||
|
|
||||||
|
let shouldSkip = fromMaybe False $ Map.lookup "skip" procDirs
|
||||||
|
shouldInclude = fromMaybe True $ Map.lookup "include" procDirs
|
||||||
|
|
||||||
|
if not shouldSkip && shouldInclude
|
||||||
|
then Just <$> act
|
||||||
|
else return Nothing
|
||||||
|
|
||||||
|
where
|
||||||
|
getIfArg m = do
|
||||||
|
val <- onNothing (Map.lookup "if" m) $ throw500
|
||||||
|
"missing if argument in the directive"
|
||||||
|
when (isJust $ _aivVariable val) markNotReusable
|
||||||
|
case _aivValue val of
|
||||||
|
AGScalar _ (Just (PGValBoolean v)) -> return v
|
||||||
|
_ -> throw500 "did not find boolean scalar for if argument"
|
||||||
|
|
||||||
|
getFragmentInfo
|
||||||
|
:: (MonadReader ValidationCtx m, MonadError QErr m, MonadState [G.Name] m)
|
||||||
|
=> G.Name
|
||||||
|
-- ^ fragment name
|
||||||
|
-> m FragDef
|
||||||
|
getFragmentInfo name = do
|
||||||
|
-- check for cycles
|
||||||
|
visitedFragments <- get
|
||||||
|
if name `elem` visitedFragments
|
||||||
|
then throwVE $ "cannot spread fragment " <> showName name
|
||||||
|
<> " within itself via "
|
||||||
|
<> T.intercalate "," (map G.unName visitedFragments)
|
||||||
|
else put $ name:visitedFragments
|
||||||
|
fragInfo <- Map.lookup name <$> asks _vcFragDefMap
|
||||||
|
onNothing fragInfo $ throwVE $ "fragment '" <> G.unName name <> "' not found"
|
||||||
|
|
||||||
|
denormalizeField
|
||||||
|
:: ( MonadReader ValidationCtx m
|
||||||
|
, MonadError QErr m
|
||||||
|
, MonadReusability m
|
||||||
|
, MonadState [G.Name] m
|
||||||
|
)
|
||||||
|
=> ObjFldInfo
|
||||||
|
-> G.Field
|
||||||
|
-> m (Maybe Field)
|
||||||
|
denormalizeField fldInfo (G.Field _ name args dirs selSet) = do
|
||||||
|
|
||||||
|
let fldTy = _fiTy fldInfo
|
||||||
|
fldBaseTy = getBaseTy fldTy
|
||||||
|
|
||||||
|
fldTyInfo <- getTyInfo fldBaseTy
|
||||||
|
|
||||||
|
argMap <- withPathK "args" $ parseArguments (_fiParams fldInfo) args
|
||||||
|
|
||||||
|
fields <- case (fldTyInfo, selSet) of
|
||||||
|
|
||||||
|
(TIObj _, []) ->
|
||||||
|
throwVE $ "field " <> showName name <> " of type "
|
||||||
|
<> G.showGT fldTy <> " must have a selection of subfields"
|
||||||
|
|
||||||
|
(TIObj objTyInfo, _) ->
|
||||||
|
SelectionSetObject <$> parseSelectionSet objTyInfo selSet
|
||||||
|
|
||||||
|
(TIIFace _, []) ->
|
||||||
|
throwVE $ "field " <> showName name <> " of type "
|
||||||
|
<> G.showGT fldTy <> " must have a selection of subfields"
|
||||||
|
|
||||||
|
(TIIFace interfaceTyInfo, _) ->
|
||||||
|
SelectionSetInterface <$> parseSelectionSet interfaceTyInfo selSet
|
||||||
|
|
||||||
|
(TIUnion _, []) ->
|
||||||
|
throwVE $ "field " <> showName name <> " of type "
|
||||||
|
<> G.showGT fldTy <> " must have a selection of subfields"
|
||||||
|
|
||||||
|
(TIUnion unionTyInfo, _) ->
|
||||||
|
SelectionSetUnion <$> parseSelectionSet unionTyInfo selSet
|
||||||
|
|
||||||
|
(TIScalar _, []) -> return SelectionSetNone
|
||||||
|
-- when scalar/enum and no empty set
|
||||||
|
(TIScalar _, _) ->
|
||||||
|
throwVE $ "field " <> showName name <> " must not have a "
|
||||||
|
<> "selection since type " <> G.showGT fldTy <> " has no subfields"
|
||||||
|
|
||||||
|
(TIEnum _, []) -> return SelectionSetNone
|
||||||
|
(TIEnum _, _) ->
|
||||||
|
throwVE $ "field " <> showName name <> " must not have a "
|
||||||
|
<> "selection since type " <> G.showGT fldTy <> " has no subfields"
|
||||||
|
|
||||||
|
(TIInpObj _, _) ->
|
||||||
|
throwVE $ "internal error: unexpected input type for field: "
|
||||||
|
<> showName name
|
||||||
|
|
||||||
|
withDirectives dirs $ pure $ Field name fldBaseTy argMap fields
|
||||||
|
|
||||||
|
type instance NormalizedSelectionSet ObjTyInfo = ObjectSelectionSet
|
||||||
|
type instance NormalizedField ObjTyInfo = Field
|
||||||
|
|
||||||
|
instance HasSelectionSet ObjTyInfo where
|
||||||
|
|
||||||
|
getTypename = _otiName
|
||||||
|
getMemberTypes = Set.singleton . _otiName
|
||||||
|
|
||||||
|
parseField_ objTyInfo field = do
|
||||||
|
fieldInfo <- getFieldInfo (_otiName objTyInfo) (_otiFields objTyInfo) $ G._fName field
|
||||||
|
denormalizeField fieldInfo field
|
||||||
|
|
||||||
|
fieldToSelectionSet alias fld =
|
||||||
|
ObjectSelectionSet $ AliasedFields $ OMap.singleton alias fld
|
||||||
|
|
||||||
|
mergeNormalizedSelectionSets = mergeObjectSelectionSets
|
||||||
|
|
||||||
|
fromObjectSelectionSet _ _ _ objectSelectionSet =
|
||||||
|
objectSelectionSet
|
||||||
|
|
||||||
|
fromInterfaceSelectionSet parentType _ _ interfaceSelectionSet =
|
||||||
|
getMemberSelectionSet parentType interfaceSelectionSet
|
||||||
|
|
||||||
|
fromUnionSelectionSet parentType _ _ unionSelectionSet =
|
||||||
|
getMemberSelectionSet parentType unionSelectionSet
|
||||||
|
|
||||||
|
type instance NormalizedSelectionSet IFaceTyInfo = InterfaceSelectionSet
|
||||||
|
type instance NormalizedField IFaceTyInfo = Field
|
||||||
|
|
||||||
|
instance HasSelectionSet IFaceTyInfo where
|
||||||
|
|
||||||
|
getTypename = _ifName
|
||||||
|
getMemberTypes = _ifMemberTypes
|
||||||
|
|
||||||
|
parseField_ interfaceTyInfo field = do
|
||||||
|
fieldInfo <- getFieldInfo (_ifName interfaceTyInfo) (_ifFields interfaceTyInfo)
|
||||||
|
$ G._fName field
|
||||||
|
denormalizeField fieldInfo field
|
||||||
|
|
||||||
|
fieldToSelectionSet alias field =
|
||||||
|
ScopedSelectionSet (AliasedFields $ OMap.singleton alias field) mempty
|
||||||
|
|
||||||
|
mergeNormalizedSelectionSets = mergeScopedSelectionSets
|
||||||
|
|
||||||
|
fromObjectSelectionSet _ fragmentType _ objectSelectionSet =
|
||||||
|
ScopedSelectionSet (AliasedFields mempty) $
|
||||||
|
Map.singleton fragmentType objectSelectionSet
|
||||||
|
|
||||||
|
fromInterfaceSelectionSet _ _ commonTypes interfaceSelectionSet =
|
||||||
|
ScopedSelectionSet (AliasedFields mempty) $
|
||||||
|
Map.fromList $ flip map (toList commonTypes) $
|
||||||
|
\commonType -> (commonType, getMemberSelectionSet commonType interfaceSelectionSet)
|
||||||
|
|
||||||
|
fromUnionSelectionSet _ _ commonTypes unionSelectionSet =
|
||||||
|
ScopedSelectionSet (AliasedFields mempty) $
|
||||||
|
Map.fromList $ flip map (toList commonTypes) $
|
||||||
|
\commonType -> (commonType, getMemberSelectionSet commonType unionSelectionSet)
|
||||||
|
|
||||||
|
type instance NormalizedSelectionSet UnionTyInfo = UnionSelectionSet
|
||||||
|
type instance NormalizedField UnionTyInfo = Typename
|
||||||
|
|
||||||
|
instance HasSelectionSet UnionTyInfo where
|
||||||
|
|
||||||
|
getTypename = _utiName
|
||||||
|
getMemberTypes = _utiMemberTypes
|
||||||
|
|
||||||
|
parseField_ unionTyInfo field = do
|
||||||
|
let fieldMap = Map.singleton (_fiName typenameFld) typenameFld
|
||||||
|
fieldInfo <- getFieldInfo (_utiName unionTyInfo) fieldMap $ G._fName field
|
||||||
|
fmap (const Typename) <$> denormalizeField fieldInfo field
|
||||||
|
|
||||||
|
fieldToSelectionSet alias field =
|
||||||
|
ScopedSelectionSet (AliasedFields $ OMap.singleton alias field) mempty
|
||||||
|
|
||||||
|
mergeNormalizedSelectionSets = mergeScopedSelectionSets
|
||||||
|
|
||||||
|
fromObjectSelectionSet _ fragmentType _ objectSelectionSet =
|
||||||
|
ScopedSelectionSet (AliasedFields mempty) $
|
||||||
|
Map.singleton fragmentType objectSelectionSet
|
||||||
|
|
||||||
|
fromInterfaceSelectionSet _ _ commonTypes interfaceSelectionSet =
|
||||||
|
ScopedSelectionSet (AliasedFields mempty) $
|
||||||
|
Map.fromList $ flip map (toList commonTypes) $
|
||||||
|
\commonType -> (commonType, getMemberSelectionSet commonType interfaceSelectionSet)
|
||||||
|
|
||||||
|
fromUnionSelectionSet _ _ commonTypes unionSelectionSet =
|
||||||
|
ScopedSelectionSet (AliasedFields mempty) $
|
||||||
|
Map.fromList $ flip map (toList commonTypes) $
|
||||||
|
\commonType -> (commonType, getMemberSelectionSet commonType unionSelectionSet)
|
812
server/src-lib/Hasura/GraphQL/Validate/Types.hs
Normal file
812
server/src-lib/Hasura/GraphQL/Validate/Types.hs
Normal file
@ -0,0 +1,812 @@
|
|||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
module Hasura.GraphQL.Validate.Types
|
||||||
|
( InpValInfo(..)
|
||||||
|
, ParamMap
|
||||||
|
|
||||||
|
, typenameFld
|
||||||
|
, ObjFldInfo(..)
|
||||||
|
, mkHsraObjFldInfo
|
||||||
|
, ObjFieldMap
|
||||||
|
|
||||||
|
-- Don't expose 'ObjTyInfo' constructor. Instead use 'mkObjTyInfo' or 'mkHsraObjTyInfo'
|
||||||
|
-- which will auto-insert the compulsory '__typename' field.
|
||||||
|
, ObjTyInfo
|
||||||
|
, _otiDesc
|
||||||
|
, _otiName
|
||||||
|
, _otiImplIFaces
|
||||||
|
, _otiFields
|
||||||
|
, mkObjTyInfo
|
||||||
|
, mkHsraObjTyInfo
|
||||||
|
|
||||||
|
-- Don't expose 'IFaceTyInfo' constructor. Instead use 'mkIFaceTyInfo'
|
||||||
|
-- which will auto-insert the compulsory '__typename' field.
|
||||||
|
, IFaceTyInfo
|
||||||
|
, _ifDesc
|
||||||
|
, _ifName
|
||||||
|
, _ifFields
|
||||||
|
, _ifMemberTypes
|
||||||
|
, mkIFaceTyInfo
|
||||||
|
|
||||||
|
, IFacesSet
|
||||||
|
, UnionTyInfo(..)
|
||||||
|
, FragDef(..)
|
||||||
|
, FragmentTypeInfo(..)
|
||||||
|
, FragDefMap
|
||||||
|
, AnnVarVals
|
||||||
|
, AnnInpVal(..)
|
||||||
|
|
||||||
|
, EnumTyInfo(..)
|
||||||
|
, mkHsraEnumTyInfo
|
||||||
|
|
||||||
|
, EnumValuesInfo(..)
|
||||||
|
, normalizeEnumValues
|
||||||
|
, EnumValInfo(..)
|
||||||
|
, InpObjFldMap
|
||||||
|
, InpObjTyInfo(..)
|
||||||
|
, mkHsraInpTyInfo
|
||||||
|
|
||||||
|
, ScalarTyInfo(..)
|
||||||
|
, fromScalarTyDef
|
||||||
|
, mkHsraScalarTyInfo
|
||||||
|
|
||||||
|
, DirectiveInfo(..)
|
||||||
|
, AsObjType(..)
|
||||||
|
, defaultDirectives
|
||||||
|
, defDirectivesMap
|
||||||
|
, defaultSchema
|
||||||
|
, TypeInfo(..)
|
||||||
|
, isObjTy
|
||||||
|
, isIFaceTy
|
||||||
|
, getPossibleObjTypes
|
||||||
|
, getObjTyM
|
||||||
|
, getUnionTyM
|
||||||
|
, mkScalarTy
|
||||||
|
, pgColTyToScalar
|
||||||
|
, getNamedTy
|
||||||
|
, mkTyInfoMap
|
||||||
|
, fromTyDef
|
||||||
|
, fromSchemaDoc
|
||||||
|
, fromSchemaDocQ
|
||||||
|
, TypeMap
|
||||||
|
, TypeLoc (..)
|
||||||
|
, typeEq
|
||||||
|
, AnnGValue(..)
|
||||||
|
, AnnGEnumValue(..)
|
||||||
|
, AnnGObject
|
||||||
|
, hasNullVal
|
||||||
|
, getAnnInpValKind
|
||||||
|
, stripTypenames
|
||||||
|
|
||||||
|
, ReusableVariableTypes(..)
|
||||||
|
, ReusableVariableValues
|
||||||
|
|
||||||
|
, QueryReusability(..)
|
||||||
|
, _Reusable
|
||||||
|
, _NotReusable
|
||||||
|
, MonadReusability(..)
|
||||||
|
, ReusabilityT
|
||||||
|
, runReusabilityT
|
||||||
|
, runReusabilityTWith
|
||||||
|
, evalReusabilityT
|
||||||
|
|
||||||
|
, module Hasura.GraphQL.Utils
|
||||||
|
) where
|
||||||
|
|
||||||
|
import Hasura.Prelude
|
||||||
|
|
||||||
|
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.HashSet as Set
|
||||||
|
import qualified Data.Text as T
|
||||||
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
import qualified Language.GraphQL.Draft.TH as G
|
||||||
|
import qualified Language.Haskell.TH.Syntax as TH
|
||||||
|
|
||||||
|
import Control.Lens (makePrisms)
|
||||||
|
|
||||||
|
import qualified Hasura.RQL.Types.Column as RQL
|
||||||
|
|
||||||
|
import Hasura.GraphQL.NormalForm
|
||||||
|
import Hasura.GraphQL.Utils
|
||||||
|
import Hasura.RQL.Instances ()
|
||||||
|
import Hasura.RQL.Types.Common
|
||||||
|
import Hasura.RQL.Types.RemoteSchema (RemoteSchemaInfo, RemoteSchemaName)
|
||||||
|
import Hasura.SQL.Types
|
||||||
|
import Hasura.SQL.Value
|
||||||
|
|
||||||
|
typeEq :: (EquatableGType a, Eq (EqProps a)) => a -> a -> Bool
|
||||||
|
typeEq a b = getEqProps a == getEqProps b
|
||||||
|
|
||||||
|
data EnumValInfo
|
||||||
|
= EnumValInfo
|
||||||
|
{ _eviDesc :: !(Maybe G.Description)
|
||||||
|
, _eviVal :: !G.EnumValue
|
||||||
|
, _eviIsDeprecated :: !Bool
|
||||||
|
} deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
fromEnumValDef :: G.EnumValueDefinition -> EnumValInfo
|
||||||
|
fromEnumValDef (G.EnumValueDefinition descM val _) =
|
||||||
|
EnumValInfo descM val False
|
||||||
|
|
||||||
|
data EnumValuesInfo
|
||||||
|
= EnumValuesSynthetic !(Map.HashMap G.EnumValue EnumValInfo)
|
||||||
|
-- ^ Values for an enum that exists only in the GraphQL schema and does not
|
||||||
|
-- have any external source of truth.
|
||||||
|
| EnumValuesReference !RQL.EnumReference
|
||||||
|
-- ^ Values for an enum that is backed by an enum table reference (see
|
||||||
|
-- "Hasura.RQL.Schema.Enum").
|
||||||
|
deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
normalizeEnumValues :: EnumValuesInfo -> Map.HashMap G.EnumValue EnumValInfo
|
||||||
|
normalizeEnumValues = \case
|
||||||
|
EnumValuesSynthetic values -> values
|
||||||
|
EnumValuesReference (RQL.EnumReference _ values) ->
|
||||||
|
mapFromL _eviVal . flip map (Map.toList values) $
|
||||||
|
\(RQL.EnumValue name, RQL.EnumValueInfo maybeDescription) -> EnumValInfo
|
||||||
|
{ _eviVal = G.EnumValue $ G.Name name
|
||||||
|
, _eviDesc = G.Description <$> maybeDescription
|
||||||
|
, _eviIsDeprecated = False }
|
||||||
|
|
||||||
|
data EnumTyInfo
|
||||||
|
= EnumTyInfo
|
||||||
|
{ _etiDesc :: !(Maybe G.Description)
|
||||||
|
, _etiName :: !G.NamedType
|
||||||
|
, _etiValues :: !EnumValuesInfo
|
||||||
|
, _etiLoc :: !TypeLoc
|
||||||
|
} deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
instance EquatableGType EnumTyInfo where
|
||||||
|
type EqProps EnumTyInfo = (G.NamedType, Map.HashMap G.EnumValue EnumValInfo)
|
||||||
|
getEqProps ety = (,) (_etiName ety) (normalizeEnumValues $ _etiValues ety)
|
||||||
|
|
||||||
|
fromEnumTyDef :: G.EnumTypeDefinition -> TypeLoc -> EnumTyInfo
|
||||||
|
fromEnumTyDef (G.EnumTypeDefinition descM n _ valDefs) loc =
|
||||||
|
EnumTyInfo descM (G.NamedType n) (EnumValuesSynthetic enumVals) loc
|
||||||
|
where
|
||||||
|
enumVals = Map.fromList
|
||||||
|
[(G._evdName valDef, fromEnumValDef valDef) | valDef <- valDefs]
|
||||||
|
|
||||||
|
mkHsraEnumTyInfo
|
||||||
|
:: Maybe G.Description
|
||||||
|
-> G.NamedType
|
||||||
|
-> EnumValuesInfo
|
||||||
|
-> EnumTyInfo
|
||||||
|
mkHsraEnumTyInfo descM ty enumVals =
|
||||||
|
EnumTyInfo descM ty enumVals TLHasuraType
|
||||||
|
|
||||||
|
fromInpValDef :: G.InputValueDefinition -> InpValInfo
|
||||||
|
fromInpValDef (G.InputValueDefinition descM n ty defM) =
|
||||||
|
InpValInfo descM n defM ty
|
||||||
|
|
||||||
|
type ParamMap = Map.HashMap G.Name InpValInfo
|
||||||
|
|
||||||
|
-- | location of the type: a hasura type or a remote type
|
||||||
|
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
|
||||||
|
= ObjFldInfo
|
||||||
|
{ _fiDesc :: !(Maybe G.Description)
|
||||||
|
, _fiName :: !G.Name
|
||||||
|
, _fiParams :: !ParamMap
|
||||||
|
, _fiTy :: !G.GType
|
||||||
|
, _fiLoc :: !TypeLoc
|
||||||
|
} deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
instance EquatableGType ObjFldInfo where
|
||||||
|
type EqProps ObjFldInfo = (G.Name, G.GType, ParamMap)
|
||||||
|
getEqProps o = (,,) (_fiName o) (_fiTy o) (_fiParams o)
|
||||||
|
|
||||||
|
fromFldDef :: G.FieldDefinition -> TypeLoc -> ObjFldInfo
|
||||||
|
fromFldDef (G.FieldDefinition descM n args ty _) loc =
|
||||||
|
ObjFldInfo descM n params ty loc
|
||||||
|
where
|
||||||
|
params = Map.fromList [(G._ivdName arg, fromInpValDef arg) | arg <- args]
|
||||||
|
|
||||||
|
mkHsraObjFldInfo
|
||||||
|
:: Maybe G.Description
|
||||||
|
-> G.Name
|
||||||
|
-> ParamMap
|
||||||
|
-> G.GType
|
||||||
|
-> ObjFldInfo
|
||||||
|
mkHsraObjFldInfo descM name params ty =
|
||||||
|
ObjFldInfo descM name params ty TLHasuraType
|
||||||
|
|
||||||
|
type ObjFieldMap = Map.HashMap G.Name ObjFldInfo
|
||||||
|
|
||||||
|
type IFacesSet = Set.HashSet G.NamedType
|
||||||
|
|
||||||
|
data ObjTyInfo
|
||||||
|
= ObjTyInfo
|
||||||
|
{ _otiDesc :: !(Maybe G.Description)
|
||||||
|
, _otiName :: !G.NamedType
|
||||||
|
, _otiImplIFaces :: !IFacesSet
|
||||||
|
, _otiFields :: !ObjFieldMap
|
||||||
|
} deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
instance EquatableGType ObjTyInfo where
|
||||||
|
type EqProps ObjTyInfo =
|
||||||
|
(G.NamedType, Set.HashSet G.NamedType, Map.HashMap G.Name (G.Name, G.GType, ParamMap))
|
||||||
|
getEqProps a = (,,) (_otiName a) (_otiImplIFaces a) (Map.map getEqProps (_otiFields a))
|
||||||
|
|
||||||
|
instance Monoid ObjTyInfo where
|
||||||
|
mempty = ObjTyInfo Nothing (G.NamedType "") Set.empty Map.empty
|
||||||
|
|
||||||
|
instance Semigroup ObjTyInfo where
|
||||||
|
objA <> objB =
|
||||||
|
objA { _otiFields = Map.union (_otiFields objA) (_otiFields objB)
|
||||||
|
, _otiImplIFaces = _otiImplIFaces objA `Set.union` _otiImplIFaces objB
|
||||||
|
}
|
||||||
|
|
||||||
|
mkObjTyInfo
|
||||||
|
:: Maybe G.Description -> G.NamedType
|
||||||
|
-> IFacesSet -> ObjFieldMap -> TypeLoc -> ObjTyInfo
|
||||||
|
mkObjTyInfo descM ty iFaces flds _ =
|
||||||
|
ObjTyInfo descM ty iFaces $ Map.insert (_fiName newFld) newFld flds
|
||||||
|
where newFld = typenameFld
|
||||||
|
|
||||||
|
mkHsraObjTyInfo
|
||||||
|
:: Maybe G.Description
|
||||||
|
-> G.NamedType
|
||||||
|
-> IFacesSet
|
||||||
|
-> ObjFieldMap
|
||||||
|
-> ObjTyInfo
|
||||||
|
mkHsraObjTyInfo descM ty implIFaces flds =
|
||||||
|
mkObjTyInfo descM ty implIFaces flds TLHasuraType
|
||||||
|
|
||||||
|
mkIFaceTyInfo
|
||||||
|
:: Maybe G.Description -> G.NamedType
|
||||||
|
-> Map.HashMap G.Name ObjFldInfo -> MemberTypes -> IFaceTyInfo
|
||||||
|
mkIFaceTyInfo descM ty flds =
|
||||||
|
IFaceTyInfo descM ty $ Map.insert (_fiName newFld) newFld flds
|
||||||
|
where
|
||||||
|
newFld = typenameFld
|
||||||
|
|
||||||
|
typenameFld :: ObjFldInfo
|
||||||
|
typenameFld =
|
||||||
|
ObjFldInfo (Just desc) "__typename" Map.empty
|
||||||
|
(G.toGT $ G.toNT $ G.NamedType "String") TLHasuraType
|
||||||
|
where
|
||||||
|
desc = "The name of the current Object type at runtime"
|
||||||
|
|
||||||
|
fromObjTyDef :: G.ObjectTypeDefinition -> TypeLoc -> ObjTyInfo
|
||||||
|
fromObjTyDef (G.ObjectTypeDefinition descM n ifaces _ flds) loc =
|
||||||
|
mkObjTyInfo descM (G.NamedType n) (Set.fromList ifaces) fldMap loc
|
||||||
|
where
|
||||||
|
fldMap = Map.fromList [(G._fldName fld, fromFldDef fld loc) | fld <- flds]
|
||||||
|
|
||||||
|
data IFaceTyInfo
|
||||||
|
= IFaceTyInfo
|
||||||
|
{ _ifDesc :: !(Maybe G.Description)
|
||||||
|
, _ifName :: !G.NamedType
|
||||||
|
, _ifFields :: !ObjFieldMap
|
||||||
|
, _ifMemberTypes :: !MemberTypes
|
||||||
|
} deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
instance EquatableGType IFaceTyInfo where
|
||||||
|
type EqProps IFaceTyInfo =
|
||||||
|
(G.NamedType, Map.HashMap G.Name (G.Name, G.GType, ParamMap))
|
||||||
|
getEqProps a = (,) (_ifName a) (Map.map getEqProps (_ifFields a))
|
||||||
|
|
||||||
|
instance Semigroup IFaceTyInfo where
|
||||||
|
objA <> objB =
|
||||||
|
objA { _ifFields = Map.union (_ifFields objA) (_ifFields objB)
|
||||||
|
}
|
||||||
|
|
||||||
|
fromIFaceDef
|
||||||
|
:: InterfaceImplementations -> G.InterfaceTypeDefinition -> TypeLoc -> IFaceTyInfo
|
||||||
|
fromIFaceDef interfaceImplementations (G.InterfaceTypeDefinition descM n _ flds) loc =
|
||||||
|
mkIFaceTyInfo descM (G.NamedType n) fldMap implementations
|
||||||
|
where
|
||||||
|
fldMap = Map.fromList [(G._fldName fld, fromFldDef fld loc) | fld <- flds]
|
||||||
|
implementations = fromMaybe mempty $ Map.lookup (G.NamedType n) interfaceImplementations
|
||||||
|
|
||||||
|
type MemberTypes = Set.HashSet G.NamedType
|
||||||
|
|
||||||
|
data UnionTyInfo
|
||||||
|
= UnionTyInfo
|
||||||
|
{ _utiDesc :: !(Maybe G.Description)
|
||||||
|
, _utiName :: !G.NamedType
|
||||||
|
, _utiMemberTypes :: !MemberTypes
|
||||||
|
} deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
instance EquatableGType UnionTyInfo where
|
||||||
|
type EqProps UnionTyInfo =
|
||||||
|
(G.NamedType, Set.HashSet G.NamedType)
|
||||||
|
getEqProps a = (,) (_utiName a) (_utiMemberTypes a)
|
||||||
|
|
||||||
|
instance Monoid UnionTyInfo where
|
||||||
|
mempty = UnionTyInfo Nothing (G.NamedType "") Set.empty
|
||||||
|
|
||||||
|
instance Semigroup UnionTyInfo where
|
||||||
|
objA <> objB =
|
||||||
|
objA { _utiMemberTypes = Set.union (_utiMemberTypes objA) (_utiMemberTypes objB)
|
||||||
|
}
|
||||||
|
|
||||||
|
fromUnionTyDef :: G.UnionTypeDefinition -> UnionTyInfo
|
||||||
|
fromUnionTyDef (G.UnionTypeDefinition descM n _ mt) = UnionTyInfo descM (G.NamedType n) $ Set.fromList mt
|
||||||
|
|
||||||
|
type InpObjFldMap = Map.HashMap G.Name InpValInfo
|
||||||
|
|
||||||
|
data InpObjTyInfo
|
||||||
|
= InpObjTyInfo
|
||||||
|
{ _iotiDesc :: !(Maybe G.Description)
|
||||||
|
, _iotiName :: !G.NamedType
|
||||||
|
, _iotiFields :: !InpObjFldMap
|
||||||
|
, _iotiLoc :: !TypeLoc
|
||||||
|
} deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
instance EquatableGType InpObjTyInfo where
|
||||||
|
type EqProps InpObjTyInfo = (G.NamedType, Map.HashMap G.Name (G.Name, G.GType))
|
||||||
|
getEqProps a = (,) (_iotiName a) (Map.map getEqProps $ _iotiFields a)
|
||||||
|
|
||||||
|
fromInpObjTyDef :: G.InputObjectTypeDefinition -> TypeLoc -> InpObjTyInfo
|
||||||
|
fromInpObjTyDef (G.InputObjectTypeDefinition descM n _ inpFlds) loc =
|
||||||
|
InpObjTyInfo descM (G.NamedType n) fldMap loc
|
||||||
|
where
|
||||||
|
fldMap = Map.fromList
|
||||||
|
[(G._ivdName inpFld, fromInpValDef inpFld) | inpFld <- inpFlds]
|
||||||
|
|
||||||
|
mkHsraInpTyInfo
|
||||||
|
:: Maybe G.Description
|
||||||
|
-> G.NamedType
|
||||||
|
-> InpObjFldMap
|
||||||
|
-> InpObjTyInfo
|
||||||
|
mkHsraInpTyInfo descM ty flds =
|
||||||
|
InpObjTyInfo descM ty flds TLHasuraType
|
||||||
|
|
||||||
|
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 (G.Name $ pgColTyToScalar ty) ty TLHasuraType
|
||||||
|
|
||||||
|
instance EquatableGType ScalarTyInfo where
|
||||||
|
type EqProps ScalarTyInfo = PGScalarType
|
||||||
|
getEqProps = _stiType
|
||||||
|
|
||||||
|
fromScalarTyDef
|
||||||
|
:: G.ScalarTypeDefinition
|
||||||
|
-> 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
|
||||||
|
_ -> textToPGScalarType $ G.unName n
|
||||||
|
|
||||||
|
data TypeInfo
|
||||||
|
= TIScalar !ScalarTyInfo
|
||||||
|
| TIObj !ObjTyInfo
|
||||||
|
| TIEnum !EnumTyInfo
|
||||||
|
| TIInpObj !InpObjTyInfo
|
||||||
|
| TIIFace !IFaceTyInfo
|
||||||
|
| TIUnion !UnionTyInfo
|
||||||
|
deriving (Show, Eq, TH.Lift)
|
||||||
|
|
||||||
|
instance J.ToJSON TypeInfo where
|
||||||
|
toJSON _ = J.String "toJSON not implemented for TypeInfo"
|
||||||
|
|
||||||
|
data AsObjType
|
||||||
|
= AOTIFace IFaceTyInfo
|
||||||
|
| AOTUnion UnionTyInfo
|
||||||
|
|
||||||
|
getPossibleObjTypes :: TypeMap -> AsObjType -> Map.HashMap G.NamedType ObjTyInfo
|
||||||
|
getPossibleObjTypes tyMap = \case
|
||||||
|
(AOTIFace i) ->
|
||||||
|
toObjMap $ mapMaybe (extrObjTyInfoM tyMap) $ Set.toList $ _ifMemberTypes i
|
||||||
|
(AOTUnion u) ->
|
||||||
|
toObjMap $ mapMaybe (extrObjTyInfoM tyMap) $ Set.toList $ _utiMemberTypes u
|
||||||
|
-- toObjMap $ mapMaybe previewImplTypeM $ Map.elems tyMap
|
||||||
|
-- where
|
||||||
|
-- previewImplTypeM = \case
|
||||||
|
-- TIObj objTyInfo -> bool Nothing (Just objTyInfo) $
|
||||||
|
-- _ifName i `elem` _otiImplIFaces objTyInfo
|
||||||
|
-- _ -> Nothing
|
||||||
|
|
||||||
|
|
||||||
|
toObjMap :: [ObjTyInfo] -> Map.HashMap G.NamedType ObjTyInfo
|
||||||
|
toObjMap = foldr (\o -> Map.insert (_otiName o) o) Map.empty
|
||||||
|
|
||||||
|
|
||||||
|
isObjTy :: TypeInfo -> Bool
|
||||||
|
isObjTy = \case
|
||||||
|
(TIObj _) -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
getObjTyM :: TypeInfo -> Maybe ObjTyInfo
|
||||||
|
getObjTyM = \case
|
||||||
|
(TIObj t) -> return t
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
getUnionTyM :: TypeInfo -> Maybe UnionTyInfo
|
||||||
|
getUnionTyM = \case
|
||||||
|
(TIUnion u) -> return u
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
isIFaceTy :: TypeInfo -> Bool
|
||||||
|
isIFaceTy = \case
|
||||||
|
(TIIFace _) -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
data SchemaPath
|
||||||
|
= SchemaPath
|
||||||
|
{ _spTypeName :: !(Maybe G.NamedType)
|
||||||
|
, _spFldName :: !(Maybe G.Name)
|
||||||
|
, _spArgName :: !(Maybe G.Name)
|
||||||
|
, _spType :: !(Maybe T.Text)
|
||||||
|
}
|
||||||
|
|
||||||
|
setFldNameSP :: SchemaPath -> G.Name -> SchemaPath
|
||||||
|
setFldNameSP sp fn = sp { _spFldName = Just fn}
|
||||||
|
|
||||||
|
setArgNameSP :: SchemaPath -> G.Name -> SchemaPath
|
||||||
|
setArgNameSP sp an = sp { _spArgName = Just an}
|
||||||
|
|
||||||
|
showSP :: SchemaPath -> Text
|
||||||
|
showSP (SchemaPath t f a _) = maybe "" (\x -> showNamedTy x <> fN) t
|
||||||
|
where
|
||||||
|
fN = maybe "" (\x -> "." <> showName x <> aN) f
|
||||||
|
aN = maybe "" showArg a
|
||||||
|
showArg x = "(" <> showName x <> ":)"
|
||||||
|
|
||||||
|
showSPTxt' :: SchemaPath -> Text
|
||||||
|
showSPTxt' (SchemaPath _ f a t) = maybe "" (<> " "<> fld) t
|
||||||
|
where
|
||||||
|
fld = maybe "" (const $ "field " <> arg) f
|
||||||
|
arg = maybe "" (const "argument ") a
|
||||||
|
|
||||||
|
showSPTxt :: SchemaPath -> Text
|
||||||
|
showSPTxt p = showSPTxt' p <> showSP p
|
||||||
|
|
||||||
|
validateIFace :: MonadError Text f => IFaceTyInfo -> f ()
|
||||||
|
validateIFace (IFaceTyInfo _ n flds _) =
|
||||||
|
when (isFldListEmpty flds) $ throwError $ "List of fields cannot be empty for interface " <> showNamedTy n
|
||||||
|
|
||||||
|
validateObj :: TypeMap -> ObjTyInfo -> Either Text ()
|
||||||
|
validateObj tyMap objTyInfo@(ObjTyInfo _ n _ flds) = do
|
||||||
|
when (isFldListEmpty flds) $ throwError $ "List of fields cannot be empty for " <> objTxt
|
||||||
|
mapM_ (extrIFaceTyInfo' >=> validateIFaceImpl objTyInfo) $ _otiImplIFaces objTyInfo
|
||||||
|
where
|
||||||
|
extrIFaceTyInfo' t = withObjTxt $ extrIFaceTyInfo tyMap t
|
||||||
|
withObjTxt x = x `catchError` \e -> throwError $ e <> " implemented by " <> objTxt
|
||||||
|
objTxt = "Object type " <> showNamedTy n
|
||||||
|
validateIFaceImpl = implmntsIFace tyMap
|
||||||
|
|
||||||
|
isFldListEmpty :: ObjFieldMap -> Bool
|
||||||
|
isFldListEmpty = Map.null . Map.delete "__typename"
|
||||||
|
|
||||||
|
validateUnion :: MonadError Text m => TypeMap -> UnionTyInfo -> m ()
|
||||||
|
validateUnion tyMap (UnionTyInfo _ un mt) = do
|
||||||
|
when (Set.null mt) $ throwError $ "List of member types cannot be empty for union type " <> showNamedTy un
|
||||||
|
mapM_ valIsObjTy $ Set.toList mt
|
||||||
|
where
|
||||||
|
valIsObjTy mn = case Map.lookup mn tyMap of
|
||||||
|
Just (TIObj t) -> return t
|
||||||
|
Nothing -> throwError $ "Could not find type " <> showNamedTy mn <> ", which is defined as a member type of Union " <> showNamedTy un
|
||||||
|
_ -> throwError $ "Union type " <> showNamedTy un <> " can only include object types. It cannot include " <> showNamedTy mn
|
||||||
|
|
||||||
|
implmntsIFace :: TypeMap -> ObjTyInfo -> IFaceTyInfo -> Either Text ()
|
||||||
|
implmntsIFace tyMap objTyInfo iFaceTyInfo = do
|
||||||
|
let path =
|
||||||
|
( SchemaPath (Just $ _otiName objTyInfo) Nothing Nothing (Just "Object")
|
||||||
|
, SchemaPath (Just $ _ifName iFaceTyInfo) Nothing Nothing (Just "Interface")
|
||||||
|
)
|
||||||
|
mapM_ (includesIFaceFld path) $ _ifFields iFaceTyInfo
|
||||||
|
where
|
||||||
|
includesIFaceFld (spO,spIF) ifFld = do
|
||||||
|
let pathA@(spOA, spIFA) = (spO, setFldNameSP spIF $ _fiName ifFld)
|
||||||
|
objFld <- sameNameFld pathA ifFld
|
||||||
|
let pathB = (setFldNameSP spOA $ _fiName objFld, spIFA)
|
||||||
|
validateIsSubType' pathB (_fiTy objFld) (_fiTy ifFld)
|
||||||
|
hasAllArgs pathB objFld ifFld
|
||||||
|
isExtraArgsNullable pathB objFld ifFld
|
||||||
|
|
||||||
|
validateIsSubType' (spO,spIF) oFld iFld = validateIsSubType tyMap oFld iFld `catchError` \_ ->
|
||||||
|
throwError $ "The type of " <> showSPTxt spO <> " (" <> G.showGT oFld <>
|
||||||
|
") is not the same type/sub type of " <> showSPTxt spIF <> " (" <> G.showGT iFld <> ")"
|
||||||
|
|
||||||
|
sameNameFld (spO, spIF) ifFld = do
|
||||||
|
let spIFN = setFldNameSP spIF $ _fiName ifFld
|
||||||
|
onNothing (Map.lookup (_fiName ifFld) objFlds)
|
||||||
|
$ throwError $ showSPTxt spIFN <> " expected, but " <> showSP spO <> " does not provide it"
|
||||||
|
|
||||||
|
hasAllArgs (spO, spIF) objFld ifFld = forM_ (_fiParams ifFld) $ \ifArg -> do
|
||||||
|
objArg <- sameNameArg ifArg
|
||||||
|
let (spON, spIFN) = (setArgNameSP spO $ _iviName objArg, setArgNameSP spIF $ _iviName ifArg)
|
||||||
|
unless (_iviType objArg == _iviType ifArg) $ throwError $
|
||||||
|
showSPTxt spIFN <> " expects type " <> G.showGT (_iviType ifArg) <> ", but " <>
|
||||||
|
showSP spON <> " has type " <> G.showGT (_iviType objArg)
|
||||||
|
where
|
||||||
|
sameNameArg ivi = do
|
||||||
|
let spIFN = setArgNameSP spIF $ _iviName ivi
|
||||||
|
onNothing (Map.lookup (_iviName ivi) objArgs) $ throwError $ showSPTxt spIFN <> " required, but " <>
|
||||||
|
showSPTxt spO <> " does not provide it"
|
||||||
|
objArgs = _fiParams objFld
|
||||||
|
|
||||||
|
isExtraArgsNullable (spO, spIF) objFld ifFld = forM_ extraArgs isInpValNullable
|
||||||
|
where
|
||||||
|
extraArgs = Map.difference (_fiParams objFld) (_fiParams ifFld)
|
||||||
|
isInpValNullable ivi = unless (G.isNullable $ _iviType ivi) $ throwError $
|
||||||
|
showSPTxt (setArgNameSP spO $ _iviName ivi) <> " is of required type "
|
||||||
|
<> G.showGT (_iviType ivi) <> ", but is not provided by " <> showSPTxt spIF
|
||||||
|
|
||||||
|
objFlds = _otiFields objTyInfo
|
||||||
|
|
||||||
|
extrTyInfo :: TypeMap -> G.NamedType -> Either Text TypeInfo
|
||||||
|
extrTyInfo tyMap tn = maybe
|
||||||
|
(throwError $ "Could not find type with name " <> showNamedTy tn)
|
||||||
|
return
|
||||||
|
$ Map.lookup tn tyMap
|
||||||
|
|
||||||
|
extrIFaceTyInfo :: MonadError Text m => Map.HashMap G.NamedType TypeInfo -> G.NamedType -> m IFaceTyInfo
|
||||||
|
extrIFaceTyInfo tyMap tn = case Map.lookup tn tyMap of
|
||||||
|
Just (TIIFace i) -> return i
|
||||||
|
_ -> throwError $ "Could not find interface " <> showNamedTy tn
|
||||||
|
|
||||||
|
extrObjTyInfoM :: TypeMap -> G.NamedType -> Maybe ObjTyInfo
|
||||||
|
extrObjTyInfoM tyMap tn = case Map.lookup tn tyMap of
|
||||||
|
Just (TIObj o) -> return o
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
validateIsSubType :: Map.HashMap G.NamedType TypeInfo -> G.GType -> G.GType -> Either Text ()
|
||||||
|
validateIsSubType tyMap subFldTy supFldTy = do
|
||||||
|
checkNullMismatch subFldTy supFldTy
|
||||||
|
case (subFldTy,supFldTy) of
|
||||||
|
(G.TypeNamed _ subTy, G.TypeNamed _ supTy) -> do
|
||||||
|
subTyInfo <- extrTyInfo tyMap subTy
|
||||||
|
supTyInfo <- extrTyInfo tyMap supTy
|
||||||
|
isSubTypeBase subTyInfo supTyInfo
|
||||||
|
(G.TypeList _ (G.ListType sub), G.TypeList _ (G.ListType sup) ) ->
|
||||||
|
validateIsSubType tyMap sub sup
|
||||||
|
_ -> throwError $ showIsListTy subFldTy <> " Type " <> G.showGT subFldTy <>
|
||||||
|
" cannot be a sub-type of " <> showIsListTy supFldTy <> " Type " <> G.showGT supFldTy
|
||||||
|
where
|
||||||
|
checkNullMismatch subTy supTy = when (G.isNotNull supTy && G.isNullable subTy ) $
|
||||||
|
throwError $ "Nullable Type " <> G.showGT subFldTy <> " cannot be a sub-type of Non-Null Type " <> G.showGT supFldTy
|
||||||
|
showIsListTy = \case
|
||||||
|
G.TypeList {} -> "List"
|
||||||
|
G.TypeNamed {} -> "Named"
|
||||||
|
|
||||||
|
-- TODO Should we check the schema location as well?
|
||||||
|
isSubTypeBase :: (MonadError Text m) => TypeInfo -> TypeInfo -> m ()
|
||||||
|
isSubTypeBase subTyInfo supTyInfo = case (subTyInfo,supTyInfo) of
|
||||||
|
(TIObj obj, TIIFace iFace) -> unless (_ifName iFace `elem` _otiImplIFaces obj) notSubTyErr
|
||||||
|
_ -> unless (subTyInfo == supTyInfo) notSubTyErr
|
||||||
|
where
|
||||||
|
showTy = showNamedTy . getNamedTy
|
||||||
|
notSubTyErr = throwError $ "Type " <> showTy subTyInfo <> " is not a sub type of " <> showTy supTyInfo
|
||||||
|
|
||||||
|
-- map postgres types to builtin scalars
|
||||||
|
pgColTyToScalar :: PGScalarType -> Text
|
||||||
|
pgColTyToScalar = \case
|
||||||
|
PGInteger -> "Int"
|
||||||
|
PGBoolean -> "Boolean"
|
||||||
|
PGFloat -> "Float"
|
||||||
|
PGText -> "String"
|
||||||
|
PGVarchar -> "String"
|
||||||
|
t -> toSQLTxt t
|
||||||
|
|
||||||
|
mkScalarTy :: PGScalarType -> G.NamedType
|
||||||
|
mkScalarTy =
|
||||||
|
G.NamedType . G.Name . pgColTyToScalar
|
||||||
|
|
||||||
|
getNamedTy :: TypeInfo -> G.NamedType
|
||||||
|
getNamedTy = \case
|
||||||
|
TIScalar t -> G.NamedType $ _stiName t
|
||||||
|
TIObj t -> _otiName t
|
||||||
|
TIIFace i -> _ifName i
|
||||||
|
TIEnum t -> _etiName t
|
||||||
|
TIInpObj t -> _iotiName t
|
||||||
|
TIUnion u -> _utiName u
|
||||||
|
|
||||||
|
mkTyInfoMap :: [TypeInfo] -> TypeMap
|
||||||
|
mkTyInfoMap tyInfos =
|
||||||
|
Map.fromList [(getNamedTy tyInfo, tyInfo) | tyInfo <- tyInfos]
|
||||||
|
|
||||||
|
fromTyDef :: InterfaceImplementations -> TypeLoc -> G.TypeDefinition -> TypeInfo
|
||||||
|
fromTyDef interfaceImplementations loc tyDef = case tyDef of
|
||||||
|
G.TypeDefinitionScalar t -> TIScalar $ fromScalarTyDef t loc
|
||||||
|
G.TypeDefinitionObject t -> TIObj $ fromObjTyDef t loc
|
||||||
|
G.TypeDefinitionInterface t -> TIIFace $ fromIFaceDef interfaceImplementations t loc
|
||||||
|
G.TypeDefinitionUnion t -> TIUnion $ fromUnionTyDef t
|
||||||
|
G.TypeDefinitionEnum t -> TIEnum $ fromEnumTyDef t loc
|
||||||
|
G.TypeDefinitionInputObject t -> TIInpObj $ fromInpObjTyDef t loc
|
||||||
|
|
||||||
|
type InterfaceImplementations = Map.HashMap G.NamedType MemberTypes
|
||||||
|
|
||||||
|
fromSchemaDoc :: G.SchemaDocument -> TypeLoc -> Either Text TypeMap
|
||||||
|
fromSchemaDoc (G.SchemaDocument tyDefs) loc = do
|
||||||
|
let tyMap = mkTyInfoMap $ map (fromTyDef interfaceImplementations loc) tyDefs
|
||||||
|
validateTypeMap tyMap
|
||||||
|
return tyMap
|
||||||
|
where
|
||||||
|
interfaceImplementations :: InterfaceImplementations
|
||||||
|
interfaceImplementations =
|
||||||
|
foldr (Map.unionWith (<>)) mempty $ flip mapMaybe tyDefs $ \case
|
||||||
|
G.TypeDefinitionObject objectDefinition ->
|
||||||
|
Just $ Map.fromList $ zip
|
||||||
|
(G._otdImplementsInterfaces objectDefinition)
|
||||||
|
(repeat $ Set.singleton $ G.NamedType $ G._otdName objectDefinition)
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
|
validateTypeMap :: TypeMap -> Either Text ()
|
||||||
|
validateTypeMap tyMap = mapM_ validateTy $ Map.elems tyMap
|
||||||
|
where
|
||||||
|
validateTy (TIObj o) = validateObj tyMap o
|
||||||
|
validateTy (TIUnion u) = validateUnion tyMap u
|
||||||
|
validateTy (TIIFace i) = validateIFace i
|
||||||
|
validateTy _ = return ()
|
||||||
|
|
||||||
|
fromSchemaDocQ :: G.SchemaDocument -> TypeLoc -> TH.Q TH.Exp
|
||||||
|
fromSchemaDocQ sd loc = case fromSchemaDoc sd loc of
|
||||||
|
Left e -> fail $ T.unpack e
|
||||||
|
Right tyMap -> TH.ListE <$> mapM TH.lift (Map.elems tyMap)
|
||||||
|
|
||||||
|
defaultSchema :: G.SchemaDocument
|
||||||
|
defaultSchema = $(G.parseSchemaDocQ "src-rsr/schema.graphql")
|
||||||
|
|
||||||
|
-- fromBaseSchemaFileQ :: FilePath -> TH.Q TH.Exp
|
||||||
|
-- fromBaseSchemaFileQ fp =
|
||||||
|
-- fromSchemaDocQ $(G.parseSchemaDocQ fp)
|
||||||
|
|
||||||
|
type TypeMap = Map.HashMap G.NamedType TypeInfo
|
||||||
|
|
||||||
|
data DirectiveInfo
|
||||||
|
= DirectiveInfo
|
||||||
|
{ _diDescription :: !(Maybe G.Description)
|
||||||
|
, _diName :: !G.Name
|
||||||
|
, _diParams :: !ParamMap
|
||||||
|
, _diLocations :: ![G.DirectiveLocation]
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
-- TODO: generate this from template haskell once we have a parser for directive defs
|
||||||
|
-- directive @skip(if: Boolean!) on FIELD | FRAGMENT_SPREAD | INLINE_FRAGMENT
|
||||||
|
defaultDirectives :: [DirectiveInfo]
|
||||||
|
defaultDirectives =
|
||||||
|
[mkDirective "skip", mkDirective "include"]
|
||||||
|
where
|
||||||
|
mkDirective n = DirectiveInfo Nothing n args dirLocs
|
||||||
|
args = Map.singleton "if" $ InpValInfo Nothing "if" Nothing $
|
||||||
|
G.TypeNamed (G.Nullability False) $ mkScalarTy PGBoolean
|
||||||
|
dirLocs = map G.DLExecutable
|
||||||
|
[G.EDLFIELD, G.EDLFRAGMENT_SPREAD, G.EDLINLINE_FRAGMENT]
|
||||||
|
|
||||||
|
defDirectivesMap :: Map.HashMap G.Name DirectiveInfo
|
||||||
|
defDirectivesMap = mapFromL _diName defaultDirectives
|
||||||
|
|
||||||
|
data FragDef
|
||||||
|
= FragDef
|
||||||
|
{ _fdName :: !G.Name
|
||||||
|
, _fdTyInfo :: !FragmentTypeInfo
|
||||||
|
, _fdSelSet :: !G.SelectionSet
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
data FragmentTypeInfo
|
||||||
|
= FragmentTyObject !ObjTyInfo
|
||||||
|
| FragmentTyInterface !IFaceTyInfo
|
||||||
|
| FragmentTyUnion !UnionTyInfo
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
|
type FragDefMap = Map.HashMap G.Name FragDef
|
||||||
|
|
||||||
|
type AnnVarVals =
|
||||||
|
Map.HashMap G.Variable AnnInpVal
|
||||||
|
|
||||||
|
stripTypenames :: [G.ExecutableDefinition] -> [G.ExecutableDefinition]
|
||||||
|
stripTypenames = map filterExecDef
|
||||||
|
where
|
||||||
|
filterExecDef = \case
|
||||||
|
G.ExecutableDefinitionOperation opDef ->
|
||||||
|
G.ExecutableDefinitionOperation $ filterOpDef opDef
|
||||||
|
G.ExecutableDefinitionFragment fragDef ->
|
||||||
|
let newSelset = filterSelSet $ G._fdSelectionSet fragDef
|
||||||
|
in G.ExecutableDefinitionFragment fragDef{G._fdSelectionSet = newSelset}
|
||||||
|
|
||||||
|
filterOpDef = \case
|
||||||
|
G.OperationDefinitionTyped typeOpDef ->
|
||||||
|
let newSelset = filterSelSet $ G._todSelectionSet typeOpDef
|
||||||
|
in G.OperationDefinitionTyped typeOpDef{G._todSelectionSet = newSelset}
|
||||||
|
G.OperationDefinitionUnTyped selset ->
|
||||||
|
G.OperationDefinitionUnTyped $ filterSelSet selset
|
||||||
|
|
||||||
|
filterSelSet = mapMaybe filterSel
|
||||||
|
filterSel s = case s of
|
||||||
|
G.SelectionField f ->
|
||||||
|
if G._fName f == "__typename"
|
||||||
|
then Nothing
|
||||||
|
else
|
||||||
|
let newSelset = filterSelSet $ G._fSelectionSet f
|
||||||
|
in Just $ G.SelectionField f{G._fSelectionSet = newSelset}
|
||||||
|
_ -> Just s
|
||||||
|
|
||||||
|
-- | Used by 'Hasura.GraphQL.Validate.validateVariablesForReuse' to parse new sets of variables for
|
||||||
|
-- reusable query plans; see also 'QueryReusability'.
|
||||||
|
newtype ReusableVariableTypes
|
||||||
|
= ReusableVariableTypes { unReusableVarTypes :: Map.HashMap G.Variable RQL.PGColumnType }
|
||||||
|
deriving (Show, Eq, Semigroup, Monoid, J.ToJSON)
|
||||||
|
type ReusableVariableValues = Map.HashMap G.Variable (WithScalarType PGScalarValue)
|
||||||
|
|
||||||
|
-- | Tracks whether or not a query is /reusable/. Reusable queries are nice, since we can cache
|
||||||
|
-- their resolved ASTs and avoid re-resolving them if we receive an identical query. However, we
|
||||||
|
-- can’t always safely reuse queries if they have variables, since some variable values can affect
|
||||||
|
-- the generated SQL. For example, consider the following query:
|
||||||
|
--
|
||||||
|
-- > query users_where($condition: users_bool_exp!) {
|
||||||
|
-- > users(where: $condition) {
|
||||||
|
-- > id
|
||||||
|
-- > }
|
||||||
|
-- > }
|
||||||
|
--
|
||||||
|
-- Different values for @$condition@ will produce completely different queries, so we can’t reuse
|
||||||
|
-- its plan (unless the variable values were also all identical, of course, but we don’t bother
|
||||||
|
-- caching those).
|
||||||
|
--
|
||||||
|
-- If a query does turn out to be reusable, we build up a 'ReusableVariableTypes' value that maps
|
||||||
|
-- variable names to their types so that we can use a fast path for validating new sets of
|
||||||
|
-- variables (namely 'Hasura.GraphQL.Validate.validateVariablesForReuse').
|
||||||
|
data QueryReusability
|
||||||
|
= Reusable !ReusableVariableTypes
|
||||||
|
| NotReusable
|
||||||
|
deriving (Show, Eq)
|
||||||
|
$(makePrisms ''QueryReusability)
|
||||||
|
|
||||||
|
instance Semigroup QueryReusability where
|
||||||
|
Reusable a <> Reusable b = Reusable (a <> b)
|
||||||
|
_ <> _ = NotReusable
|
||||||
|
instance Monoid QueryReusability where
|
||||||
|
mempty = Reusable mempty
|
||||||
|
|
||||||
|
class (Monad m) => MonadReusability m where
|
||||||
|
recordVariableUse :: G.Variable -> RQL.PGColumnType -> m ()
|
||||||
|
markNotReusable :: m ()
|
||||||
|
|
||||||
|
instance (MonadReusability m) => MonadReusability (ReaderT r m) where
|
||||||
|
recordVariableUse a b = lift $ recordVariableUse a b
|
||||||
|
markNotReusable = lift markNotReusable
|
||||||
|
|
||||||
|
instance (MonadReusability m) => MonadReusability (StateT s m) where
|
||||||
|
recordVariableUse a b = lift $ recordVariableUse a b
|
||||||
|
markNotReusable = lift markNotReusable
|
||||||
|
|
||||||
|
newtype ReusabilityT m a = ReusabilityT { unReusabilityT :: StateT QueryReusability m a }
|
||||||
|
deriving (Functor, Applicative, Monad, MonadError e, MonadReader r, MonadIO)
|
||||||
|
|
||||||
|
instance (Monad m) => MonadReusability (ReusabilityT m) where
|
||||||
|
recordVariableUse varName varType = ReusabilityT $
|
||||||
|
modify' (<> Reusable (ReusableVariableTypes $ Map.singleton varName varType))
|
||||||
|
markNotReusable = ReusabilityT $ put NotReusable
|
||||||
|
|
||||||
|
runReusabilityT :: ReusabilityT m a -> m (a, QueryReusability)
|
||||||
|
runReusabilityT = runReusabilityTWith mempty
|
||||||
|
|
||||||
|
-- | Like 'runReusabilityT', but starting from an existing 'QueryReusability' state.
|
||||||
|
runReusabilityTWith :: QueryReusability -> ReusabilityT m a -> m (a, QueryReusability)
|
||||||
|
runReusabilityTWith initialReusability = flip runStateT initialReusability . unReusabilityT
|
||||||
|
|
||||||
|
evalReusabilityT :: (Monad m) => ReusabilityT m a -> m a
|
||||||
|
evalReusabilityT = flip evalStateT mempty . unReusabilityT
|
@ -10,6 +10,9 @@ module Hasura.RQL.DDL.RemoteSchema
|
|||||||
) where
|
) where
|
||||||
|
|
||||||
import Hasura.EncJSON
|
import Hasura.EncJSON
|
||||||
|
-- import Hasura.GraphQL.NormalForm
|
||||||
|
import Hasura.GraphQL.RemoteServer
|
||||||
|
-- import Hasura.GraphQL.Schema.Merge
|
||||||
import Hasura.Prelude
|
import Hasura.Prelude
|
||||||
|
|
||||||
import qualified Data.Aeson as J
|
import qualified Data.Aeson as J
|
||||||
@ -121,3 +124,34 @@ fetchRemoteSchemas =
|
|||||||
where
|
where
|
||||||
fromRow (name, Q.AltJ def, comment) =
|
fromRow (name, Q.AltJ def, comment) =
|
||||||
AddRemoteSchemaQuery name def comment
|
AddRemoteSchemaQuery name def comment
|
||||||
|
|
||||||
|
-- runIntrospectRemoteSchema
|
||||||
|
-- :: (CacheRM m, QErrM m) => RemoteSchemaNameQuery -> m EncJSON
|
||||||
|
-- runIntrospectRemoteSchema (RemoteSchemaNameQuery rsName) = do
|
||||||
|
-- sc <- askSchemaCache
|
||||||
|
-- rGCtx <-
|
||||||
|
-- case Map.lookup rsName (scRemoteSchemas sc) of
|
||||||
|
-- Nothing ->
|
||||||
|
-- throw400 NotExists $
|
||||||
|
-- "remote schema: " <> remoteSchemaNameToTxt rsName <> " not found"
|
||||||
|
-- Just rCtx -> mergeGCtx (rscGCtx rCtx) GC.emptyGCtx
|
||||||
|
-- -- merge with emptyGCtx to get default query fields
|
||||||
|
-- queryParts <- flip runReaderT rGCtx $ VQ.getQueryParts introspectionQuery
|
||||||
|
-- (rootSelSet, _) <- flip runReaderT rGCtx $ VT.runReusabilityT $ VQ.validateGQ queryParts
|
||||||
|
-- schemaField <-
|
||||||
|
-- case rootSelSet of
|
||||||
|
-- VQ.RQuery selSet -> getSchemaField $ toList $ unAliasedFields $
|
||||||
|
-- unObjectSelectionSet selSet
|
||||||
|
-- _ -> throw500 "expected query for introspection"
|
||||||
|
-- (introRes, _) <- flip runReaderT rGCtx $ VT.runReusabilityT $ RI.schemaR schemaField
|
||||||
|
-- pure $ wrapInSpecKeys introRes
|
||||||
|
-- where
|
||||||
|
-- wrapInSpecKeys introObj =
|
||||||
|
-- encJFromAssocList
|
||||||
|
-- [ ( T.pack "data"
|
||||||
|
-- , encJFromAssocList [(T.pack "__schema", encJFromJValue introObj)])
|
||||||
|
-- ]
|
||||||
|
-- getSchemaField = \case
|
||||||
|
-- [] -> throw500 "found empty when looking for __schema field"
|
||||||
|
-- [f] -> pure f
|
||||||
|
-- _ -> throw500 "expected __schema field, found many fields"
|
||||||
|
@ -47,6 +47,7 @@ import Hasura.RQL.DDL.CustomTypes
|
|||||||
import Hasura.RQL.DDL.Deps
|
import Hasura.RQL.DDL.Deps
|
||||||
import Hasura.RQL.DDL.EventTrigger
|
import Hasura.RQL.DDL.EventTrigger
|
||||||
import Hasura.RQL.DDL.RemoteSchema
|
import Hasura.RQL.DDL.RemoteSchema
|
||||||
|
-- import Hasura.RQL.DDL.ScheduledTrigger
|
||||||
import Hasura.RQL.DDL.Schema.Cache.Common
|
import Hasura.RQL.DDL.Schema.Cache.Common
|
||||||
import Hasura.RQL.DDL.Schema.Cache.Dependencies
|
import Hasura.RQL.DDL.Schema.Cache.Dependencies
|
||||||
import Hasura.RQL.DDL.Schema.Cache.Fields
|
import Hasura.RQL.DDL.Schema.Cache.Fields
|
||||||
@ -192,6 +193,9 @@ buildSchemaCacheRule = proc (catalogMetadata, invalidationKeys) -> do
|
|||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
-- Step 4: Build the relay GraphQL schema
|
||||||
|
-- relayGQLSchema <- bindA -< Relay.mkRelayGCtxMap (_boTables resolvedOutputs) (_boFunctions resolvedOutputs)
|
||||||
|
|
||||||
returnA -< SchemaCache
|
returnA -< SchemaCache
|
||||||
{ scTables = _boTables resolvedOutputs
|
{ scTables = _boTables resolvedOutputs
|
||||||
, scActions = _boActions resolvedOutputs
|
, scActions = _boActions resolvedOutputs
|
||||||
|
@ -71,7 +71,7 @@ mutateAndFetchCols qt cols (cte, p) strfyNum =
|
|||||||
tabFrom = FromIden aliasIden
|
tabFrom = FromIden aliasIden
|
||||||
tabPerm = TablePerm annBoolExpTrue Nothing
|
tabPerm = TablePerm annBoolExpTrue Nothing
|
||||||
selFlds = flip map cols $
|
selFlds = flip map cols $
|
||||||
\ci -> (fromPGCol $ pgiColumn ci, mkAnnColFieldAsText ci)
|
\ci -> (fromPGCol $ pgiColumn ci, mkAnnColumnFieldAsText ci)
|
||||||
|
|
||||||
sql = toSQL selectWith
|
sql = toSQL selectWith
|
||||||
selectWith = S.SelectWith [(S.Alias aliasIden, cte)] select
|
selectWith = S.SelectWith [(S.Alias aliasIden, cte)] select
|
||||||
@ -87,7 +87,7 @@ mutateAndFetchCols qt cols (cte, p) strfyNum =
|
|||||||
, S.selFrom = Just $ S.FromExp [S.FIIden aliasIden]
|
, S.selFrom = Just $ S.FromExp [S.FIIden aliasIden]
|
||||||
}
|
}
|
||||||
colSel = S.SESelect $ mkSQLSelect JASMultipleRows $
|
colSel = S.SESelect $ mkSQLSelect JASMultipleRows $
|
||||||
AnnSelG selFlds tabFrom tabPerm noTableArgs strfyNum
|
AnnSelectG selFlds tabFrom tabPerm noSelectArgs strfyNum
|
||||||
|
|
||||||
-- | Note:- Using sorted columns is necessary to enable casting the rows returned by VALUES expression to table type.
|
-- | Note:- Using sorted columns is necessary to enable casting the rows returned by VALUES expression to table type.
|
||||||
-- For example, let's consider the table, `CREATE TABLE test (id serial primary key, name text not null, age int)`.
|
-- For example, let's consider the table, `CREATE TABLE test (id serial primary key, name text not null, age int)`.
|
||||||
|
@ -12,23 +12,20 @@ import Hasura.Prelude
|
|||||||
|
|
||||||
import Control.Lens
|
import Control.Lens
|
||||||
import Data.List (nub)
|
import Data.List (nub)
|
||||||
import Data.Validation
|
|
||||||
import Data.Scientific (toBoundedInteger, toRealFloat)
|
import Data.Scientific (toBoundedInteger, toRealFloat)
|
||||||
|
import Data.Validation
|
||||||
|
|
||||||
import Hasura.EncJSON
|
import Hasura.EncJSON
|
||||||
|
import Hasura.GraphQL.Parser
|
||||||
import Hasura.GraphQL.RemoteServer (execRemoteGQ')
|
import Hasura.GraphQL.RemoteServer (execRemoteGQ')
|
||||||
import Hasura.GraphQL.Transport.HTTP.Protocol
|
import Hasura.GraphQL.Transport.HTTP.Protocol
|
||||||
import Hasura.GraphQL.Utils
|
|
||||||
import Hasura.GraphQL.Parser
|
|
||||||
import Hasura.GraphQL.Execute.Resolve
|
|
||||||
import Hasura.RQL.DML.Internal
|
import Hasura.RQL.DML.Internal
|
||||||
import Hasura.RQL.DML.Returning
|
|
||||||
import Hasura.RQL.DML.Returning.Types
|
import Hasura.RQL.DML.Returning.Types
|
||||||
import Hasura.RQL.DML.Select.Types
|
import Hasura.RQL.DML.Select.Types
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
import Hasura.Server.Version (HasVersion)
|
import Hasura.Server.Version (HasVersion)
|
||||||
import Hasura.SQL.Types ((<<>))
|
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
|
import Hasura.SQL.Types ((<<>))
|
||||||
|
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
|
|
||||||
@ -45,8 +42,6 @@ import qualified Language.GraphQL.Draft.Printer.Text as G
|
|||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
import qualified Network.HTTP.Client as HTTP
|
import qualified Network.HTTP.Client as HTTP
|
||||||
import qualified Network.HTTP.Types as N
|
import qualified Network.HTTP.Types as N
|
||||||
import qualified Data.ByteString.Lazy as BL
|
|
||||||
import qualified Network.Wreq as Wreq
|
|
||||||
|
|
||||||
-- | Executes given query and fetch response JSON from Postgres. Substitutes remote relationship fields.
|
-- | Executes given query and fetch response JSON from Postgres. Substitutes remote relationship fields.
|
||||||
executeQueryWithRemoteJoins
|
executeQueryWithRemoteJoins
|
||||||
@ -106,7 +101,7 @@ pathToAlias path counter = do
|
|||||||
parseGraphQLName $ T.intercalate "_" (map getFieldNameTxt $ unFieldPath path)
|
parseGraphQLName $ T.intercalate "_" (map getFieldNameTxt $ unFieldPath path)
|
||||||
<> "__" <> (T.pack . show . unCounter) counter
|
<> "__" <> (T.pack . show . unCounter) counter
|
||||||
|
|
||||||
-- | A 'RemoteJoin' represents the context of remote relationship to be extracted from 'AnnFldG's.
|
-- | A 'RemoteJoin' represents the context of remote relationship to be extracted from 'AnnFieldG's.
|
||||||
data RemoteJoin
|
data RemoteJoin
|
||||||
= RemoteJoin
|
= RemoteJoin
|
||||||
{ _rjName :: !FieldName -- ^ The remote join field name.
|
{ _rjName :: !FieldName -- ^ The remote join field name.
|
||||||
@ -139,14 +134,14 @@ transformSelect path sel = do
|
|||||||
pure sel{_asnFields = transformedFields}
|
pure sel{_asnFields = transformedFields}
|
||||||
|
|
||||||
-- | Traverse through @'AnnAggregateSelect' and collect remote join fields (if any).
|
-- | Traverse through @'AnnAggregateSelect' and collect remote join fields (if any).
|
||||||
getRemoteJoinsAggregateSelect :: AnnAggSel -> (AnnAggSel, Maybe RemoteJoins)
|
getRemoteJoinsAggregateSelect :: AnnAggregateSelect -> (AnnAggregateSelect, Maybe RemoteJoins)
|
||||||
getRemoteJoinsAggregateSelect =
|
getRemoteJoinsAggregateSelect =
|
||||||
second mapToNonEmpty . flip runState mempty . transformAggregateSelect mempty
|
second mapToNonEmpty . flip runState mempty . transformAggregateSelect mempty
|
||||||
|
|
||||||
transformAggregateSelect
|
transformAggregateSelect
|
||||||
:: FieldPath
|
:: FieldPath
|
||||||
-> AnnAggSel
|
-> AnnAggregateSelect
|
||||||
-> State RemoteJoinMap AnnAggSel
|
-> State RemoteJoinMap AnnAggregateSelect
|
||||||
transformAggregateSelect path sel = do
|
transformAggregateSelect path sel = do
|
||||||
let aggFields = _asnFields sel
|
let aggFields = _asnFields sel
|
||||||
transformedFields <- forM aggFields $ \(fieldName, aggField) ->
|
transformedFields <- forM aggFields $ \(fieldName, aggField) ->
|
||||||
@ -156,32 +151,32 @@ transformAggregateSelect path sel = do
|
|||||||
TAFExp t -> pure $ TAFExp t
|
TAFExp t -> pure $ TAFExp t
|
||||||
pure sel{_asnFields = transformedFields}
|
pure sel{_asnFields = transformedFields}
|
||||||
|
|
||||||
-- -- | Traverse through @'ConnectionSelect' and collect remote join fields (if any).
|
-- | Traverse through @'ConnectionSelect' and collect remote join fields (if any).
|
||||||
-- getRemoteJoinsConnectionSelect :: ConnectionSelect S.SQLExp -> (ConnectionSelect S.SQLExp, Maybe RemoteJoins)
|
getRemoteJoinsConnectionSelect :: ConnectionSelect S.SQLExp -> (ConnectionSelect S.SQLExp, Maybe RemoteJoins)
|
||||||
-- getRemoteJoinsConnectionSelect =
|
getRemoteJoinsConnectionSelect =
|
||||||
-- second mapToNonEmpty . flip runState mempty . transformConnectionSelect mempty
|
second mapToNonEmpty . flip runState mempty . transformConnectionSelect mempty
|
||||||
|
|
||||||
-- transformConnectionSelect
|
transformConnectionSelect
|
||||||
-- :: FieldPath
|
:: FieldPath
|
||||||
-- -> ConnectionSelect S.SQLExp
|
-> ConnectionSelect S.SQLExp
|
||||||
-- -> State RemoteJoinMap (ConnectionSelect S.SQLExp)
|
-> State RemoteJoinMap (ConnectionSelect S.SQLExp)
|
||||||
-- transformConnectionSelect path ConnectionSelect{..} = do
|
transformConnectionSelect path ConnectionSelect{..} = do
|
||||||
-- let connectionFields = _asnFields _csSelect
|
let connectionFields = _asnFields _csSelect
|
||||||
-- transformedFields <- forM connectionFields $ \(fieldName, field) ->
|
transformedFields <- forM connectionFields $ \(fieldName, field) ->
|
||||||
-- (fieldName,) <$> case field of
|
(fieldName,) <$> case field of
|
||||||
-- ConnectionTypename t -> pure $ ConnectionTypename t
|
ConnectionTypename t -> pure $ ConnectionTypename t
|
||||||
-- ConnectionPageInfo p -> pure $ ConnectionPageInfo p
|
ConnectionPageInfo p -> pure $ ConnectionPageInfo p
|
||||||
-- ConnectionEdges edges -> ConnectionEdges <$> transformEdges (appendPath fieldName path) edges
|
ConnectionEdges edges -> ConnectionEdges <$> transformEdges (appendPath fieldName path) edges
|
||||||
-- let select = _csSelect{_asnFields = transformedFields}
|
let select = _csSelect{_asnFields = transformedFields}
|
||||||
-- pure $ ConnectionSelect _csPrimaryKeyColumns _csSplit _csSlice select
|
pure $ ConnectionSelect _csPrimaryKeyColumns _csSplit _csSlice select
|
||||||
-- where
|
where
|
||||||
-- transformEdges edgePath edgeFields =
|
transformEdges edgePath edgeFields =
|
||||||
-- forM edgeFields $ \(fieldName, edgeField) ->
|
forM edgeFields $ \(fieldName, edgeField) ->
|
||||||
-- (fieldName,) <$> case edgeField of
|
(fieldName,) <$> case edgeField of
|
||||||
-- EdgeTypename t -> pure $ EdgeTypename t
|
EdgeTypename t -> pure $ EdgeTypename t
|
||||||
-- EdgeCursor -> pure EdgeCursor
|
EdgeCursor -> pure EdgeCursor
|
||||||
-- EdgeNode annFields ->
|
EdgeNode annFields ->
|
||||||
-- EdgeNode <$> transformAnnFields (appendPath fieldName edgePath) annFields
|
EdgeNode <$> transformAnnFields (appendPath fieldName edgePath) annFields
|
||||||
|
|
||||||
-- | Traverse through 'MutationOutput' and collect remote join fields (if any)
|
-- | Traverse through 'MutationOutput' and collect remote join fields (if any)
|
||||||
getRemoteJoinsMutationOutput :: MutationOutput -> (MutationOutput, Maybe RemoteJoins)
|
getRemoteJoinsMutationOutput :: MutationOutput -> (MutationOutput, Maybe RemoteJoins)
|
||||||
@ -203,10 +198,10 @@ getRemoteJoinsMutationOutput =
|
|||||||
MExp t -> pure $ MExp t
|
MExp t -> pure $ MExp t
|
||||||
MRet annFields -> MRet <$> transformAnnFields fieldPath annFields
|
MRet annFields -> MRet <$> transformAnnFields fieldPath annFields
|
||||||
|
|
||||||
transformAnnFields :: FieldPath -> AnnFlds -> State RemoteJoinMap AnnFlds
|
transformAnnFields :: FieldPath -> AnnFields -> State RemoteJoinMap AnnFields
|
||||||
transformAnnFields path fields = do
|
transformAnnFields path fields = do
|
||||||
let pgColumnFields = map fst $ getFields _FCol fields
|
let pgColumnFields = map fst $ getFields _AFColumn fields
|
||||||
remoteSelects = getFields _FRemote fields
|
remoteSelects = getFields _AFRemote fields
|
||||||
remoteJoins = flip map remoteSelects $ \(fieldName, remoteSelect) ->
|
remoteJoins = flip map remoteSelects $ \(fieldName, remoteSelect) ->
|
||||||
let RemoteSelect argsMap selSet hasuraColumns remoteFields rsi = remoteSelect
|
let RemoteSelect argsMap selSet hasuraColumns remoteFields rsi = remoteSelect
|
||||||
hasuraColumnL = toList hasuraColumns
|
hasuraColumnL = toList hasuraColumns
|
||||||
@ -217,44 +212,46 @@ transformAnnFields path fields = do
|
|||||||
transformedFields <- forM fields $ \(fieldName, field') -> do
|
transformedFields <- forM fields $ \(fieldName, field') -> do
|
||||||
let fieldPath = appendPath fieldName path
|
let fieldPath = appendPath fieldName path
|
||||||
(fieldName,) <$> case field' of
|
(fieldName,) <$> case field' of
|
||||||
FCol c -> pure $ FCol c
|
AFNodeId qt pkeys -> pure $ AFNodeId qt pkeys
|
||||||
FObj annRel ->
|
AFColumn c -> pure $ AFColumn c
|
||||||
FObj <$> transformAnnRelation fieldPath annRel
|
AFObjectRelation annRel ->
|
||||||
FArr (ASSimple annRel) ->
|
AFObjectRelation <$> transformAnnRelation fieldPath annRel
|
||||||
FArr . ASSimple <$> transformAnnRelation fieldPath annRel
|
AFArrayRelation (ASSimple annRel) ->
|
||||||
FArr (ASAgg aggRel) ->
|
AFArrayRelation . ASSimple <$> transformAnnRelation fieldPath annRel
|
||||||
FArr . ASAgg <$> transformAnnAggregateRelation fieldPath aggRel
|
AFArrayRelation (ASAggregate aggRel) ->
|
||||||
-- AFArrayRelation (ASConnection annRel) ->
|
AFArrayRelation . ASAggregate <$> transformAnnAggregateRelation fieldPath aggRel
|
||||||
-- AFArrayRelation . ASConnection <$> transformArrayConnection fieldPath annRel
|
AFArrayRelation (ASConnection annRel) ->
|
||||||
FComputedField computedField ->
|
AFArrayRelation . ASConnection <$> transformArrayConnection fieldPath annRel
|
||||||
FComputedField <$> case computedField of
|
AFComputedField computedField ->
|
||||||
|
AFComputedField <$> case computedField of
|
||||||
CFSScalar _ -> pure computedField
|
CFSScalar _ -> pure computedField
|
||||||
CFSTable jas annSel -> CFSTable jas <$> transformSelect fieldPath annSel
|
CFSTable jas annSel -> CFSTable jas <$> transformSelect fieldPath annSel
|
||||||
FRemote rs -> pure $ FRemote rs
|
AFRemote rs -> pure $ AFRemote rs
|
||||||
|
AFExpression t -> pure $ AFExpression t
|
||||||
|
|
||||||
case NE.nonEmpty remoteJoins of
|
case NE.nonEmpty remoteJoins of
|
||||||
Nothing -> pure transformedFields
|
Nothing -> pure transformedFields
|
||||||
Just nonEmptyRemoteJoins -> do
|
Just nonEmptyRemoteJoins -> do
|
||||||
let phantomColumns = map (\ci -> (fromPGCol $ pgiColumn ci, FCol $ AnnColField ci False Nothing)) $
|
let phantomColumns = map (\ci -> (fromPGCol $ pgiColumn ci, AFColumn $ AnnColumnField ci False Nothing)) $
|
||||||
concatMap _rjPhantomFields remoteJoins
|
concatMap _rjPhantomFields remoteJoins
|
||||||
modify (Map.insert path nonEmptyRemoteJoins)
|
modify (Map.insert path nonEmptyRemoteJoins)
|
||||||
pure $ transformedFields <> phantomColumns
|
pure $ transformedFields <> phantomColumns
|
||||||
where
|
where
|
||||||
getFields f = mapMaybe (sequence . second (^? f))
|
getFields f = mapMaybe (sequence . second (^? f))
|
||||||
transformAnnRelation fieldPath annRel = do
|
transformAnnRelation fieldPath annRel = do
|
||||||
let annSel = aarAnnSel annRel
|
let annSel = aarAnnSelect annRel
|
||||||
transformedSel <- transformSelect fieldPath annSel
|
transformedSel <- transformSelect fieldPath annSel
|
||||||
pure annRel{aarAnnSel = transformedSel}
|
pure annRel{aarAnnSelect = transformedSel}
|
||||||
|
|
||||||
transformAnnAggregateRelation fieldPath annRel = do
|
transformAnnAggregateRelation fieldPath annRel = do
|
||||||
let annSel = aarAnnSel annRel
|
let annSel = aarAnnSelect annRel
|
||||||
transformedSel <- transformAggregateSelect fieldPath annSel
|
transformedSel <- transformAggregateSelect fieldPath annSel
|
||||||
pure annRel{aarAnnSel = transformedSel}
|
pure annRel{aarAnnSelect = transformedSel}
|
||||||
|
|
||||||
-- transformArrayConnection fieldPath annRel = do
|
transformArrayConnection fieldPath annRel = do
|
||||||
-- let connectionSelect = aarAnnSelect annRel
|
let connectionSelect = aarAnnSelect annRel
|
||||||
-- transformedConnectionSelect <- transformConnectionSelect fieldPath connectionSelect
|
transformedConnectionSelect <- transformConnectionSelect fieldPath connectionSelect
|
||||||
-- pure annRel{aarAnnSelect = transformedConnectionSelect}
|
pure annRel{aarAnnSelect = transformedConnectionSelect}
|
||||||
|
|
||||||
type CompositeObject a = OMap.InsOrdHashMap Text (CompositeValue a)
|
type CompositeObject a = OMap.InsOrdHashMap Text (CompositeValue a)
|
||||||
|
|
||||||
@ -338,7 +335,7 @@ traverseQueryResponseJSON rjm =
|
|||||||
A.Number val ->
|
A.Number val ->
|
||||||
case (toBoundedInteger val) of
|
case (toBoundedInteger val) of
|
||||||
Just intVal -> pure $ G.VInt intVal
|
Just intVal -> pure $ G.VInt intVal
|
||||||
Nothing -> pure $ G.VFloat $ toRealFloat val
|
Nothing -> pure $ G.VFloat $ toRealFloat val
|
||||||
A.Array vals -> G.VList <$> traverse go (toList vals)
|
A.Array vals -> G.VList <$> traverse go (toList vals)
|
||||||
A.Object vals ->
|
A.Object vals ->
|
||||||
G.VObject . Map.fromList <$> for (Map.toList vals) \(key, val) -> do
|
G.VObject . Map.fromList <$> for (Map.toList vals) \(key, val) -> do
|
||||||
|
@ -10,7 +10,6 @@ import Hasura.SQL.Types
|
|||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
|
|
||||||
|
|
||||||
traverseMutFld
|
traverseMutFld
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b)
|
=> (a -> f b)
|
||||||
@ -19,8 +18,7 @@ traverseMutFld
|
|||||||
traverseMutFld f = \case
|
traverseMutFld f = \case
|
||||||
MCount -> pure MCount
|
MCount -> pure MCount
|
||||||
MExp t -> pure $ MExp t
|
MExp t -> pure $ MExp t
|
||||||
MRet flds -> MRet <$> traverse (traverse (traverseAnnFld f)) flds
|
MRet flds -> MRet <$> traverse (traverse (traverseAnnField f)) flds
|
||||||
|
|
||||||
|
|
||||||
traverseMutationOutput
|
traverseMutationOutput
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
@ -30,7 +28,7 @@ traverseMutationOutput f = \case
|
|||||||
MOutMultirowFields mutationFields ->
|
MOutMultirowFields mutationFields ->
|
||||||
MOutMultirowFields <$> traverse (traverse (traverseMutFld f)) mutationFields
|
MOutMultirowFields <$> traverse (traverse (traverseMutFld f)) mutationFields
|
||||||
MOutSinglerowObject annFields ->
|
MOutSinglerowObject annFields ->
|
||||||
MOutSinglerowObject <$> traverseAnnFlds f annFields
|
MOutSinglerowObject <$> traverseAnnFields f annFields
|
||||||
|
|
||||||
traverseMutFlds
|
traverseMutFlds
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
@ -43,15 +41,15 @@ traverseMutFlds f =
|
|||||||
hasNestedFld :: MutationOutputG a -> Bool
|
hasNestedFld :: MutationOutputG a -> Bool
|
||||||
hasNestedFld = \case
|
hasNestedFld = \case
|
||||||
MOutMultirowFields flds -> any isNestedMutFld flds
|
MOutMultirowFields flds -> any isNestedMutFld flds
|
||||||
MOutSinglerowObject annFlds -> any isNestedAnnFld annFlds
|
MOutSinglerowObject annFlds -> any isNestedAnnField annFlds
|
||||||
where
|
where
|
||||||
isNestedMutFld (_, mutFld) = case mutFld of
|
isNestedMutFld (_, mutFld) = case mutFld of
|
||||||
MRet annFlds -> any isNestedAnnFld annFlds
|
MRet annFlds -> any isNestedAnnField annFlds
|
||||||
_ -> False
|
_ -> False
|
||||||
isNestedAnnFld (_, annFld) = case annFld of
|
isNestedAnnField (_, annFld) = case annFld of
|
||||||
FObj _ -> True
|
AFObjectRelation _ -> True
|
||||||
FArr _ -> True
|
AFArrayRelation _ -> True
|
||||||
_ -> False
|
_ -> False
|
||||||
|
|
||||||
pgColsFromMutFld :: MutFld -> [(PGCol, PGColumnType)]
|
pgColsFromMutFld :: MutFld -> [(PGCol, PGColumnType)]
|
||||||
pgColsFromMutFld = \case
|
pgColsFromMutFld = \case
|
||||||
@ -59,16 +57,16 @@ pgColsFromMutFld = \case
|
|||||||
MExp _ -> []
|
MExp _ -> []
|
||||||
MRet selFlds ->
|
MRet selFlds ->
|
||||||
flip mapMaybe selFlds $ \(_, annFld) -> case annFld of
|
flip mapMaybe selFlds $ \(_, annFld) -> case annFld of
|
||||||
FCol (AnnColField (PGColumnInfo col _ _ colTy _ _) _ _) -> Just (col, colTy)
|
AFColumn (AnnColumnField (PGColumnInfo col _ _ colTy _ _) _ _) -> Just (col, colTy)
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
pgColsFromMutFlds :: MutFlds -> [(PGCol, PGColumnType)]
|
pgColsFromMutFlds :: MutFlds -> [(PGCol, PGColumnType)]
|
||||||
pgColsFromMutFlds = concatMap (pgColsFromMutFld . snd)
|
pgColsFromMutFlds = concatMap (pgColsFromMutFld . snd)
|
||||||
|
|
||||||
pgColsToSelFlds :: [PGColumnInfo] -> [(FieldName, AnnFld)]
|
pgColsToSelFlds :: [PGColumnInfo] -> [(FieldName, AnnField)]
|
||||||
pgColsToSelFlds cols =
|
pgColsToSelFlds cols =
|
||||||
flip map cols $
|
flip map cols $
|
||||||
\pgColInfo -> (fromPGCol $ pgiColumn pgColInfo, mkAnnColField pgColInfo Nothing)
|
\pgColInfo -> (fromPGCol $ pgiColumn pgColInfo, mkAnnColumnField pgColInfo Nothing)
|
||||||
|
|
||||||
mkDefaultMutFlds :: Maybe [PGColumnInfo] -> MutationOutput
|
mkDefaultMutFlds :: Maybe [PGColumnInfo] -> MutationOutput
|
||||||
mkDefaultMutFlds = MOutMultirowFields . \case
|
mkDefaultMutFlds = MOutMultirowFields . \case
|
||||||
@ -95,7 +93,7 @@ mkMutFldExp qt preCalAffRows strfyNum = \case
|
|||||||
let tabFrom = FromIden cteAlias
|
let tabFrom = FromIden cteAlias
|
||||||
tabPerm = TablePerm annBoolExpTrue Nothing
|
tabPerm = TablePerm annBoolExpTrue Nothing
|
||||||
in S.SESelect $ mkSQLSelect JASMultipleRows $
|
in S.SESelect $ mkSQLSelect JASMultipleRows $
|
||||||
AnnSelG selFlds tabFrom tabPerm noTableArgs strfyNum
|
AnnSelectG selFlds tabFrom tabPerm noSelectArgs strfyNum
|
||||||
where
|
where
|
||||||
cteAlias = qualTableToAliasIden qt
|
cteAlias = qualTableToAliasIden qt
|
||||||
|
|
||||||
@ -117,7 +115,7 @@ mkMutationOutputExp qt preCalAffRows cte mutOutput strfyNum =
|
|||||||
let tabFrom = FromIden cteAlias
|
let tabFrom = FromIden cteAlias
|
||||||
tabPerm = TablePerm annBoolExpTrue Nothing
|
tabPerm = TablePerm annBoolExpTrue Nothing
|
||||||
in S.SESelect $ mkSQLSelect JASSingleObject $
|
in S.SESelect $ mkSQLSelect JASSingleObject $
|
||||||
AnnSelG annFlds tabFrom tabPerm noTableArgs strfyNum
|
AnnSelectG annFlds tabFrom tabPerm noSelectArgs strfyNum
|
||||||
|
|
||||||
|
|
||||||
checkRetCols
|
checkRetCols
|
||||||
|
@ -12,7 +12,7 @@ import Hasura.RQL.DML.Select.Types
|
|||||||
data MutFldG v
|
data MutFldG v
|
||||||
= MCount
|
= MCount
|
||||||
| MExp !T.Text
|
| MExp !T.Text
|
||||||
| MRet !(AnnFldsG v)
|
| MRet !(AnnFieldsG v)
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
type MutFld = MutFldG S.SQLExp
|
type MutFld = MutFldG S.SQLExp
|
||||||
@ -21,7 +21,7 @@ type MutFldsG v = Fields (MutFldG v)
|
|||||||
|
|
||||||
data MutationOutputG v
|
data MutationOutputG v
|
||||||
= MOutMultirowFields !(MutFldsG v)
|
= MOutMultirowFields !(MutFldsG v)
|
||||||
| MOutSinglerowObject !(AnnFldsG v)
|
| MOutSinglerowObject !(AnnFieldsG v)
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
type MutationOutput = MutationOutputG S.SQLExp
|
type MutationOutput = MutationOutputG S.SQLExp
|
||||||
|
@ -1,11 +1,11 @@
|
|||||||
module Hasura.RQL.DML.Select
|
module Hasura.RQL.DML.Select
|
||||||
( selectP2
|
( selectP2
|
||||||
, selectQuerySQL
|
|
||||||
, selectAggQuerySQL
|
|
||||||
, convSelectQuery
|
, convSelectQuery
|
||||||
, asSingleRowJsonResp
|
, asSingleRowJsonResp
|
||||||
, module Hasura.RQL.DML.Select.Internal
|
|
||||||
, runSelect
|
, runSelect
|
||||||
|
, selectQuerySQL
|
||||||
|
, selectAggregateQuerySQL
|
||||||
|
, module Hasura.RQL.DML.Select.Internal
|
||||||
)
|
)
|
||||||
where
|
where
|
||||||
|
|
||||||
@ -105,7 +105,7 @@ convOrderByElem
|
|||||||
=> SessVarBldr m
|
=> SessVarBldr m
|
||||||
-> (FieldInfoMap FieldInfo, SelPermInfo)
|
-> (FieldInfoMap FieldInfo, SelPermInfo)
|
||||||
-> OrderByCol
|
-> OrderByCol
|
||||||
-> m AnnObCol
|
-> m (AnnOrderByElement S.SQLExp)
|
||||||
convOrderByElem sessVarBldr (flds, spi) = \case
|
convOrderByElem sessVarBldr (flds, spi) = \case
|
||||||
OCPG fldName -> do
|
OCPG fldName -> do
|
||||||
fldInfo <- askFieldInfo flds fldName
|
fldInfo <- askFieldInfo flds fldName
|
||||||
@ -118,7 +118,7 @@ convOrderByElem sessVarBldr (flds, spi) = \case
|
|||||||
[ fldName <<> " has type 'geometry'"
|
[ fldName <<> " has type 'geometry'"
|
||||||
, " and cannot be used in order_by"
|
, " and cannot be used in order_by"
|
||||||
]
|
]
|
||||||
else return $ AOCPG $ pgiColumn colInfo
|
else return $ AOCColumn colInfo
|
||||||
FIRelationship _ -> throw400 UnexpectedPayload $ mconcat
|
FIRelationship _ -> throw400 UnexpectedPayload $ mconcat
|
||||||
[ fldName <<> " is a"
|
[ fldName <<> " is a"
|
||||||
, " relationship and should be expanded"
|
, " relationship and should be expanded"
|
||||||
@ -149,7 +149,7 @@ convOrderByElem sessVarBldr (flds, spi) = \case
|
|||||||
]
|
]
|
||||||
(relFim, relSpi) <- fetchRelDet (riName relInfo) (riRTable relInfo)
|
(relFim, relSpi) <- fetchRelDet (riName relInfo) (riRTable relInfo)
|
||||||
resolvedSelFltr <- convAnnBoolExpPartialSQL sessVarBldr $ spiFilter relSpi
|
resolvedSelFltr <- convAnnBoolExpPartialSQL sessVarBldr $ spiFilter relSpi
|
||||||
AOCObj relInfo resolvedSelFltr <$>
|
AOCObjectRelation relInfo resolvedSelFltr <$>
|
||||||
convOrderByElem sessVarBldr (relFim, relSpi) rest
|
convOrderByElem sessVarBldr (relFim, relSpi) rest
|
||||||
FIRemoteRelationship {} ->
|
FIRemoteRelationship {} ->
|
||||||
throw400 UnexpectedPayload (mconcat [ fldName <<> " is a remote field" ])
|
throw400 UnexpectedPayload (mconcat [ fldName <<> " is a remote field" ])
|
||||||
@ -168,12 +168,12 @@ convSelectQ fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do
|
|||||||
indexedForM (sqColumns selQ) $ \case
|
indexedForM (sqColumns selQ) $ \case
|
||||||
(ECSimple pgCol) -> do
|
(ECSimple pgCol) -> do
|
||||||
colInfo <- convExtSimple fieldInfoMap selPermInfo pgCol
|
colInfo <- convExtSimple fieldInfoMap selPermInfo pgCol
|
||||||
return (fromPGCol pgCol, mkAnnColField colInfo Nothing)
|
return (fromPGCol pgCol, mkAnnColumnField colInfo Nothing)
|
||||||
(ECRel relName mAlias relSelQ) -> do
|
(ECRel relName mAlias relSelQ) -> do
|
||||||
annRel <- convExtRel fieldInfoMap relName mAlias
|
annRel <- convExtRel fieldInfoMap relName mAlias
|
||||||
relSelQ sessVarBldr prepValBldr
|
relSelQ sessVarBldr prepValBldr
|
||||||
return ( fromRel $ fromMaybe relName mAlias
|
return ( fromRel $ fromMaybe relName mAlias
|
||||||
, either FObj FArr annRel
|
, either AFObjectRelation AFArrayRelation annRel
|
||||||
)
|
)
|
||||||
|
|
||||||
-- let spiT = spiTable selPermInfo
|
-- let spiT = spiTable selPermInfo
|
||||||
@ -198,11 +198,11 @@ convSelectQ fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do
|
|||||||
|
|
||||||
let tabFrom = FromTable $ spiTable selPermInfo
|
let tabFrom = FromTable $ spiTable selPermInfo
|
||||||
tabPerm = TablePerm resolvedSelFltr mPermLimit
|
tabPerm = TablePerm resolvedSelFltr mPermLimit
|
||||||
tabArgs = TableArgs wClause annOrdByM mQueryLimit
|
tabArgs = SelectArgs wClause annOrdByM mQueryLimit
|
||||||
(S.intToSQLExp <$> mQueryOffset) Nothing
|
(S.intToSQLExp <$> mQueryOffset) Nothing
|
||||||
|
|
||||||
strfyNum <- stringifyNum <$> askSQLGenCtx
|
strfyNum <- stringifyNum <$> askSQLGenCtx
|
||||||
return $ AnnSelG annFlds tabFrom tabPerm tabArgs strfyNum
|
return $ AnnSelectG annFlds tabFrom tabPerm tabArgs strfyNum
|
||||||
|
|
||||||
where
|
where
|
||||||
mQueryOffset = sqOffset selQ
|
mQueryOffset = sqOffset selQ
|
||||||
@ -229,7 +229,7 @@ convExtRel
|
|||||||
-> SelectQExt
|
-> SelectQExt
|
||||||
-> SessVarBldr m
|
-> SessVarBldr m
|
||||||
-> (PGColumnType -> Value -> m S.SQLExp)
|
-> (PGColumnType -> Value -> m S.SQLExp)
|
||||||
-> m (Either ObjSel ArrSel)
|
-> m (Either ObjectRelationSelect ArraySelect)
|
||||||
convExtRel fieldInfoMap relName mAlias selQ sessVarBldr prepValBldr = do
|
convExtRel fieldInfoMap relName mAlias selQ sessVarBldr prepValBldr = do
|
||||||
-- Point to the name key
|
-- Point to the name key
|
||||||
relInfo <- withPathK "name" $
|
relInfo <- withPathK "name" $
|
||||||
@ -240,9 +240,9 @@ convExtRel fieldInfoMap relName mAlias selQ sessVarBldr prepValBldr = do
|
|||||||
case relTy of
|
case relTy of
|
||||||
ObjRel -> do
|
ObjRel -> do
|
||||||
when misused $ throw400 UnexpectedPayload objRelMisuseMsg
|
when misused $ throw400 UnexpectedPayload objRelMisuseMsg
|
||||||
return $ Left $ AnnRelG (fromMaybe relName mAlias) colMapping annSel
|
return $ Left $ AnnRelationSelectG (fromMaybe relName mAlias) colMapping annSel
|
||||||
ArrRel ->
|
ArrRel ->
|
||||||
return $ Right $ ASSimple $ AnnRelG (fromMaybe relName mAlias)
|
return $ Right $ ASSimple $ AnnRelationSelectG (fromMaybe relName mAlias)
|
||||||
colMapping annSel
|
colMapping annSel
|
||||||
where
|
where
|
||||||
pgWhenRelErr = "only relationships can be expanded"
|
pgWhenRelErr = "only relationships can be expanded"
|
||||||
@ -270,8 +270,7 @@ convSelectQuery sessVarBldr prepArgBuilder (DMLQuery qt selQ) = do
|
|||||||
let fieldInfo = _tciFieldInfoMap $ _tiCoreInfo tabInfo
|
let fieldInfo = _tciFieldInfoMap $ _tiCoreInfo tabInfo
|
||||||
extSelQ <- resolveStar fieldInfo selPermInfo selQ
|
extSelQ <- resolveStar fieldInfo selPermInfo selQ
|
||||||
validateHeaders $ spiRequiredHeaders selPermInfo
|
validateHeaders $ spiRequiredHeaders selPermInfo
|
||||||
convSelectQ fieldInfo selPermInfo
|
convSelectQ fieldInfo selPermInfo extSelQ sessVarBldr prepArgBuilder
|
||||||
extSelQ sessVarBldr prepArgBuilder
|
|
||||||
|
|
||||||
selectP2 :: JsonAggSelect -> (AnnSimpleSel, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON
|
selectP2 :: JsonAggSelect -> (AnnSimpleSel, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON
|
||||||
selectP2 jsonAggSelect (sel, p) =
|
selectP2 jsonAggSelect (sel, p) =
|
||||||
@ -284,9 +283,9 @@ selectQuerySQL :: JsonAggSelect -> AnnSimpleSel -> Q.Query
|
|||||||
selectQuerySQL jsonAggSelect sel =
|
selectQuerySQL jsonAggSelect sel =
|
||||||
Q.fromBuilder $ toSQL $ mkSQLSelect jsonAggSelect sel
|
Q.fromBuilder $ toSQL $ mkSQLSelect jsonAggSelect sel
|
||||||
|
|
||||||
selectAggQuerySQL :: AnnAggSel -> Q.Query
|
selectAggregateQuerySQL :: AnnAggregateSelect -> Q.Query
|
||||||
selectAggQuerySQL =
|
selectAggregateQuerySQL =
|
||||||
Q.fromBuilder . toSQL . mkAggSelect
|
Q.fromBuilder . toSQL . mkAggregateSelect
|
||||||
|
|
||||||
asSingleRowJsonResp :: Q.Query -> [Q.PrepArg] -> Q.TxE QErr EncJSON
|
asSingleRowJsonResp :: Q.Query -> [Q.PrepArg] -> Q.TxE QErr EncJSON
|
||||||
asSingleRowJsonResp query args =
|
asSingleRowJsonResp query args =
|
||||||
|
File diff suppressed because it is too large
Load Diff
@ -3,19 +3,19 @@
|
|||||||
|
|
||||||
module Hasura.RQL.DML.Select.Types where
|
module Hasura.RQL.DML.Select.Types where
|
||||||
|
|
||||||
|
import Control.Lens.TH (makeLenses, makePrisms)
|
||||||
import Data.Aeson.Types
|
import Data.Aeson.Types
|
||||||
import Language.Haskell.TH.Syntax (Lift)
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
import Control.Lens.TH (makePrisms)
|
|
||||||
|
|
||||||
import qualified Data.HashMap.Strict as HM
|
import qualified Data.Aeson as J
|
||||||
import qualified Data.List.NonEmpty as NE
|
import qualified Data.HashMap.Strict as HM
|
||||||
import qualified Data.Sequence as Seq
|
import qualified Data.List.NonEmpty as NE
|
||||||
import qualified Data.Text as T
|
import qualified Data.Sequence as Seq
|
||||||
import qualified Data.Aeson as J
|
import qualified Data.Text as T
|
||||||
import qualified Language.GraphQL.Draft.Syntax as G
|
import qualified Language.GraphQL.Draft.Syntax as G
|
||||||
|
|
||||||
import Hasura.Prelude
|
|
||||||
import Hasura.GraphQL.Parser.Schema
|
import Hasura.GraphQL.Parser.Schema
|
||||||
|
import Hasura.Prelude
|
||||||
import Hasura.RQL.Types.BoolExp
|
import Hasura.RQL.Types.BoolExp
|
||||||
import Hasura.RQL.Types.Column
|
import Hasura.RQL.Types.Column
|
||||||
import Hasura.RQL.Types.Common
|
import Hasura.RQL.Types.Common
|
||||||
@ -23,7 +23,7 @@ import Hasura.RQL.Types.DML
|
|||||||
import Hasura.RQL.Types.Function
|
import Hasura.RQL.Types.Function
|
||||||
import Hasura.RQL.Types.RemoteRelationship
|
import Hasura.RQL.Types.RemoteRelationship
|
||||||
import Hasura.RQL.Types.RemoteSchema
|
import Hasura.RQL.Types.RemoteSchema
|
||||||
import qualified Hasura.SQL.DML as S
|
import qualified Hasura.SQL.DML as S
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
|
|
||||||
type SelectQExt = SelectG ExtCol BoolExp Int
|
type SelectQExt = SelectG ExtCol BoolExp Int
|
||||||
@ -31,7 +31,8 @@ type SelectQExt = SelectG ExtCol BoolExp Int
|
|||||||
data JsonAggSelect
|
data JsonAggSelect
|
||||||
= JASMultipleRows
|
= JASMultipleRows
|
||||||
| JASSingleObject
|
| JASSingleObject
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq, Generic)
|
||||||
|
instance Hashable JsonAggSelect
|
||||||
|
|
||||||
-- Columns in RQL
|
-- Columns in RQL
|
||||||
data ExtCol
|
data ExtCol
|
||||||
@ -60,118 +61,129 @@ instance FromJSON ExtCol where
|
|||||||
, "object (relationship)"
|
, "object (relationship)"
|
||||||
]
|
]
|
||||||
|
|
||||||
data AnnAggOrdBy
|
data AnnAggregateOrderBy
|
||||||
= AAOCount
|
= AAOCount
|
||||||
| AAOOp !T.Text !PGCol
|
| AAOOp !T.Text !PGColumnInfo
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq, Generic)
|
||||||
|
instance Hashable AnnAggregateOrderBy
|
||||||
|
|
||||||
data AnnObColG v
|
data AnnOrderByElementG v
|
||||||
= AOCPG !PGCol
|
= AOCColumn !PGColumnInfo
|
||||||
| AOCObj !RelInfo !(AnnBoolExp v) !(AnnObColG v)
|
| AOCObjectRelation !RelInfo !v !(AnnOrderByElementG v)
|
||||||
| AOCAgg !RelInfo !(AnnBoolExp v) !AnnAggOrdBy
|
| AOCArrayAggregation !RelInfo !v !AnnAggregateOrderBy
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq, Generic, Functor)
|
||||||
|
instance (Hashable v) => Hashable (AnnOrderByElementG v)
|
||||||
|
|
||||||
traverseAnnObCol
|
type AnnOrderByElement v = AnnOrderByElementG (AnnBoolExp v)
|
||||||
|
|
||||||
|
traverseAnnOrderByElement
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b) -> AnnObColG a -> f (AnnObColG b)
|
=> (a -> f b) -> AnnOrderByElement a -> f (AnnOrderByElement b)
|
||||||
traverseAnnObCol f = \case
|
traverseAnnOrderByElement f = \case
|
||||||
AOCPG pgColInfo -> pure $ AOCPG pgColInfo
|
AOCColumn pgColInfo -> pure $ AOCColumn pgColInfo
|
||||||
AOCObj relInfo annBoolExp annObCol ->
|
AOCObjectRelation relInfo annBoolExp annObCol ->
|
||||||
AOCObj relInfo
|
AOCObjectRelation relInfo
|
||||||
<$> traverseAnnBoolExp f annBoolExp
|
<$> traverseAnnBoolExp f annBoolExp
|
||||||
<*> traverseAnnObCol f annObCol
|
<*> traverseAnnOrderByElement f annObCol
|
||||||
AOCAgg relInfo annBoolExp annAggOb ->
|
AOCArrayAggregation relInfo annBoolExp annAggOb ->
|
||||||
AOCAgg relInfo
|
AOCArrayAggregation relInfo
|
||||||
<$> traverseAnnBoolExp f annBoolExp
|
<$> traverseAnnBoolExp f annBoolExp
|
||||||
<*> pure annAggOb
|
<*> pure annAggOb
|
||||||
|
|
||||||
type AnnObCol = AnnObColG S.SQLExp
|
type AnnOrderByItemG v = OrderByItemG (AnnOrderByElement v)
|
||||||
|
|
||||||
type AnnOrderByItemG v = OrderByItemG (AnnObColG v)
|
|
||||||
|
|
||||||
traverseAnnOrderByItem
|
traverseAnnOrderByItem
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b) -> AnnOrderByItemG a -> f (AnnOrderByItemG b)
|
=> (a -> f b) -> AnnOrderByItemG a -> f (AnnOrderByItemG b)
|
||||||
traverseAnnOrderByItem f =
|
traverseAnnOrderByItem f =
|
||||||
traverse (traverseAnnObCol f)
|
traverse (traverseAnnOrderByElement f)
|
||||||
|
|
||||||
type AnnOrderByItem = AnnOrderByItemG S.SQLExp
|
type AnnOrderByItem = AnnOrderByItemG S.SQLExp
|
||||||
|
|
||||||
data AnnRelG a
|
type OrderByItemExp =
|
||||||
= AnnRelG
|
OrderByItemG (AnnOrderByElement S.SQLExp, (S.Alias, S.SQLExp))
|
||||||
{ aarName :: !RelName -- Relationship name
|
|
||||||
, aarMapping :: !(HashMap PGCol PGCol) -- Column of left table to join with
|
data AnnRelationSelectG a
|
||||||
, aarAnnSel :: !a -- Current table. Almost ~ to SQL Select
|
= AnnRelationSelectG
|
||||||
|
{ aarRelationshipName :: !RelName -- Relationship name
|
||||||
|
, aarColumnMapping :: !(HashMap PGCol PGCol) -- Column of left table to join with
|
||||||
|
, aarAnnSelect :: !a -- Current table. Almost ~ to SQL Select
|
||||||
} deriving (Show, Eq, Functor, Foldable, Traversable)
|
} deriving (Show, Eq, Functor, Foldable, Traversable)
|
||||||
|
|
||||||
type ObjSelG v = AnnRelG (AnnSimpleSelG v)
|
type ObjectRelationSelectG v = AnnRelationSelectG (AnnSimpleSelG v)
|
||||||
type ObjSel = ObjSelG S.SQLExp
|
type ObjectRelationSelect = ObjectRelationSelectG S.SQLExp
|
||||||
|
|
||||||
type ArrRelG v = AnnRelG (AnnSimpleSelG v)
|
type ArrayRelationSelectG v = AnnRelationSelectG (AnnSimpleSelG v)
|
||||||
type ArrRelAggG v = AnnRelG (AnnAggSelG v)
|
type ArrayAggregateSelectG v = AnnRelationSelectG (AnnAggregateSelectG v)
|
||||||
type ArrRelAgg = ArrRelAggG S.SQLExp
|
type ArrayConnectionSelect v = AnnRelationSelectG (ConnectionSelect v)
|
||||||
|
type ArrayAggregateSelect = ArrayAggregateSelectG S.SQLExp
|
||||||
|
|
||||||
data ComputedFieldScalarSel v
|
data ComputedFieldScalarSelect v
|
||||||
= ComputedFieldScalarSel
|
= ComputedFieldScalarSelect
|
||||||
{ _cfssFunction :: !QualifiedFunction
|
{ _cfssFunction :: !QualifiedFunction
|
||||||
, _cfssArguments :: !(FunctionArgsExpTableRow v)
|
, _cfssArguments :: !(FunctionArgsExpTableRow v)
|
||||||
, _cfssType :: !PGScalarType
|
, _cfssType :: !PGScalarType
|
||||||
, _cfssColumnOp :: !(Maybe ColOp)
|
, _cfssColumnOp :: !(Maybe ColumnOp)
|
||||||
} deriving (Show, Eq, Functor, Foldable, Traversable)
|
} deriving (Show, Eq, Functor, Foldable, Traversable)
|
||||||
|
|
||||||
data ComputedFieldSel v
|
data ComputedFieldSelect v
|
||||||
= CFSScalar !(ComputedFieldScalarSel v)
|
= CFSScalar !(ComputedFieldScalarSelect v)
|
||||||
| CFSTable !JsonAggSelect !(AnnSimpleSelG v)
|
| CFSTable !JsonAggSelect !(AnnSimpleSelG v)
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
traverseComputedFieldSel
|
traverseComputedFieldSelect
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (v -> f w)
|
=> (v -> f w)
|
||||||
-> ComputedFieldSel v -> f (ComputedFieldSel w)
|
-> ComputedFieldSelect v -> f (ComputedFieldSelect w)
|
||||||
traverseComputedFieldSel fv = \case
|
traverseComputedFieldSelect fv = \case
|
||||||
CFSScalar scalarSel -> CFSScalar <$> traverse fv scalarSel
|
CFSScalar scalarSel -> CFSScalar <$> traverse fv scalarSel
|
||||||
CFSTable b tableSel -> CFSTable b <$> traverseAnnSimpleSel fv tableSel
|
CFSTable b tableSel -> CFSTable b <$> traverseAnnSimpleSelect fv tableSel
|
||||||
|
|
||||||
type Fields a = [(FieldName, a)]
|
type Fields a = [(FieldName, a)]
|
||||||
|
|
||||||
data ArrSelG v
|
data ArraySelectG v
|
||||||
= ASSimple !(ArrRelG v)
|
= ASSimple !(ArrayRelationSelectG v)
|
||||||
| ASAgg !(ArrRelAggG v)
|
| ASAggregate !(ArrayAggregateSelectG v)
|
||||||
|
| ASConnection !(ArrayConnectionSelect v)
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
traverseArrSel
|
traverseArraySelect
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b)
|
=> (a -> f b)
|
||||||
-> ArrSelG a
|
-> ArraySelectG a
|
||||||
-> f (ArrSelG b)
|
-> f (ArraySelectG b)
|
||||||
traverseArrSel f = \case
|
traverseArraySelect f = \case
|
||||||
ASSimple arrRel -> ASSimple <$> traverse (traverseAnnSimpleSel f) arrRel
|
ASSimple arrRel ->
|
||||||
ASAgg arrRelAgg -> ASAgg <$> traverse (traverseAnnAggSel f) arrRelAgg
|
ASSimple <$> traverse (traverseAnnSimpleSelect f) arrRel
|
||||||
|
ASAggregate arrRelAgg ->
|
||||||
|
ASAggregate <$> traverse (traverseAnnAggregateSelect f) arrRelAgg
|
||||||
|
ASConnection relConnection ->
|
||||||
|
ASConnection <$> traverse (traverseConnectionSelect f) relConnection
|
||||||
|
|
||||||
type ArrSel = ArrSelG S.SQLExp
|
type ArraySelect = ArraySelectG S.SQLExp
|
||||||
|
|
||||||
type ArrSelFldsG v = Fields (ArrSelG v)
|
type ArraySelectFieldsG v = Fields (ArraySelectG v)
|
||||||
|
|
||||||
data ColOp
|
data ColumnOp
|
||||||
= ColOp
|
= ColumnOp
|
||||||
{ _colOp :: S.SQLOp
|
{ _colOp :: S.SQLOp
|
||||||
, _colExp :: S.SQLExp
|
, _colExp :: S.SQLExp
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
data AnnColField
|
data AnnColumnField
|
||||||
= AnnColField
|
= AnnColumnField
|
||||||
{ _acfInfo :: !PGColumnInfo
|
{ _acfInfo :: !PGColumnInfo
|
||||||
, _acfAsText :: !Bool
|
, _acfAsText :: !Bool
|
||||||
-- ^ If this field is 'True', columns are explicitly casted to @text@ when fetched, which avoids
|
-- ^ If this field is 'True', columns are explicitly casted to @text@ when fetched, which avoids
|
||||||
-- an issue that occurs because we don’t currently have proper support for array types. See
|
-- an issue that occurs because we don’t currently have proper support for array types. See
|
||||||
-- https://github.com/hasura/graphql-engine/pull/3198 for more details.
|
-- https://github.com/hasura/graphql-engine/pull/3198 for more details.
|
||||||
, _acfOp :: !(Maybe ColOp)
|
, _acfOp :: !(Maybe ColumnOp)
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
data RemoteFieldArgument
|
data RemoteFieldArgument
|
||||||
= RemoteFieldArgument
|
= RemoteFieldArgument
|
||||||
{ _rfaName :: !G.Name
|
{ _rfaName :: !G.Name
|
||||||
, _rfaValue :: !(G.Value Variable)
|
, _rfaValue :: !(G.Value Variable)
|
||||||
, _rfaVariable :: !(Maybe [(G.VariableDefinition,J.Value)])
|
, _rfaVariable :: !(Maybe [(G.VariableDefinition,J.Value)])
|
||||||
} deriving (Eq,Show)
|
} deriving (Eq,Show)
|
||||||
|
|
||||||
@ -184,50 +196,53 @@ data RemoteSelect
|
|||||||
, _rselRemoteSchema :: !RemoteSchemaInfo
|
, _rselRemoteSchema :: !RemoteSchemaInfo
|
||||||
} deriving (Show,Eq)
|
} deriving (Show,Eq)
|
||||||
|
|
||||||
data AnnFldG v
|
data AnnFieldG v
|
||||||
= FCol !AnnColField
|
= AFColumn !AnnColumnField
|
||||||
| FObj !(ObjSelG v)
|
| AFObjectRelation !(ObjectRelationSelectG v)
|
||||||
| FArr !(ArrSelG v)
|
| AFArrayRelation !(ArraySelectG v)
|
||||||
| FComputedField !(ComputedFieldSel v)
|
| AFComputedField !(ComputedFieldSelect v)
|
||||||
| FExp !T.Text
|
| AFRemote !RemoteSelect
|
||||||
| FRemote !RemoteSelect
|
| AFNodeId !QualifiedTable !(NonEmpty PGColumnInfo)
|
||||||
deriving (Show,Eq)
|
| AFExpression !T.Text
|
||||||
|
deriving (Show, Eq)
|
||||||
|
|
||||||
mkAnnColField :: PGColumnInfo -> Maybe ColOp -> AnnFldG v
|
mkAnnColumnField :: PGColumnInfo -> Maybe ColumnOp -> AnnFieldG v
|
||||||
mkAnnColField ci colOpM =
|
mkAnnColumnField ci colOpM =
|
||||||
FCol $ AnnColField ci False colOpM
|
AFColumn $ AnnColumnField ci False colOpM
|
||||||
|
|
||||||
mkAnnColFieldAsText :: PGColumnInfo -> AnnFldG v
|
mkAnnColumnFieldAsText :: PGColumnInfo -> AnnFieldG v
|
||||||
mkAnnColFieldAsText ci =
|
mkAnnColumnFieldAsText ci =
|
||||||
FCol $ AnnColField ci True Nothing
|
AFColumn $ AnnColumnField ci True Nothing
|
||||||
|
|
||||||
traverseAnnFld
|
traverseAnnField
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b) -> AnnFldG a -> f (AnnFldG b)
|
=> (a -> f b) -> AnnFieldG a -> f (AnnFieldG b)
|
||||||
traverseAnnFld f = \case
|
traverseAnnField f = \case
|
||||||
FCol colFld -> pure $ FCol colFld
|
AFColumn colFld -> pure $ AFColumn colFld
|
||||||
FObj sel -> FObj <$> traverse (traverseAnnSimpleSel f) sel
|
AFObjectRelation sel -> AFObjectRelation <$> traverse (traverseAnnSimpleSelect f) sel
|
||||||
FArr sel -> FArr <$> traverseArrSel f sel
|
AFArrayRelation sel -> AFArrayRelation <$> traverseArraySelect f sel
|
||||||
FComputedField sel -> FComputedField <$> traverseComputedFieldSel f sel
|
AFComputedField sel -> AFComputedField <$> traverseComputedFieldSelect f sel
|
||||||
FExp t -> FExp <$> pure t
|
AFRemote s -> pure $ AFRemote s
|
||||||
FRemote s -> pure $ FRemote s
|
AFNodeId qt pKeys -> pure $ AFNodeId qt pKeys
|
||||||
|
AFExpression t -> AFExpression <$> pure t
|
||||||
|
|
||||||
type AnnFld = AnnFldG S.SQLExp
|
type AnnField = AnnFieldG S.SQLExp
|
||||||
|
|
||||||
data TableArgsG v
|
data SelectArgsG v
|
||||||
= TableArgs
|
= SelectArgs
|
||||||
{ _taWhere :: !(Maybe (AnnBoolExp v))
|
{ _saWhere :: !(Maybe (AnnBoolExp v))
|
||||||
, _taOrderBy :: !(Maybe (NE.NonEmpty (AnnOrderByItemG v)))
|
, _saOrderBy :: !(Maybe (NE.NonEmpty (AnnOrderByItemG v)))
|
||||||
, _taLimit :: !(Maybe Int)
|
, _saLimit :: !(Maybe Int)
|
||||||
, _taOffset :: !(Maybe S.SQLExp)
|
, _saOffset :: !(Maybe S.SQLExp)
|
||||||
, _taDistCols :: !(Maybe (NE.NonEmpty PGCol))
|
, _saDistinct :: !(Maybe (NE.NonEmpty PGCol))
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq, Generic)
|
||||||
|
instance (Hashable v) => Hashable (SelectArgsG v)
|
||||||
|
|
||||||
traverseTableArgs
|
traverseSelectArgs
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b) -> TableArgsG a -> f (TableArgsG b)
|
=> (a -> f b) -> SelectArgsG a -> f (SelectArgsG b)
|
||||||
traverseTableArgs f (TableArgs wh ordBy lmt ofst distCols) =
|
traverseSelectArgs f (SelectArgs wh ordBy lmt ofst distCols) =
|
||||||
TableArgs
|
SelectArgs
|
||||||
<$> traverse (traverseAnnBoolExp f) wh
|
<$> traverse (traverseAnnBoolExp f) wh
|
||||||
-- traversing through maybe -> nonempty -> annorderbyitem
|
-- traversing through maybe -> nonempty -> annorderbyitem
|
||||||
<*> traverse (traverse (traverseAnnOrderByItem f)) ordBy
|
<*> traverse (traverse (traverseAnnOrderByItem f)) ordBy
|
||||||
@ -235,62 +250,103 @@ traverseTableArgs f (TableArgs wh ordBy lmt ofst distCols) =
|
|||||||
<*> pure ofst
|
<*> pure ofst
|
||||||
<*> pure distCols
|
<*> pure distCols
|
||||||
|
|
||||||
type TableArgs = TableArgsG S.SQLExp
|
type SelectArgs = SelectArgsG S.SQLExp
|
||||||
|
|
||||||
noTableArgs :: TableArgsG v
|
noSelectArgs :: SelectArgsG v
|
||||||
noTableArgs = TableArgs Nothing Nothing Nothing Nothing Nothing
|
noSelectArgs = SelectArgs Nothing Nothing Nothing Nothing Nothing
|
||||||
|
|
||||||
data PGColFld
|
data PGColFld
|
||||||
= PCFCol !PGCol
|
= PCFCol !PGCol
|
||||||
| PCFExp !T.Text
|
| PCFExp !T.Text
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
type ColFlds = Fields PGColFld
|
type ColumnFields = Fields PGColFld
|
||||||
|
|
||||||
data AggOp
|
data AggregateOp
|
||||||
= AggOp
|
= AggregateOp
|
||||||
{ _aoOp :: !T.Text
|
{ _aoOp :: !T.Text
|
||||||
, _aoFlds :: !ColFlds
|
, _aoFields :: !ColumnFields
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
data AggFld
|
data AggregateField
|
||||||
= AFCount !S.CountType
|
= AFCount !S.CountType
|
||||||
| AFOp !AggOp
|
| AFOp !AggregateOp
|
||||||
| AFExp !T.Text
|
| AFExp !T.Text
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
type AggFlds = Fields AggFld
|
type AggregateFields = Fields AggregateField
|
||||||
type AnnFldsG v = Fields (AnnFldG v)
|
type AnnFieldsG v = Fields (AnnFieldG v)
|
||||||
|
|
||||||
traverseAnnFlds
|
traverseAnnFields
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b) -> AnnFldsG a -> f (AnnFldsG b)
|
=> (a -> f b) -> AnnFieldsG a -> f (AnnFieldsG b)
|
||||||
traverseAnnFlds f = traverse (traverse (traverseAnnFld f))
|
traverseAnnFields f = traverse (traverse (traverseAnnField f))
|
||||||
|
|
||||||
type AnnFlds = AnnFldsG S.SQLExp
|
type AnnFields = AnnFieldsG S.SQLExp
|
||||||
|
|
||||||
data TableAggFldG v
|
data TableAggregateFieldG v
|
||||||
= TAFAgg !AggFlds
|
= TAFAgg !AggregateFields
|
||||||
| TAFNodes !(AnnFldsG v)
|
| TAFNodes !(AnnFieldsG v)
|
||||||
| TAFExp !T.Text
|
| TAFExp !T.Text
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
traverseTableAggFld
|
data PageInfoField
|
||||||
|
= PageInfoTypename !Text
|
||||||
|
| PageInfoHasNextPage
|
||||||
|
| PageInfoHasPreviousPage
|
||||||
|
| PageInfoStartCursor
|
||||||
|
| PageInfoEndCursor
|
||||||
|
deriving (Show, Eq)
|
||||||
|
type PageInfoFields = Fields PageInfoField
|
||||||
|
|
||||||
|
data EdgeField v
|
||||||
|
= EdgeTypename !Text
|
||||||
|
| EdgeCursor
|
||||||
|
| EdgeNode !(AnnFieldsG v)
|
||||||
|
deriving (Show, Eq)
|
||||||
|
type EdgeFields v = Fields (EdgeField v)
|
||||||
|
|
||||||
|
traverseEdgeField
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b) -> TableAggFldG a -> f (TableAggFldG b)
|
=> (a -> f b) -> EdgeField a -> f (EdgeField b)
|
||||||
traverseTableAggFld f = \case
|
traverseEdgeField f = \case
|
||||||
|
EdgeTypename t -> pure $ EdgeTypename t
|
||||||
|
EdgeCursor -> pure EdgeCursor
|
||||||
|
EdgeNode fields -> EdgeNode <$> traverseAnnFields f fields
|
||||||
|
|
||||||
|
data ConnectionField v
|
||||||
|
= ConnectionTypename !Text
|
||||||
|
| ConnectionPageInfo !PageInfoFields
|
||||||
|
| ConnectionEdges !(EdgeFields v)
|
||||||
|
deriving (Show, Eq)
|
||||||
|
type ConnectionFields v = Fields (ConnectionField v)
|
||||||
|
|
||||||
|
traverseConnectionField
|
||||||
|
:: (Applicative f)
|
||||||
|
=> (a -> f b) -> ConnectionField a -> f (ConnectionField b)
|
||||||
|
traverseConnectionField f = \case
|
||||||
|
ConnectionTypename t -> pure $ ConnectionTypename t
|
||||||
|
ConnectionPageInfo fields -> pure $ ConnectionPageInfo fields
|
||||||
|
ConnectionEdges fields ->
|
||||||
|
ConnectionEdges <$> traverse (traverse (traverseEdgeField f)) fields
|
||||||
|
|
||||||
|
traverseTableAggregateField
|
||||||
|
:: (Applicative f)
|
||||||
|
=> (a -> f b) -> TableAggregateFieldG a -> f (TableAggregateFieldG b)
|
||||||
|
traverseTableAggregateField f = \case
|
||||||
TAFAgg aggFlds -> pure $ TAFAgg aggFlds
|
TAFAgg aggFlds -> pure $ TAFAgg aggFlds
|
||||||
TAFNodes annFlds -> TAFNodes <$> traverseAnnFlds f annFlds
|
TAFNodes annFlds -> TAFNodes <$> traverseAnnFields f annFlds
|
||||||
TAFExp t -> pure $ TAFExp t
|
TAFExp t -> pure $ TAFExp t
|
||||||
|
|
||||||
type TableAggFld = TableAggFldG S.SQLExp
|
type TableAggregateField = TableAggregateFieldG S.SQLExp
|
||||||
type TableAggFldsG v = Fields (TableAggFldG v)
|
type TableAggregateFieldsG v = Fields (TableAggregateFieldG v)
|
||||||
type TableAggFlds = TableAggFldsG S.SQLExp
|
type TableAggregateFields = TableAggregateFieldsG S.SQLExp
|
||||||
|
|
||||||
data ArgumentExp a
|
data ArgumentExp a
|
||||||
= AETableRow !(Maybe Iden) -- ^ table row accessor
|
= AETableRow !(Maybe Iden) -- ^ table row accessor
|
||||||
| AEInput !a
|
| AEInput !a
|
||||||
deriving (Show, Eq, Functor, Foldable, Traversable)
|
deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
|
||||||
|
instance (Hashable v) => Hashable (ArgumentExp v)
|
||||||
|
|
||||||
type FunctionArgsExpTableRow v = FunctionArgsExpG (ArgumentExp v)
|
type FunctionArgsExpTableRow v = FunctionArgsExpG (ArgumentExp v)
|
||||||
|
|
||||||
@ -299,8 +355,10 @@ data SelectFromG v
|
|||||||
| FromIden !Iden
|
| FromIden !Iden
|
||||||
| FromFunction !QualifiedFunction
|
| FromFunction !QualifiedFunction
|
||||||
!(FunctionArgsExpTableRow v)
|
!(FunctionArgsExpTableRow v)
|
||||||
|
-- a definition list
|
||||||
!(Maybe [(PGCol, PGScalarType)])
|
!(Maybe [(PGCol, PGScalarType)])
|
||||||
deriving (Show, Eq, Functor, Foldable, Traversable)
|
deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
|
||||||
|
instance (Hashable v) => Hashable (SelectFromG v)
|
||||||
|
|
||||||
type SelectFrom = SelectFromG S.SQLExp
|
type SelectFrom = SelectFromG S.SQLExp
|
||||||
|
|
||||||
@ -308,7 +366,8 @@ data TablePermG v
|
|||||||
= TablePerm
|
= TablePerm
|
||||||
{ _tpFilter :: !(AnnBoolExp v)
|
{ _tpFilter :: !(AnnBoolExp v)
|
||||||
, _tpLimit :: !(Maybe Int)
|
, _tpLimit :: !(Maybe Int)
|
||||||
} deriving (Eq, Show)
|
} deriving (Eq, Show, Generic)
|
||||||
|
instance (Hashable v) => Hashable (TablePermG v)
|
||||||
|
|
||||||
traverseTablePerm
|
traverseTablePerm
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
@ -326,62 +385,105 @@ noTablePermissions =
|
|||||||
|
|
||||||
type TablePerm = TablePermG S.SQLExp
|
type TablePerm = TablePermG S.SQLExp
|
||||||
|
|
||||||
data AnnSelG a v
|
data AnnSelectG a v
|
||||||
= AnnSelG
|
= AnnSelectG
|
||||||
{ _asnFields :: !a
|
{ _asnFields :: !a
|
||||||
, _asnFrom :: !(SelectFromG v)
|
, _asnFrom :: !(SelectFromG v)
|
||||||
, _asnPerm :: !(TablePermG v)
|
, _asnPerm :: !(TablePermG v)
|
||||||
, _asnArgs :: !(TableArgsG v)
|
, _asnArgs :: !(SelectArgsG v)
|
||||||
, _asnStrfyNum :: !Bool
|
, _asnStrfyNum :: !Bool
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
getPermLimit :: AnnSelG a v -> Maybe Int
|
traverseAnnSimpleSelect
|
||||||
getPermLimit = _tpLimit . _asnPerm
|
|
||||||
|
|
||||||
traverseAnnSimpleSel
|
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b)
|
=> (a -> f b)
|
||||||
-> AnnSimpleSelG a -> f (AnnSimpleSelG b)
|
-> AnnSimpleSelG a -> f (AnnSimpleSelG b)
|
||||||
traverseAnnSimpleSel f = traverseAnnSel (traverseAnnFlds f) f
|
traverseAnnSimpleSelect f = traverseAnnSelect (traverseAnnFields f) f
|
||||||
|
|
||||||
traverseAnnAggSel
|
traverseAnnAggregateSelect
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b)
|
=> (a -> f b)
|
||||||
-> AnnAggSelG a -> f (AnnAggSelG b)
|
-> AnnAggregateSelectG a -> f (AnnAggregateSelectG b)
|
||||||
traverseAnnAggSel f =
|
traverseAnnAggregateSelect f =
|
||||||
traverseAnnSel (traverse (traverse (traverseTableAggFld f))) f
|
traverseAnnSelect (traverse (traverse (traverseTableAggregateField f))) f
|
||||||
|
|
||||||
traverseAnnSel
|
traverseAnnSelect
|
||||||
:: (Applicative f)
|
:: (Applicative f)
|
||||||
=> (a -> f b) -> (v -> f w)
|
=> (a -> f b) -> (v -> f w)
|
||||||
-> AnnSelG a v -> f (AnnSelG b w)
|
-> AnnSelectG a v -> f (AnnSelectG b w)
|
||||||
traverseAnnSel f1 f2 (AnnSelG flds tabFrom perm args strfyNum) =
|
traverseAnnSelect f1 f2 (AnnSelectG flds tabFrom perm args strfyNum) =
|
||||||
AnnSelG
|
AnnSelectG
|
||||||
<$> f1 flds
|
<$> f1 flds
|
||||||
<*> traverse f2 tabFrom
|
<*> traverse f2 tabFrom
|
||||||
<*> traverseTablePerm f2 perm
|
<*> traverseTablePerm f2 perm
|
||||||
<*> traverseTableArgs f2 args
|
<*> traverseSelectArgs f2 args
|
||||||
<*> pure strfyNum
|
<*> pure strfyNum
|
||||||
|
|
||||||
type AnnSimpleSelG v = AnnSelG (AnnFldsG v) v
|
type AnnSimpleSelG v = AnnSelectG (AnnFieldsG v) v
|
||||||
type AnnSimpleSel = AnnSimpleSelG S.SQLExp
|
type AnnSimpleSel = AnnSimpleSelG S.SQLExp
|
||||||
|
|
||||||
type AnnAggSelG v = AnnSelG (TableAggFldsG v) v
|
type AnnAggregateSelectG v = AnnSelectG (TableAggregateFieldsG v) v
|
||||||
type AnnAggSel = AnnAggSelG S.SQLExp
|
type AnnAggregateSelect = AnnAggregateSelectG S.SQLExp
|
||||||
|
|
||||||
|
data ConnectionSlice
|
||||||
|
= SliceFirst !Int
|
||||||
|
| SliceLast !Int
|
||||||
|
deriving (Show, Eq, Generic)
|
||||||
|
instance Hashable ConnectionSlice
|
||||||
|
|
||||||
|
data ConnectionSplitKind
|
||||||
|
= CSKBefore
|
||||||
|
| CSKAfter
|
||||||
|
deriving (Show, Eq, Generic)
|
||||||
|
instance Hashable ConnectionSplitKind
|
||||||
|
|
||||||
|
data ConnectionSplit v
|
||||||
|
= ConnectionSplit
|
||||||
|
{ _csKind :: !ConnectionSplitKind
|
||||||
|
, _csValue :: !v
|
||||||
|
, _csOrderBy :: !(OrderByItemG (AnnOrderByElementG ()))
|
||||||
|
} deriving (Show, Eq, Functor, Generic, Foldable, Traversable)
|
||||||
|
instance (Hashable v) => Hashable (ConnectionSplit v)
|
||||||
|
|
||||||
|
traverseConnectionSplit
|
||||||
|
:: (Applicative f)
|
||||||
|
=> (a -> f b) -> ConnectionSplit a -> f (ConnectionSplit b)
|
||||||
|
traverseConnectionSplit f (ConnectionSplit k v ob) =
|
||||||
|
ConnectionSplit k <$> f v <*> pure ob
|
||||||
|
|
||||||
|
data ConnectionSelect v
|
||||||
|
= ConnectionSelect
|
||||||
|
{ _csPrimaryKeyColumns :: !(NE.NonEmpty PGColumnInfo)
|
||||||
|
, _csSplit :: !(Maybe (NE.NonEmpty (ConnectionSplit v)))
|
||||||
|
, _csSlice :: !(Maybe ConnectionSlice)
|
||||||
|
, _csSelect :: !(AnnSelectG (ConnectionFields v) v)
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
traverseConnectionSelect
|
||||||
|
:: (Applicative f)
|
||||||
|
=> (a -> f b)
|
||||||
|
-> ConnectionSelect a -> f (ConnectionSelect b)
|
||||||
|
traverseConnectionSelect f (ConnectionSelect pkCols cSplit cSlice sel) =
|
||||||
|
ConnectionSelect pkCols
|
||||||
|
<$> traverse (traverse (traverseConnectionSplit f)) cSplit
|
||||||
|
<*> pure cSlice
|
||||||
|
<*> traverseAnnSelect (traverse (traverse (traverseConnectionField f))) f sel
|
||||||
|
|
||||||
data FunctionArgsExpG a
|
data FunctionArgsExpG a
|
||||||
= FunctionArgsExp
|
= FunctionArgsExp
|
||||||
{ _faePositional :: ![a]
|
{ _faePositional :: ![a]
|
||||||
, _faeNamed :: !(HM.HashMap Text a)
|
, _faeNamed :: !(HM.HashMap Text a)
|
||||||
} deriving (Show, Eq, Functor, Foldable, Traversable)
|
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
|
||||||
|
instance (Hashable a) => Hashable (FunctionArgsExpG a)
|
||||||
|
|
||||||
emptyFunctionArgsExp :: FunctionArgsExpG a
|
emptyFunctionArgsExp :: FunctionArgsExpG a
|
||||||
emptyFunctionArgsExp = FunctionArgsExp [] HM.empty
|
emptyFunctionArgsExp = FunctionArgsExp [] HM.empty
|
||||||
|
|
||||||
type FunctionArgExp = FunctionArgsExpG S.SQLExp
|
type FunctionArgExp = FunctionArgsExpG S.SQLExp
|
||||||
|
|
||||||
-- | If argument positional index is less than or equal to length of 'positional' arguments then
|
-- | If argument positional index is less than or equal to length of
|
||||||
-- insert the value in 'positional' arguments else insert the value with argument name in 'named' arguments
|
-- 'positional' arguments then insert the value in 'positional' arguments else
|
||||||
|
-- insert the value with argument name in 'named' arguments
|
||||||
insertFunctionArg
|
insertFunctionArg
|
||||||
:: FunctionArgName
|
:: FunctionArgName
|
||||||
-> Int
|
-> Int
|
||||||
@ -396,113 +498,106 @@ insertFunctionArg argName index value (FunctionArgsExp positional named) =
|
|||||||
where
|
where
|
||||||
insertAt i a = toList . Seq.insertAt i a . Seq.fromList
|
insertAt i a = toList . Seq.insertAt i a . Seq.fromList
|
||||||
|
|
||||||
data BaseNode
|
data SourcePrefixes
|
||||||
= BaseNode
|
= SourcePrefixes
|
||||||
{ _bnPrefix :: !Iden
|
{ _pfThis :: !Iden -- ^ Current source prefix
|
||||||
, _bnDistinct :: !(Maybe S.DistinctExpr)
|
, _pfBase :: !Iden
|
||||||
, _bnFrom :: !S.FromItem
|
-- ^ Base table source row identifier to generate
|
||||||
, _bnWhere :: !S.BoolExp
|
-- the table's column identifiers for computed field
|
||||||
, _bnOrderBy :: !(Maybe S.OrderByExp)
|
-- function input parameters
|
||||||
, _bnLimit :: !(Maybe Int)
|
} deriving (Show, Eq, Generic)
|
||||||
, _bnOffset :: !(Maybe S.SQLExp)
|
instance Hashable SourcePrefixes
|
||||||
|
|
||||||
, _bnExtrs :: !(HM.HashMap S.Alias S.SQLExp)
|
data SelectSource
|
||||||
, _bnObjs :: !(HM.HashMap RelName ObjNode)
|
= SelectSource
|
||||||
, _bnArrs :: !(HM.HashMap S.Alias ArrNode)
|
{ _ssPrefix :: !Iden
|
||||||
, _bnComputedFieldTables :: !(HM.HashMap FieldName CFTableNode)
|
, _ssFrom :: !S.FromItem
|
||||||
|
, _ssDistinct :: !(Maybe S.DistinctExpr)
|
||||||
|
, _ssWhere :: !S.BoolExp
|
||||||
|
, _ssOrderBy :: !(Maybe S.OrderByExp)
|
||||||
|
, _ssLimit :: !(Maybe Int)
|
||||||
|
, _ssOffset :: !(Maybe S.SQLExp)
|
||||||
|
} deriving (Show, Eq, Generic)
|
||||||
|
instance Hashable SelectSource
|
||||||
|
|
||||||
|
data SelectNode
|
||||||
|
= SelectNode
|
||||||
|
{ _snExtractors :: !(HM.HashMap S.Alias S.SQLExp)
|
||||||
|
, _snJoinTree :: !JoinTree
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
mergeBaseNodes :: BaseNode -> BaseNode -> BaseNode
|
instance Semigroup SelectNode where
|
||||||
mergeBaseNodes lNodeDet rNodeDet =
|
SelectNode lExtrs lJoinTree <> SelectNode rExtrs rJoinTree =
|
||||||
BaseNode pfx dExp f whr ordBy limit offset
|
SelectNode (lExtrs <> rExtrs) (lJoinTree <> rJoinTree)
|
||||||
(HM.union lExtrs rExtrs)
|
|
||||||
(HM.unionWith mergeObjNodes lObjs rObjs)
|
|
||||||
(HM.unionWith mergeArrNodes lArrs rArrs)
|
|
||||||
(HM.unionWith mergeCFTableNodes lCFTables rCFTables)
|
|
||||||
where
|
|
||||||
BaseNode pfx dExp f whr ordBy limit offset lExtrs lObjs lArrs lCFTables
|
|
||||||
= lNodeDet
|
|
||||||
BaseNode _ _ _ _ _ _ _ rExtrs rObjs rArrs rCFTables
|
|
||||||
= rNodeDet
|
|
||||||
|
|
||||||
data OrderByNode
|
data ObjectRelationSource
|
||||||
= OBNNothing
|
= ObjectRelationSource
|
||||||
| OBNObjNode !RelName !ObjNode
|
{ _orsRelationshipName :: !RelName
|
||||||
| OBNArrNode !S.Alias !ArrNode
|
, _orsRelationMapping :: !(HM.HashMap PGCol PGCol)
|
||||||
|
, _orsSelectSource :: !SelectSource
|
||||||
|
} deriving (Show, Eq, Generic)
|
||||||
|
instance Hashable ObjectRelationSource
|
||||||
|
|
||||||
|
data ArrayRelationSource
|
||||||
|
= ArrayRelationSource
|
||||||
|
{ _arsAlias :: !S.Alias
|
||||||
|
, _arsRelationMapping :: !(HM.HashMap PGCol PGCol)
|
||||||
|
, _arsSelectSource :: !SelectSource
|
||||||
|
} deriving (Show, Eq, Generic)
|
||||||
|
instance Hashable ArrayRelationSource
|
||||||
|
|
||||||
|
data ArraySelectNode
|
||||||
|
= ArraySelectNode
|
||||||
|
{ _asnTopExtractors :: ![S.Extractor]
|
||||||
|
, _asnSelectNode :: !SelectNode
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
instance Semigroup ArraySelectNode where
|
||||||
|
ArraySelectNode lTopExtrs lSelNode <> ArraySelectNode rTopExtrs rSelNode =
|
||||||
|
ArraySelectNode (lTopExtrs <> rTopExtrs) (lSelNode <> rSelNode)
|
||||||
|
|
||||||
|
data ComputedFieldTableSetSource
|
||||||
|
= ComputedFieldTableSetSource
|
||||||
|
{ _cftssFieldName :: !FieldName
|
||||||
|
, _cftssSelectType :: !JsonAggSelect
|
||||||
|
, _cftssSelectSource :: !SelectSource
|
||||||
|
} deriving (Show, Eq, Generic)
|
||||||
|
instance Hashable ComputedFieldTableSetSource
|
||||||
|
|
||||||
|
data ArrayConnectionSource
|
||||||
|
= ArrayConnectionSource
|
||||||
|
{ _acsAlias :: !S.Alias
|
||||||
|
, _acsRelationMapping :: !(HM.HashMap PGCol PGCol)
|
||||||
|
, _acsSplitFilter :: !(Maybe S.BoolExp)
|
||||||
|
, _acsSlice :: !(Maybe ConnectionSlice)
|
||||||
|
, _acsSource :: !SelectSource
|
||||||
|
} deriving (Show, Eq, Generic)
|
||||||
|
|
||||||
|
instance Hashable ArrayConnectionSource
|
||||||
|
|
||||||
|
data JoinTree
|
||||||
|
= JoinTree
|
||||||
|
{ _jtObjectRelations :: !(HM.HashMap ObjectRelationSource SelectNode)
|
||||||
|
, _jtArrayRelations :: !(HM.HashMap ArrayRelationSource ArraySelectNode)
|
||||||
|
, _jtArrayConnections :: !(HM.HashMap ArrayConnectionSource ArraySelectNode)
|
||||||
|
, _jtComputedFieldTableSets :: !(HM.HashMap ComputedFieldTableSetSource SelectNode)
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
instance Semigroup JoinTree where
|
||||||
|
JoinTree lObjs lArrs lArrConns lCfts <> JoinTree rObjs rArrs rArrConns rCfts =
|
||||||
|
JoinTree (HM.unionWith (<>) lObjs rObjs)
|
||||||
|
(HM.unionWith (<>) lArrs rArrs)
|
||||||
|
(HM.unionWith (<>) lArrConns rArrConns)
|
||||||
|
(HM.unionWith (<>) lCfts rCfts)
|
||||||
|
|
||||||
|
instance Monoid JoinTree where
|
||||||
|
mempty = JoinTree mempty mempty mempty mempty
|
||||||
|
|
||||||
|
data PermissionLimitSubQuery
|
||||||
|
= PLSQRequired !Int -- ^ Permission limit
|
||||||
|
| PLSQNotRequired
|
||||||
deriving (Show, Eq)
|
deriving (Show, Eq)
|
||||||
|
|
||||||
data ArrRelCtxG v
|
$(makeLenses ''AnnSelectG)
|
||||||
= ArrRelCtx
|
$(makePrisms ''AnnFieldG)
|
||||||
{ aacFields :: !(ArrSelFldsG v)
|
$(makePrisms ''AnnOrderByElementG)
|
||||||
, aacAggOrdBys :: ![RelName]
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
type ArrRelCtx = ArrRelCtxG S.SQLExp
|
|
||||||
|
|
||||||
emptyArrRelCtx :: ArrRelCtxG a
|
|
||||||
emptyArrRelCtx = ArrRelCtx [] []
|
|
||||||
|
|
||||||
data ArrNodeItemG v
|
|
||||||
= ANIField !(FieldName, ArrSelG v)
|
|
||||||
| ANIAggOrdBy !RelName
|
|
||||||
deriving (Show, Eq)
|
|
||||||
|
|
||||||
type ArrNodeItem = ArrNodeItemG S.SQLExp
|
|
||||||
|
|
||||||
data ObjNode
|
|
||||||
= ObjNode
|
|
||||||
{ _rnRelMapping :: !(HashMap PGCol PGCol)
|
|
||||||
, _rnNodeDet :: !BaseNode
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
mergeObjNodes :: ObjNode -> ObjNode -> ObjNode
|
|
||||||
mergeObjNodes lNode rNode =
|
|
||||||
ObjNode colMapping $ mergeBaseNodes lBN rBN
|
|
||||||
where
|
|
||||||
ObjNode colMapping lBN = lNode
|
|
||||||
ObjNode _ rBN = rNode
|
|
||||||
|
|
||||||
-- simple array select, aggregate select and order by
|
|
||||||
-- nodes differ in extractors
|
|
||||||
data ArrNode
|
|
||||||
= ArrNode
|
|
||||||
{ _anExtr :: ![S.Extractor]
|
|
||||||
, _anRelMapping :: !(HashMap PGCol PGCol)
|
|
||||||
, _anNodeDet :: !BaseNode
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
mergeArrNodes :: ArrNode -> ArrNode -> ArrNode
|
|
||||||
mergeArrNodes lNode rNode =
|
|
||||||
ArrNode (lExtrs `union` rExtrs) colMapping $
|
|
||||||
mergeBaseNodes lBN rBN
|
|
||||||
where
|
|
||||||
ArrNode lExtrs colMapping lBN = lNode
|
|
||||||
ArrNode rExtrs _ rBN = rNode
|
|
||||||
|
|
||||||
data ArrNodeInfo
|
|
||||||
= ArrNodeInfo
|
|
||||||
{ _aniAlias :: !S.Alias
|
|
||||||
, _aniPrefix :: !Iden
|
|
||||||
, _aniSubQueryRequired :: !Bool
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
-- | Node for computed field returning setof <table>
|
|
||||||
data CFTableNode
|
|
||||||
= CFTableNode
|
|
||||||
{ _ctnSelectType :: !JsonAggSelect
|
|
||||||
, _ctnNode :: !BaseNode
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
mergeCFTableNodes :: CFTableNode -> CFTableNode -> CFTableNode
|
|
||||||
mergeCFTableNodes lNode rNode =
|
|
||||||
CFTableNode
|
|
||||||
(_ctnSelectType rNode)
|
|
||||||
(mergeBaseNodes (_ctnNode lNode) (_ctnNode rNode))
|
|
||||||
|
|
||||||
data Prefixes
|
|
||||||
= Prefixes
|
|
||||||
{ _pfThis :: !Iden -- Current node prefix
|
|
||||||
, _pfBase :: !Iden -- Base table row identifier for computed field function
|
|
||||||
} deriving (Show, Eq)
|
|
||||||
|
|
||||||
$(makePrisms ''AnnFldG)
|
|
||||||
|
@ -55,9 +55,9 @@ import Hasura.RQL.DDL.Headers
|
|||||||
import Hasura.RQL.DML.Select.Types
|
import Hasura.RQL.DML.Select.Types
|
||||||
import Hasura.RQL.Types.CustomTypes
|
import Hasura.RQL.Types.CustomTypes
|
||||||
import Hasura.RQL.Types.Permission
|
import Hasura.RQL.Types.Permission
|
||||||
|
import Hasura.Session
|
||||||
import Hasura.SQL.Types
|
import Hasura.SQL.Types
|
||||||
import Language.Haskell.TH.Syntax (Lift)
|
import Language.Haskell.TH.Syntax (Lift)
|
||||||
import Hasura.Session
|
|
||||||
|
|
||||||
import qualified Data.Aeson as J
|
import qualified Data.Aeson as J
|
||||||
import qualified Data.Aeson.Casing as J
|
import qualified Data.Aeson.Casing as J
|
||||||
@ -273,7 +273,7 @@ data AnnActionExecution v
|
|||||||
= AnnActionExecution
|
= AnnActionExecution
|
||||||
{ _aaeName :: !ActionName
|
{ _aaeName :: !ActionName
|
||||||
, _aaeOutputType :: !GraphQLType -- ^ output type
|
, _aaeOutputType :: !GraphQLType -- ^ output type
|
||||||
, _aaeFields :: !(AnnFldsG v) -- ^ output selection
|
, _aaeFields :: !(AnnFieldsG v) -- ^ output selection
|
||||||
, _aaePayload :: !J.Value -- ^ jsonified input arguments
|
, _aaePayload :: !J.Value -- ^ jsonified input arguments
|
||||||
, _aaeOutputFields :: !ActionOutputFields
|
, _aaeOutputFields :: !ActionOutputFields
|
||||||
-- ^ to validate the response fields from webhook
|
-- ^ to validate the response fields from webhook
|
||||||
@ -292,7 +292,7 @@ data AnnActionMutationAsync
|
|||||||
|
|
||||||
data AsyncActionQueryFieldG v
|
data AsyncActionQueryFieldG v
|
||||||
= AsyncTypename !Text
|
= AsyncTypename !Text
|
||||||
| AsyncOutput !(AnnFldsG v)
|
| AsyncOutput !(AnnFieldsG v)
|
||||||
| AsyncId
|
| AsyncId
|
||||||
| AsyncCreatedAt
|
| AsyncCreatedAt
|
||||||
| AsyncErrors
|
| AsyncErrors
|
||||||
|
@ -66,6 +66,7 @@ data GExists a
|
|||||||
instance (NFData a) => NFData (GExists a)
|
instance (NFData a) => NFData (GExists a)
|
||||||
instance (Data a) => Plated (GExists a)
|
instance (Data a) => Plated (GExists a)
|
||||||
instance (Cacheable a) => Cacheable (GExists a)
|
instance (Cacheable a) => Cacheable (GExists a)
|
||||||
|
instance (Hashable a) => Hashable (GExists a)
|
||||||
|
|
||||||
gExistsToJSON :: (a -> (Text, Value)) -> GExists a -> Value
|
gExistsToJSON :: (a -> (Text, Value)) -> GExists a -> Value
|
||||||
gExistsToJSON f (GExists qt wh) =
|
gExistsToJSON f (GExists qt wh) =
|
||||||
@ -92,6 +93,7 @@ data GBoolExp a
|
|||||||
instance (NFData a) => NFData (GBoolExp a)
|
instance (NFData a) => NFData (GBoolExp a)
|
||||||
instance (Data a) => Plated (GBoolExp a)
|
instance (Data a) => Plated (GBoolExp a)
|
||||||
instance (Cacheable a) => Cacheable (GBoolExp a)
|
instance (Cacheable a) => Cacheable (GBoolExp a)
|
||||||
|
instance (Hashable a) => Hashable (GBoolExp a)
|
||||||
|
|
||||||
gBoolExpTrue :: GBoolExp a
|
gBoolExpTrue :: GBoolExp a
|
||||||
gBoolExpTrue = BoolAnd []
|
gBoolExpTrue = BoolAnd []
|
||||||
@ -143,6 +145,7 @@ data DWithinGeomOp a =
|
|||||||
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
||||||
instance (NFData a) => NFData (DWithinGeomOp a)
|
instance (NFData a) => NFData (DWithinGeomOp a)
|
||||||
instance (Cacheable a) => Cacheable (DWithinGeomOp a)
|
instance (Cacheable a) => Cacheable (DWithinGeomOp a)
|
||||||
|
instance (Hashable a) => Hashable (DWithinGeomOp a)
|
||||||
$(deriveJSON (aesonDrop 6 snakeCase) ''DWithinGeomOp)
|
$(deriveJSON (aesonDrop 6 snakeCase) ''DWithinGeomOp)
|
||||||
|
|
||||||
data DWithinGeogOp a =
|
data DWithinGeogOp a =
|
||||||
@ -153,6 +156,7 @@ data DWithinGeogOp a =
|
|||||||
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
||||||
instance (NFData a) => NFData (DWithinGeogOp a)
|
instance (NFData a) => NFData (DWithinGeogOp a)
|
||||||
instance (Cacheable a) => Cacheable (DWithinGeogOp a)
|
instance (Cacheable a) => Cacheable (DWithinGeogOp a)
|
||||||
|
instance (Hashable a) => Hashable (DWithinGeogOp a)
|
||||||
$(deriveJSON (aesonDrop 6 snakeCase) ''DWithinGeogOp)
|
$(deriveJSON (aesonDrop 6 snakeCase) ''DWithinGeogOp)
|
||||||
|
|
||||||
data STIntersectsNbandGeommin a =
|
data STIntersectsNbandGeommin a =
|
||||||
@ -162,6 +166,7 @@ data STIntersectsNbandGeommin a =
|
|||||||
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
||||||
instance (NFData a) => NFData (STIntersectsNbandGeommin a)
|
instance (NFData a) => NFData (STIntersectsNbandGeommin a)
|
||||||
instance (Cacheable a) => Cacheable (STIntersectsNbandGeommin a)
|
instance (Cacheable a) => Cacheable (STIntersectsNbandGeommin a)
|
||||||
|
instance (Hashable a) => Hashable (STIntersectsNbandGeommin a)
|
||||||
$(deriveJSON (aesonDrop 4 snakeCase) ''STIntersectsNbandGeommin)
|
$(deriveJSON (aesonDrop 4 snakeCase) ''STIntersectsNbandGeommin)
|
||||||
|
|
||||||
data STIntersectsGeomminNband a =
|
data STIntersectsGeomminNband a =
|
||||||
@ -171,6 +176,7 @@ data STIntersectsGeomminNband a =
|
|||||||
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
||||||
instance (NFData a) => NFData (STIntersectsGeomminNband a)
|
instance (NFData a) => NFData (STIntersectsGeomminNband a)
|
||||||
instance (Cacheable a) => Cacheable (STIntersectsGeomminNband a)
|
instance (Cacheable a) => Cacheable (STIntersectsGeomminNband a)
|
||||||
|
instance (Hashable a) => Hashable (STIntersectsGeomminNband a)
|
||||||
$(deriveJSON (aesonDrop 4 snakeCase) ''STIntersectsGeomminNband)
|
$(deriveJSON (aesonDrop 4 snakeCase) ''STIntersectsGeomminNband)
|
||||||
|
|
||||||
type CastExp a = M.HashMap PGScalarType [OpExpG a]
|
type CastExp a = M.HashMap PGScalarType [OpExpG a]
|
||||||
@ -230,6 +236,7 @@ data OpExpG a
|
|||||||
deriving (Eq, Show, Functor, Foldable, Traversable, Generic, Data)
|
deriving (Eq, Show, Functor, Foldable, Traversable, Generic, Data)
|
||||||
instance (NFData a) => NFData (OpExpG a)
|
instance (NFData a) => NFData (OpExpG a)
|
||||||
instance (Cacheable a) => Cacheable (OpExpG a)
|
instance (Cacheable a) => Cacheable (OpExpG a)
|
||||||
|
instance (Hashable a) => Hashable (OpExpG a)
|
||||||
|
|
||||||
opExpDepCol :: OpExpG a -> Maybe PGCol
|
opExpDepCol :: OpExpG a -> Maybe PGCol
|
||||||
opExpDepCol = \case
|
opExpDepCol = \case
|
||||||
@ -303,6 +310,7 @@ data AnnBoolExpFld a
|
|||||||
deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
|
deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
|
||||||
instance (NFData a) => NFData (AnnBoolExpFld a)
|
instance (NFData a) => NFData (AnnBoolExpFld a)
|
||||||
instance (Cacheable a) => Cacheable (AnnBoolExpFld a)
|
instance (Cacheable a) => Cacheable (AnnBoolExpFld a)
|
||||||
|
instance (Hashable a) => Hashable (AnnBoolExpFld a)
|
||||||
|
|
||||||
type AnnBoolExp a
|
type AnnBoolExp a
|
||||||
= GBoolExp (AnnBoolExpFld a)
|
= GBoolExp (AnnBoolExpFld a)
|
||||||
|
@ -143,6 +143,7 @@ data RelInfo
|
|||||||
} deriving (Show, Eq, Generic)
|
} deriving (Show, Eq, Generic)
|
||||||
instance NFData RelInfo
|
instance NFData RelInfo
|
||||||
instance Cacheable RelInfo
|
instance Cacheable RelInfo
|
||||||
|
instance Hashable RelInfo
|
||||||
$(deriveToJSON (aesonDrop 2 snakeCase) ''RelInfo)
|
$(deriveToJSON (aesonDrop 2 snakeCase) ''RelInfo)
|
||||||
|
|
||||||
newtype FieldName
|
newtype FieldName
|
||||||
@ -150,6 +151,7 @@ newtype FieldName
|
|||||||
deriving ( Show, Eq, Ord, Hashable, FromJSON, ToJSON
|
deriving ( Show, Eq, Ord, Hashable, FromJSON, ToJSON
|
||||||
, FromJSONKey, ToJSONKey, Lift, Data, Generic
|
, FromJSONKey, ToJSONKey, Lift, Data, Generic
|
||||||
, IsString, Arbitrary, NFData, Cacheable
|
, IsString, Arbitrary, NFData, Cacheable
|
||||||
|
, Semigroup
|
||||||
)
|
)
|
||||||
|
|
||||||
instance IsIden FieldName where
|
instance IsIden FieldName where
|
||||||
@ -212,7 +214,7 @@ data PrimaryKey a
|
|||||||
= PrimaryKey
|
= PrimaryKey
|
||||||
{ _pkConstraint :: !Constraint
|
{ _pkConstraint :: !Constraint
|
||||||
, _pkColumns :: !(NESeq a)
|
, _pkColumns :: !(NESeq a)
|
||||||
} deriving (Show, Eq, Generic)
|
} deriving (Show, Eq, Generic, Foldable)
|
||||||
instance (NFData a) => NFData (PrimaryKey a)
|
instance (NFData a) => NFData (PrimaryKey a)
|
||||||
instance (Cacheable a) => Cacheable (PrimaryKey a)
|
instance (Cacheable a) => Cacheable (PrimaryKey a)
|
||||||
$(makeLenses ''PrimaryKey)
|
$(makeLenses ''PrimaryKey)
|
||||||
|
@ -101,6 +101,7 @@ instance (FromJSON a) => FromJSON (DMLQuery a) where
|
|||||||
newtype OrderType
|
newtype OrderType
|
||||||
= OrderType { unOrderType :: S.OrderType }
|
= OrderType { unOrderType :: S.OrderType }
|
||||||
deriving (Show, Eq, Lift, Generic)
|
deriving (Show, Eq, Lift, Generic)
|
||||||
|
instance Hashable OrderType
|
||||||
|
|
||||||
instance FromJSON OrderType where
|
instance FromJSON OrderType where
|
||||||
parseJSON =
|
parseJSON =
|
||||||
@ -112,6 +113,7 @@ instance FromJSON OrderType where
|
|||||||
newtype NullsOrder
|
newtype NullsOrder
|
||||||
= NullsOrder { unNullsOrder :: S.NullsOrder }
|
= NullsOrder { unNullsOrder :: S.NullsOrder }
|
||||||
deriving (Show, Eq, Lift, Generic)
|
deriving (Show, Eq, Lift, Generic)
|
||||||
|
instance Hashable NullsOrder
|
||||||
|
|
||||||
instance FromJSON NullsOrder where
|
instance FromJSON NullsOrder where
|
||||||
parseJSON =
|
parseJSON =
|
||||||
@ -176,7 +178,8 @@ data OrderByItemG a
|
|||||||
{ obiType :: !(Maybe OrderType)
|
{ obiType :: !(Maybe OrderType)
|
||||||
, obiColumn :: !a
|
, obiColumn :: !a
|
||||||
, obiNulls :: !(Maybe NullsOrder)
|
, obiNulls :: !(Maybe NullsOrder)
|
||||||
} deriving (Show, Eq, Lift, Functor, Foldable, Traversable)
|
} deriving (Show, Eq, Lift, Functor, Foldable, Traversable, Generic)
|
||||||
|
instance (Hashable a) => Hashable (OrderByItemG a)
|
||||||
|
|
||||||
type OrderByItem = OrderByItemG OrderByCol
|
type OrderByItem = OrderByItemG OrderByCol
|
||||||
|
|
||||||
|
@ -133,8 +133,8 @@ import Hasura.RQL.Types.QueryCollection
|
|||||||
import Hasura.RQL.Types.RemoteSchema
|
import Hasura.RQL.Types.RemoteSchema
|
||||||
import Hasura.RQL.Types.SchemaCacheTypes
|
import Hasura.RQL.Types.SchemaCacheTypes
|
||||||
import Hasura.RQL.Types.Table
|
import Hasura.RQL.Types.Table
|
||||||
import Hasura.SQL.Types
|
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
|
import Hasura.SQL.Types
|
||||||
|
|
||||||
import Data.Aeson
|
import Data.Aeson
|
||||||
import Data.Aeson.Casing
|
import Data.Aeson.Casing
|
||||||
@ -198,18 +198,18 @@ type ActionCache = M.HashMap ActionName ActionInfo -- info of all actions
|
|||||||
|
|
||||||
data SchemaCache
|
data SchemaCache
|
||||||
= SchemaCache
|
= SchemaCache
|
||||||
{ scTables :: !TableCache
|
{ scTables :: !TableCache
|
||||||
, scActions :: !ActionCache
|
, scActions :: !ActionCache
|
||||||
, scFunctions :: !FunctionCache
|
, scFunctions :: !FunctionCache
|
||||||
, scRemoteSchemas :: !RemoteSchemaMap
|
, scRemoteSchemas :: !RemoteSchemaMap
|
||||||
, scAllowlist :: !(HS.HashSet GQLQuery)
|
, scAllowlist :: !(HS.HashSet GQLQuery)
|
||||||
, scGQLContext :: !(HashMap RoleName GQLContext)
|
, scGQLContext :: !(HashMap RoleName GQLContext)
|
||||||
, scUnauthenticatedGQLContext :: !GQLContext
|
, scUnauthenticatedGQLContext :: !GQLContext
|
||||||
, scRelayContext :: !(HashMap RoleName GQLContext)
|
, scRelayContext :: !(HashMap RoleName GQLContext)
|
||||||
, scUnauthenticatedRelayContext :: !GQLContext
|
, scUnauthenticatedRelayContext :: !GQLContext
|
||||||
-- , scCustomTypes :: !(NonObjectTypeMap, AnnotatedObjects)
|
-- , scCustomTypes :: !(NonObjectTypeMap, AnnotatedObjects)
|
||||||
, scDepMap :: !DepMap
|
, scDepMap :: !DepMap
|
||||||
, scInconsistentObjs :: ![InconsistentMetadata]
|
, scInconsistentObjs :: ![InconsistentMetadata]
|
||||||
}
|
}
|
||||||
$(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaCache)
|
$(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaCache)
|
||||||
|
|
||||||
|
@ -35,6 +35,7 @@ data Select
|
|||||||
} deriving (Show, Eq, Generic, Data)
|
} deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData Select
|
instance NFData Select
|
||||||
instance Cacheable Select
|
instance Cacheable Select
|
||||||
|
instance Hashable Select
|
||||||
|
|
||||||
mkSelect :: Select
|
mkSelect :: Select
|
||||||
mkSelect = Select Nothing [] Nothing
|
mkSelect = Select Nothing [] Nothing
|
||||||
@ -43,7 +44,7 @@ mkSelect = Select Nothing [] Nothing
|
|||||||
|
|
||||||
newtype LimitExp
|
newtype LimitExp
|
||||||
= LimitExp SQLExp
|
= LimitExp SQLExp
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL LimitExp where
|
instance ToSQL LimitExp where
|
||||||
toSQL (LimitExp se) =
|
toSQL (LimitExp se) =
|
||||||
@ -51,15 +52,15 @@ instance ToSQL LimitExp where
|
|||||||
|
|
||||||
newtype OffsetExp
|
newtype OffsetExp
|
||||||
= OffsetExp SQLExp
|
= OffsetExp SQLExp
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL OffsetExp where
|
instance ToSQL OffsetExp where
|
||||||
toSQL (OffsetExp se) =
|
toSQL (OffsetExp se) =
|
||||||
"OFFSET" <-> toSQL se
|
"OFFSET" <-> toSQL se
|
||||||
|
|
||||||
newtype OrderByExp
|
newtype OrderByExp
|
||||||
= OrderByExp [OrderByItem]
|
= OrderByExp (NonEmpty OrderByItem)
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
data OrderByItem
|
data OrderByItem
|
||||||
= OrderByItem
|
= OrderByItem
|
||||||
@ -69,6 +70,7 @@ data OrderByItem
|
|||||||
} deriving (Show, Eq, Generic, Data)
|
} deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData OrderByItem
|
instance NFData OrderByItem
|
||||||
instance Cacheable OrderByItem
|
instance Cacheable OrderByItem
|
||||||
|
instance Hashable OrderByItem
|
||||||
|
|
||||||
instance ToSQL OrderByItem where
|
instance ToSQL OrderByItem where
|
||||||
toSQL (OrderByItem e ot no) =
|
toSQL (OrderByItem e ot no) =
|
||||||
@ -78,6 +80,7 @@ data OrderType = OTAsc | OTDesc
|
|||||||
deriving (Show, Eq, Lift, Generic, Data)
|
deriving (Show, Eq, Lift, Generic, Data)
|
||||||
instance NFData OrderType
|
instance NFData OrderType
|
||||||
instance Cacheable OrderType
|
instance Cacheable OrderType
|
||||||
|
instance Hashable OrderType
|
||||||
|
|
||||||
instance ToSQL OrderType where
|
instance ToSQL OrderType where
|
||||||
toSQL OTAsc = "ASC"
|
toSQL OTAsc = "ASC"
|
||||||
@ -89,6 +92,7 @@ data NullsOrder
|
|||||||
deriving (Show, Eq, Lift, Generic, Data)
|
deriving (Show, Eq, Lift, Generic, Data)
|
||||||
instance NFData NullsOrder
|
instance NFData NullsOrder
|
||||||
instance Cacheable NullsOrder
|
instance Cacheable NullsOrder
|
||||||
|
instance Hashable NullsOrder
|
||||||
|
|
||||||
instance ToSQL NullsOrder where
|
instance ToSQL NullsOrder where
|
||||||
toSQL NFirst = "NULLS FIRST"
|
toSQL NFirst = "NULLS FIRST"
|
||||||
@ -96,11 +100,11 @@ instance ToSQL NullsOrder where
|
|||||||
|
|
||||||
instance ToSQL OrderByExp where
|
instance ToSQL OrderByExp where
|
||||||
toSQL (OrderByExp l) =
|
toSQL (OrderByExp l) =
|
||||||
"ORDER BY" <-> (", " <+> l)
|
"ORDER BY" <-> (", " <+> toList l)
|
||||||
|
|
||||||
newtype GroupByExp
|
newtype GroupByExp
|
||||||
= GroupByExp [SQLExp]
|
= GroupByExp [SQLExp]
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL GroupByExp where
|
instance ToSQL GroupByExp where
|
||||||
toSQL (GroupByExp idens) =
|
toSQL (GroupByExp idens) =
|
||||||
@ -108,7 +112,7 @@ instance ToSQL GroupByExp where
|
|||||||
|
|
||||||
newtype FromExp
|
newtype FromExp
|
||||||
= FromExp [FromItem]
|
= FromExp [FromItem]
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL FromExp where
|
instance ToSQL FromExp where
|
||||||
toSQL (FromExp items) =
|
toSQL (FromExp items) =
|
||||||
@ -148,7 +152,7 @@ mkRowExp extrs = let
|
|||||||
|
|
||||||
newtype HavingExp
|
newtype HavingExp
|
||||||
= HavingExp BoolExp
|
= HavingExp BoolExp
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL HavingExp where
|
instance ToSQL HavingExp where
|
||||||
toSQL (HavingExp be) =
|
toSQL (HavingExp be) =
|
||||||
@ -156,7 +160,7 @@ instance ToSQL HavingExp where
|
|||||||
|
|
||||||
newtype WhereFrag
|
newtype WhereFrag
|
||||||
= WhereFrag { getWFBoolExp :: BoolExp }
|
= WhereFrag { getWFBoolExp :: BoolExp }
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL WhereFrag where
|
instance ToSQL WhereFrag where
|
||||||
toSQL (WhereFrag be) =
|
toSQL (WhereFrag be) =
|
||||||
@ -188,6 +192,7 @@ data Qual
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData Qual
|
instance NFData Qual
|
||||||
instance Cacheable Qual
|
instance Cacheable Qual
|
||||||
|
instance Hashable Qual
|
||||||
|
|
||||||
mkQual :: QualifiedTable -> Qual
|
mkQual :: QualifiedTable -> Qual
|
||||||
mkQual = QualTable
|
mkQual = QualTable
|
||||||
@ -205,6 +210,7 @@ data QIden
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData QIden
|
instance NFData QIden
|
||||||
instance Cacheable QIden
|
instance Cacheable QIden
|
||||||
|
instance Hashable QIden
|
||||||
|
|
||||||
instance ToSQL QIden where
|
instance ToSQL QIden where
|
||||||
toSQL (QIden qual iden) =
|
toSQL (QIden qual iden) =
|
||||||
@ -212,7 +218,7 @@ instance ToSQL QIden where
|
|||||||
|
|
||||||
newtype SQLOp
|
newtype SQLOp
|
||||||
= SQLOp {sqlOpTxt :: T.Text}
|
= SQLOp {sqlOpTxt :: T.Text}
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
incOp :: SQLOp
|
incOp :: SQLOp
|
||||||
incOp = SQLOp "+"
|
incOp = SQLOp "+"
|
||||||
@ -234,7 +240,7 @@ jsonbDeleteAtPathOp = SQLOp "#-"
|
|||||||
|
|
||||||
newtype TypeAnn
|
newtype TypeAnn
|
||||||
= TypeAnn { unTypeAnn :: T.Text }
|
= TypeAnn { unTypeAnn :: T.Text }
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL TypeAnn where
|
instance ToSQL TypeAnn where
|
||||||
toSQL (TypeAnn ty) = "::" <> TB.text ty
|
toSQL (TypeAnn ty) = "::" <> TB.text ty
|
||||||
@ -260,6 +266,9 @@ jsonTypeAnn = mkTypeAnn $ PGTypeScalar PGJSON
|
|||||||
jsonbTypeAnn :: TypeAnn
|
jsonbTypeAnn :: TypeAnn
|
||||||
jsonbTypeAnn = mkTypeAnn $ PGTypeScalar PGJSONB
|
jsonbTypeAnn = mkTypeAnn $ PGTypeScalar PGJSONB
|
||||||
|
|
||||||
|
boolTypeAnn :: TypeAnn
|
||||||
|
boolTypeAnn = mkTypeAnn $ PGTypeScalar PGBoolean
|
||||||
|
|
||||||
data CountType
|
data CountType
|
||||||
= CTStar
|
= CTStar
|
||||||
| CTSimple ![PGCol]
|
| CTSimple ![PGCol]
|
||||||
@ -267,6 +276,7 @@ data CountType
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData CountType
|
instance NFData CountType
|
||||||
instance Cacheable CountType
|
instance Cacheable CountType
|
||||||
|
instance Hashable CountType
|
||||||
|
|
||||||
instance ToSQL CountType where
|
instance ToSQL CountType where
|
||||||
toSQL CTStar = "*"
|
toSQL CTStar = "*"
|
||||||
@ -277,7 +287,7 @@ instance ToSQL CountType where
|
|||||||
|
|
||||||
newtype TupleExp
|
newtype TupleExp
|
||||||
= TupleExp [SQLExp]
|
= TupleExp [SQLExp]
|
||||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL TupleExp where
|
instance ToSQL TupleExp where
|
||||||
toSQL (TupleExp exps) =
|
toSQL (TupleExp exps) =
|
||||||
@ -302,6 +312,7 @@ data SQLExp
|
|||||||
| SEBool !BoolExp
|
| SEBool !BoolExp
|
||||||
| SEExcluded !Iden
|
| SEExcluded !Iden
|
||||||
| SEArray ![SQLExp]
|
| SEArray ![SQLExp]
|
||||||
|
| SEArrayIndex !SQLExp !SQLExp
|
||||||
| SETuple !TupleExp
|
| SETuple !TupleExp
|
||||||
| SECount !CountType
|
| SECount !CountType
|
||||||
| SENamedArg !Iden !SQLExp
|
| SENamedArg !Iden !SQLExp
|
||||||
@ -309,6 +320,7 @@ data SQLExp
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData SQLExp
|
instance NFData SQLExp
|
||||||
instance Cacheable SQLExp
|
instance Cacheable SQLExp
|
||||||
|
instance Hashable SQLExp
|
||||||
|
|
||||||
withTyAnn :: PGScalarType -> SQLExp -> SQLExp
|
withTyAnn :: PGScalarType -> SQLExp -> SQLExp
|
||||||
withTyAnn colTy v = SETyAnn v . mkTypeAnn $ PGTypeScalar colTy
|
withTyAnn colTy v = SETyAnn v . mkTypeAnn $ PGTypeScalar colTy
|
||||||
@ -318,7 +330,7 @@ instance J.ToJSON SQLExp where
|
|||||||
|
|
||||||
newtype Alias
|
newtype Alias
|
||||||
= Alias { getAlias :: Iden }
|
= Alias { getAlias :: Iden }
|
||||||
deriving (Show, Eq, NFData, Hashable, Data, Cacheable)
|
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||||
|
|
||||||
instance IsIden Alias where
|
instance IsIden Alias where
|
||||||
toIden (Alias iden) = iden
|
toIden (Alias iden) = iden
|
||||||
@ -370,6 +382,9 @@ instance ToSQL SQLExp where
|
|||||||
<> toSQL i
|
<> toSQL i
|
||||||
toSQL (SEArray exps) = "ARRAY" <> TB.char '['
|
toSQL (SEArray exps) = "ARRAY" <> TB.char '['
|
||||||
<> (", " <+> exps) <> TB.char ']'
|
<> (", " <+> exps) <> TB.char ']'
|
||||||
|
toSQL (SEArrayIndex arrayExp indexExp) =
|
||||||
|
paren (toSQL arrayExp)
|
||||||
|
<> TB.char '[' <> toSQL indexExp <> TB.char ']'
|
||||||
toSQL (SETuple tup) = toSQL tup
|
toSQL (SETuple tup) = toSQL tup
|
||||||
toSQL (SECount ty) = "COUNT" <> paren (toSQL ty)
|
toSQL (SECount ty) = "COUNT" <> paren (toSQL ty)
|
||||||
-- https://www.postgresql.org/docs/current/sql-syntax-calling-funcs.html
|
-- https://www.postgresql.org/docs/current/sql-syntax-calling-funcs.html
|
||||||
@ -384,6 +399,7 @@ data Extractor = Extractor !SQLExp !(Maybe Alias)
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData Extractor
|
instance NFData Extractor
|
||||||
instance Cacheable Extractor
|
instance Cacheable Extractor
|
||||||
|
instance Hashable Extractor
|
||||||
|
|
||||||
mkSQLOpExp
|
mkSQLOpExp
|
||||||
:: SQLOp
|
:: SQLOp
|
||||||
@ -431,6 +447,7 @@ data DistinctExpr
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData DistinctExpr
|
instance NFData DistinctExpr
|
||||||
instance Cacheable DistinctExpr
|
instance Cacheable DistinctExpr
|
||||||
|
instance Hashable DistinctExpr
|
||||||
|
|
||||||
instance ToSQL DistinctExpr where
|
instance ToSQL DistinctExpr where
|
||||||
toSQL DistinctSimple = "DISTINCT"
|
toSQL DistinctSimple = "DISTINCT"
|
||||||
@ -444,6 +461,7 @@ data FunctionArgs
|
|||||||
} deriving (Show, Eq, Generic, Data)
|
} deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData FunctionArgs
|
instance NFData FunctionArgs
|
||||||
instance Cacheable FunctionArgs
|
instance Cacheable FunctionArgs
|
||||||
|
instance Hashable FunctionArgs
|
||||||
|
|
||||||
instance ToSQL FunctionArgs where
|
instance ToSQL FunctionArgs where
|
||||||
toSQL (FunctionArgs positionalArgs namedArgsMap) =
|
toSQL (FunctionArgs positionalArgs namedArgsMap) =
|
||||||
@ -458,6 +476,7 @@ data DefinitionListItem
|
|||||||
} deriving (Show, Eq, Data, Generic)
|
} deriving (Show, Eq, Data, Generic)
|
||||||
instance NFData DefinitionListItem
|
instance NFData DefinitionListItem
|
||||||
instance Cacheable DefinitionListItem
|
instance Cacheable DefinitionListItem
|
||||||
|
instance Hashable DefinitionListItem
|
||||||
|
|
||||||
instance ToSQL DefinitionListItem where
|
instance ToSQL DefinitionListItem where
|
||||||
toSQL (DefinitionListItem column columnType) =
|
toSQL (DefinitionListItem column columnType) =
|
||||||
@ -470,6 +489,7 @@ data FunctionAlias
|
|||||||
} deriving (Show, Eq, Data, Generic)
|
} deriving (Show, Eq, Data, Generic)
|
||||||
instance NFData FunctionAlias
|
instance NFData FunctionAlias
|
||||||
instance Cacheable FunctionAlias
|
instance Cacheable FunctionAlias
|
||||||
|
instance Hashable FunctionAlias
|
||||||
|
|
||||||
mkSimpleFunctionAlias :: Iden -> FunctionAlias
|
mkSimpleFunctionAlias :: Iden -> FunctionAlias
|
||||||
mkSimpleFunctionAlias identifier =
|
mkSimpleFunctionAlias identifier =
|
||||||
@ -494,6 +514,7 @@ data FunctionExp
|
|||||||
} deriving (Show, Eq, Generic, Data)
|
} deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData FunctionExp
|
instance NFData FunctionExp
|
||||||
instance Cacheable FunctionExp
|
instance Cacheable FunctionExp
|
||||||
|
instance Hashable FunctionExp
|
||||||
|
|
||||||
instance ToSQL FunctionExp where
|
instance ToSQL FunctionExp where
|
||||||
toSQL (FunctionExp qf args alsM) =
|
toSQL (FunctionExp qf args alsM) =
|
||||||
@ -505,11 +526,13 @@ data FromItem
|
|||||||
| FIFunc !FunctionExp
|
| FIFunc !FunctionExp
|
||||||
| FIUnnest ![SQLExp] !Alias ![SQLExp]
|
| FIUnnest ![SQLExp] !Alias ![SQLExp]
|
||||||
| FISelect !Lateral !Select !Alias
|
| FISelect !Lateral !Select !Alias
|
||||||
|
| FISelectWith !Lateral !(SelectWithG Select) !Alias
|
||||||
| FIValues !ValuesExp !Alias !(Maybe [PGCol])
|
| FIValues !ValuesExp !Alias !(Maybe [PGCol])
|
||||||
| FIJoin !JoinExpr
|
| FIJoin !JoinExpr
|
||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData FromItem
|
instance NFData FromItem
|
||||||
instance Cacheable FromItem
|
instance Cacheable FromItem
|
||||||
|
instance Hashable FromItem
|
||||||
|
|
||||||
mkSelFromItem :: Select -> Alias -> FromItem
|
mkSelFromItem :: Select -> Alias -> FromItem
|
||||||
mkSelFromItem = FISelect (Lateral False)
|
mkSelFromItem = FISelect (Lateral False)
|
||||||
@ -532,6 +555,8 @@ instance ToSQL FromItem where
|
|||||||
"UNNEST" <> paren (", " <+> args) <-> toSQL als <> paren (", " <+> cols)
|
"UNNEST" <> paren (", " <+> args) <-> toSQL als <> paren (", " <+> cols)
|
||||||
toSQL (FISelect mla sel al) =
|
toSQL (FISelect mla sel al) =
|
||||||
toSQL mla <-> paren (toSQL sel) <-> toSQL al
|
toSQL mla <-> paren (toSQL sel) <-> toSQL al
|
||||||
|
toSQL (FISelectWith mla selWith al) =
|
||||||
|
toSQL mla <-> paren (toSQL selWith) <-> toSQL al
|
||||||
toSQL (FIValues valsExp al mCols) =
|
toSQL (FIValues valsExp al mCols) =
|
||||||
paren (toSQL valsExp) <-> toSQL al
|
paren (toSQL valsExp) <-> toSQL al
|
||||||
<-> toSQL (toColTupExp <$> mCols)
|
<-> toSQL (toColTupExp <$> mCols)
|
||||||
@ -539,7 +564,7 @@ instance ToSQL FromItem where
|
|||||||
toSQL je
|
toSQL je
|
||||||
|
|
||||||
newtype Lateral = Lateral Bool
|
newtype Lateral = Lateral Bool
|
||||||
deriving (Show, Eq, Data, NFData, Cacheable)
|
deriving (Show, Eq, Data, NFData, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL Lateral where
|
instance ToSQL Lateral where
|
||||||
toSQL (Lateral True) = "LATERAL"
|
toSQL (Lateral True) = "LATERAL"
|
||||||
@ -554,6 +579,7 @@ data JoinExpr
|
|||||||
} deriving (Show, Eq, Generic, Data)
|
} deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData JoinExpr
|
instance NFData JoinExpr
|
||||||
instance Cacheable JoinExpr
|
instance Cacheable JoinExpr
|
||||||
|
instance Hashable JoinExpr
|
||||||
|
|
||||||
instance ToSQL JoinExpr where
|
instance ToSQL JoinExpr where
|
||||||
toSQL je =
|
toSQL je =
|
||||||
@ -570,6 +596,7 @@ data JoinType
|
|||||||
deriving (Eq, Show, Generic, Data)
|
deriving (Eq, Show, Generic, Data)
|
||||||
instance NFData JoinType
|
instance NFData JoinType
|
||||||
instance Cacheable JoinType
|
instance Cacheable JoinType
|
||||||
|
instance Hashable JoinType
|
||||||
|
|
||||||
instance ToSQL JoinType where
|
instance ToSQL JoinType where
|
||||||
toSQL Inner = "INNER JOIN"
|
toSQL Inner = "INNER JOIN"
|
||||||
@ -583,6 +610,7 @@ data JoinCond
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData JoinCond
|
instance NFData JoinCond
|
||||||
instance Cacheable JoinCond
|
instance Cacheable JoinCond
|
||||||
|
instance Hashable JoinCond
|
||||||
|
|
||||||
instance ToSQL JoinCond where
|
instance ToSQL JoinCond where
|
||||||
toSQL (JoinOn be) =
|
toSQL (JoinOn be) =
|
||||||
@ -606,6 +634,7 @@ data BoolExp
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData BoolExp
|
instance NFData BoolExp
|
||||||
instance Cacheable BoolExp
|
instance Cacheable BoolExp
|
||||||
|
instance Hashable BoolExp
|
||||||
|
|
||||||
-- removes extraneous 'AND true's
|
-- removes extraneous 'AND true's
|
||||||
simplifyBoolExp :: BoolExp -> BoolExp
|
simplifyBoolExp :: BoolExp -> BoolExp
|
||||||
@ -661,6 +690,7 @@ data BinOp = AndOp | OrOp
|
|||||||
deriving (Show, Eq, Generic, Data)
|
deriving (Show, Eq, Generic, Data)
|
||||||
instance NFData BinOp
|
instance NFData BinOp
|
||||||
instance Cacheable BinOp
|
instance Cacheable BinOp
|
||||||
|
instance Hashable BinOp
|
||||||
|
|
||||||
instance ToSQL BinOp where
|
instance ToSQL BinOp where
|
||||||
toSQL AndOp = "AND"
|
toSQL AndOp = "AND"
|
||||||
@ -689,6 +719,7 @@ data CompareOp
|
|||||||
deriving (Eq, Generic, Data)
|
deriving (Eq, Generic, Data)
|
||||||
instance NFData CompareOp
|
instance NFData CompareOp
|
||||||
instance Cacheable CompareOp
|
instance Cacheable CompareOp
|
||||||
|
instance Hashable CompareOp
|
||||||
|
|
||||||
instance Show CompareOp where
|
instance Show CompareOp where
|
||||||
show = \case
|
show = \case
|
||||||
@ -835,7 +866,7 @@ instance ToSQL SQLConflict where
|
|||||||
|
|
||||||
newtype ValuesExp
|
newtype ValuesExp
|
||||||
= ValuesExp [TupleExp]
|
= ValuesExp [TupleExp]
|
||||||
deriving (Show, Eq, Data, NFData, Cacheable)
|
deriving (Show, Eq, Data, NFData, Cacheable, Hashable)
|
||||||
|
|
||||||
instance ToSQL ValuesExp where
|
instance ToSQL ValuesExp where
|
||||||
toSQL (ValuesExp tuples) =
|
toSQL (ValuesExp tuples) =
|
||||||
@ -874,14 +905,20 @@ instance ToSQL CTE where
|
|||||||
CTEUpdate q -> toSQL q
|
CTEUpdate q -> toSQL q
|
||||||
CTEDelete q -> toSQL q
|
CTEDelete q -> toSQL q
|
||||||
|
|
||||||
data SelectWith
|
data SelectWithG v
|
||||||
= SelectWith
|
= SelectWith
|
||||||
{ swCTEs :: [(Alias, CTE)]
|
{ swCTEs :: ![(Alias, v)]
|
||||||
, swSelect :: !Select
|
, swSelect :: !Select
|
||||||
} deriving (Show, Eq)
|
} deriving (Show, Eq, Generic, Data)
|
||||||
|
|
||||||
instance ToSQL SelectWith where
|
instance (NFData v) => NFData (SelectWithG v)
|
||||||
|
instance (Cacheable v) => Cacheable (SelectWithG v)
|
||||||
|
instance (Hashable v) => Hashable (SelectWithG v)
|
||||||
|
|
||||||
|
instance (ToSQL v) => ToSQL (SelectWithG v) where
|
||||||
toSQL (SelectWith ctes sel) =
|
toSQL (SelectWith ctes sel) =
|
||||||
"WITH " <> (", " <+> map f ctes) <-> toSQL sel
|
"WITH " <> (", " <+> map f ctes) <-> toSQL sel
|
||||||
where
|
where
|
||||||
f (Alias al, q) = toSQL al <-> "AS" <-> paren (toSQL q)
|
f (Alias al, q) = toSQL al <-> "AS" <-> paren (toSQL q)
|
||||||
|
|
||||||
|
type SelectWith = SelectWithG CTE
|
||||||
|
@ -1,5 +1,6 @@
|
|||||||
module Hasura.SQL.Rewrite
|
module Hasura.SQL.Rewrite
|
||||||
( prefixNumToAliases
|
( prefixNumToAliases
|
||||||
|
, prefixNumToAliasesSelectWith
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import qualified Data.HashMap.Strict as Map
|
import qualified Data.HashMap.Strict as Map
|
||||||
@ -20,6 +21,11 @@ prefixNumToAliases :: S.Select -> S.Select
|
|||||||
prefixNumToAliases s =
|
prefixNumToAliases s =
|
||||||
uSelect s `evalState` UniqSt 0 Map.empty
|
uSelect s `evalState` UniqSt 0 Map.empty
|
||||||
|
|
||||||
|
prefixNumToAliasesSelectWith
|
||||||
|
:: S.SelectWithG S.Select -> S.SelectWithG S.Select
|
||||||
|
prefixNumToAliasesSelectWith s =
|
||||||
|
uSelectWith s `evalState` UniqSt 0 Map.empty
|
||||||
|
|
||||||
type Rewrite a = State a
|
type Rewrite a = State a
|
||||||
|
|
||||||
data UniqSt
|
data UniqSt
|
||||||
@ -56,6 +62,12 @@ restoringIdens action = do
|
|||||||
modify' $ \s -> s { _uqIdens = idens }
|
modify' $ \s -> s { _uqIdens = idens }
|
||||||
return res
|
return res
|
||||||
|
|
||||||
|
uSelectWith :: S.SelectWithG S.Select -> Uniq (S.SelectWithG S.Select)
|
||||||
|
uSelectWith (S.SelectWith ctes baseSelect) =
|
||||||
|
S.SelectWith
|
||||||
|
<$> forM ctes (\(als, sel) -> (als,) <$> restoringIdens (uSelect sel))
|
||||||
|
<*> uSelect baseSelect
|
||||||
|
|
||||||
uSelect :: S.Select -> Uniq S.Select
|
uSelect :: S.Select -> Uniq S.Select
|
||||||
uSelect sel = do
|
uSelect sel = do
|
||||||
-- this has to be the first thing to process
|
-- this has to be the first thing to process
|
||||||
@ -113,6 +125,10 @@ uFromItem fromItem = case fromItem of
|
|||||||
newSel <- restoringIdens $ uSelect sel
|
newSel <- restoringIdens $ uSelect sel
|
||||||
newAls <- addAlias al
|
newAls <- addAlias al
|
||||||
return $ S.FISelect isLateral newSel newAls
|
return $ S.FISelect isLateral newSel newAls
|
||||||
|
S.FISelectWith isLateral selectWith al -> do
|
||||||
|
newSelectWith <- uSelectWith selectWith
|
||||||
|
newAls <- addAlias al
|
||||||
|
return $ S.FISelectWith isLateral newSelectWith newAls
|
||||||
S.FIValues (S.ValuesExp tups) als mCols -> do
|
S.FIValues (S.ValuesExp tups) als mCols -> do
|
||||||
newValExp <- fmap S.ValuesExp $
|
newValExp <- fmap S.ValuesExp $
|
||||||
forM tups $ \(S.TupleExp ts) ->
|
forM tups $ \(S.TupleExp ts) ->
|
||||||
@ -196,8 +212,10 @@ uSqlExp = restoringIdens . \case
|
|||||||
S.SEExcluded <$> return t
|
S.SEExcluded <$> return t
|
||||||
S.SEArray l ->
|
S.SEArray l ->
|
||||||
S.SEArray <$> mapM uSqlExp l
|
S.SEArray <$> mapM uSqlExp l
|
||||||
|
S.SEArrayIndex arrayExp indexExp ->
|
||||||
|
S.SEArrayIndex <$> uSqlExp arrayExp <*> uSqlExp indexExp
|
||||||
S.SETuple (S.TupleExp l) ->
|
S.SETuple (S.TupleExp l) ->
|
||||||
S.SEArray <$> mapM uSqlExp l
|
S.SETuple . S.TupleExp <$> mapM uSqlExp l
|
||||||
S.SECount cty -> return $ S.SECount cty
|
S.SECount cty -> return $ S.SECount cty
|
||||||
S.SENamedArg arg val -> S.SENamedArg arg <$> uSqlExp val
|
S.SENamedArg arg val -> S.SENamedArg arg <$> uSqlExp val
|
||||||
S.SEFunction funcExp -> S.SEFunction <$> uFunctionExp funcExp
|
S.SEFunction funcExp -> S.SEFunction <$> uFunctionExp funcExp
|
||||||
|
@ -3,68 +3,68 @@
|
|||||||
module Hasura.Server.App where
|
module Hasura.Server.App where
|
||||||
|
|
||||||
import Control.Concurrent.MVar.Lifted
|
import Control.Concurrent.MVar.Lifted
|
||||||
import Control.Exception (IOException, try)
|
import Control.Exception (IOException, try)
|
||||||
import Control.Lens (view, _2)
|
import Control.Lens (view, _2)
|
||||||
import Control.Monad.Stateless
|
import Control.Monad.Stateless
|
||||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||||
import Data.Aeson hiding (json)
|
import Data.Aeson hiding (json)
|
||||||
import Data.Either (isRight)
|
import Data.Either (isRight)
|
||||||
import Data.Int (Int64)
|
import Data.Int (Int64)
|
||||||
import Data.IORef
|
import Data.IORef
|
||||||
import Data.Time.Clock (UTCTime)
|
import Data.Time.Clock (UTCTime)
|
||||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||||
import Network.Mime (defaultMimeLookup)
|
import Network.Mime (defaultMimeLookup)
|
||||||
import System.Exit (exitFailure)
|
import System.Exit (exitFailure)
|
||||||
import System.FilePath (joinPath, takeFileName)
|
import System.FilePath (joinPath, takeFileName)
|
||||||
import Web.Spock.Core ((<//>))
|
import Web.Spock.Core ((<//>))
|
||||||
|
|
||||||
import qualified Control.Concurrent.Async.Lifted.Safe as LA
|
import qualified Control.Concurrent.Async.Lifted.Safe as LA
|
||||||
import qualified Data.ByteString.Lazy as BL
|
import qualified Data.ByteString.Lazy as BL
|
||||||
import qualified Data.CaseInsensitive as CI
|
import qualified Data.CaseInsensitive as CI
|
||||||
import qualified Data.HashMap.Strict as M
|
import qualified Data.HashMap.Strict as M
|
||||||
import qualified Data.HashSet as S
|
import qualified Data.HashSet as S
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Database.PG.Query as Q
|
import qualified Database.PG.Query as Q
|
||||||
import qualified Network.HTTP.Client as HTTP
|
import qualified Network.HTTP.Client as HTTP
|
||||||
import qualified Network.HTTP.Types as HTTP
|
import qualified Network.HTTP.Types as HTTP
|
||||||
import qualified Network.Wai as Wai
|
import qualified Network.Wai as Wai
|
||||||
import qualified Network.Wai.Handler.WebSockets as WS
|
import qualified Network.Wai.Handler.WebSockets as WS
|
||||||
import qualified Network.WebSockets as WS
|
import qualified Network.WebSockets as WS
|
||||||
import qualified System.Metrics as EKG
|
import qualified System.Metrics as EKG
|
||||||
import qualified System.Metrics.Json as EKG
|
import qualified System.Metrics.Json as EKG
|
||||||
import qualified Text.Mustache as M
|
import qualified Text.Mustache as M
|
||||||
import qualified Web.Spock.Core as Spock
|
import qualified Web.Spock.Core as Spock
|
||||||
|
|
||||||
import Hasura.EncJSON
|
import Hasura.EncJSON
|
||||||
-- import Hasura.GraphQL.Resolve.Action
|
-- import Hasura.GraphQL.Resolve.Action
|
||||||
import Hasura.GraphQL.Logging (MonadQueryLog (..))
|
import Hasura.GraphQL.Logging (MonadQueryLog (..))
|
||||||
import Hasura.HTTP
|
import Hasura.HTTP
|
||||||
import Hasura.Prelude hiding (get, put)
|
import Hasura.Prelude hiding (get, put)
|
||||||
import Hasura.RQL.DDL.Schema
|
import Hasura.RQL.DDL.Schema
|
||||||
import Hasura.RQL.Types
|
import Hasura.RQL.Types
|
||||||
import Hasura.RQL.Types.Run
|
import Hasura.RQL.Types.Run
|
||||||
import Hasura.Server.API.Config (runGetConfig)
|
import Hasura.Server.API.Config (runGetConfig)
|
||||||
import Hasura.Server.API.Query
|
import Hasura.Server.API.Query
|
||||||
import Hasura.Server.Auth (AuthMode (..), UserAuthentication (..))
|
import Hasura.Server.Auth (AuthMode (..), UserAuthentication (..))
|
||||||
import Hasura.Server.Compression
|
import Hasura.Server.Compression
|
||||||
import Hasura.Server.Cors
|
import Hasura.Server.Cors
|
||||||
import Hasura.Server.Init
|
import Hasura.Server.Init
|
||||||
import Hasura.Server.Logging
|
import Hasura.Server.Logging
|
||||||
import Hasura.Server.Middleware (corsMiddleware)
|
import Hasura.Server.Middleware (corsMiddleware)
|
||||||
import Hasura.Server.Utils
|
import Hasura.Server.Utils
|
||||||
import Hasura.Server.Version
|
import Hasura.Server.Version
|
||||||
import Hasura.SQL.Types
|
|
||||||
import Hasura.Session
|
import Hasura.Session
|
||||||
|
import Hasura.SQL.Types
|
||||||
|
|
||||||
import qualified Hasura.GraphQL.Execute as E
|
import qualified Hasura.GraphQL.Execute as E
|
||||||
import qualified Hasura.GraphQL.Execute.LiveQuery as EL
|
import qualified Hasura.GraphQL.Execute.LiveQuery as EL
|
||||||
-- import qualified Hasura.GraphQL.Explain as GE
|
-- import qualified Hasura.GraphQL.Explain as GE
|
||||||
import qualified Hasura.GraphQL.Transport.HTTP as GH
|
import qualified Hasura.GraphQL.Transport.HTTP as GH
|
||||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||||
import qualified Hasura.GraphQL.Transport.WebSocket as WS
|
import qualified Hasura.GraphQL.Transport.WebSocket as WS
|
||||||
import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS
|
import qualified Hasura.GraphQL.Transport.WebSocket.Server as WS
|
||||||
import qualified Hasura.Logging as L
|
import qualified Hasura.Logging as L
|
||||||
import qualified Hasura.Server.API.PGDump as PGD
|
import qualified Hasura.Server.API.PGDump as PGD
|
||||||
import qualified Network.Wai.Handler.WebSockets.Custom as WSC
|
import qualified Network.Wai.Handler.WebSockets.Custom as WSC
|
||||||
|
|
||||||
|
|
||||||
@ -350,7 +350,8 @@ v1Alpha1GQHandler queryType query = do
|
|||||||
|
|
||||||
v1GQHandler
|
v1GQHandler
|
||||||
:: (HasVersion, MonadIO m)
|
:: (HasVersion, MonadIO m)
|
||||||
=> GH.GQLBatchedReqs GH.GQLQueryText -> Handler m (HttpResponse EncJSON)
|
=> GH.GQLBatchedReqs GH.GQLQueryText
|
||||||
|
-> Handler m (HttpResponse EncJSON)
|
||||||
v1GQHandler = v1Alpha1GQHandler E.QueryHasura
|
v1GQHandler = v1Alpha1GQHandler E.QueryHasura
|
||||||
|
|
||||||
v1GQRelayHandler
|
v1GQRelayHandler
|
||||||
|
@ -0,0 +1,49 @@
|
|||||||
|
description: Get last page of articles with 3 items
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
article_connection(
|
||||||
|
last: 3
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
title
|
||||||
|
content
|
||||||
|
author_id
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
article_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJpZCIgOiA0fQ==
|
||||||
|
endCursor: eyJpZCIgOiA2fQ==
|
||||||
|
hasPreviousPage: true
|
||||||
|
hasNextPage: false
|
||||||
|
edges:
|
||||||
|
- cursor: eyJpZCIgOiA0fQ==
|
||||||
|
node:
|
||||||
|
title: Article 4
|
||||||
|
content: Sample article content 4
|
||||||
|
author_id: 2
|
||||||
|
- cursor: eyJpZCIgOiA1fQ==
|
||||||
|
node:
|
||||||
|
title: Article 5
|
||||||
|
content: Sample article content 5
|
||||||
|
author_id: 2
|
||||||
|
- cursor: eyJpZCIgOiA2fQ==
|
||||||
|
node:
|
||||||
|
title: Article 6
|
||||||
|
content: Sample article content 6
|
||||||
|
author_id: 3
|
@ -0,0 +1,45 @@
|
|||||||
|
description: Get last page of articles with 2 items before 'Article 4'
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
article_connection(
|
||||||
|
last: 2
|
||||||
|
before: "eyJpZCIgOiA0fQ=="
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
title
|
||||||
|
content
|
||||||
|
author_id
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
article_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJpZCIgOiAyfQ==
|
||||||
|
endCursor: eyJpZCIgOiAzfQ==
|
||||||
|
hasPreviousPage: true
|
||||||
|
hasNextPage: true
|
||||||
|
edges:
|
||||||
|
- cursor: eyJpZCIgOiAyfQ==
|
||||||
|
node:
|
||||||
|
title: Article 2
|
||||||
|
content: Sample article content 2
|
||||||
|
author_id: 1
|
||||||
|
- cursor: eyJpZCIgOiAzfQ==
|
||||||
|
node:
|
||||||
|
title: Article 3
|
||||||
|
content: Sample article content 3
|
||||||
|
author_id: 1
|
@ -0,0 +1,40 @@
|
|||||||
|
description: Get last page of articles before 'Article 2'
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
article_connection(
|
||||||
|
last: 2
|
||||||
|
before: "eyJpZCIgOiAyfQ=="
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
title
|
||||||
|
content
|
||||||
|
author_id
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
article_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJpZCIgOiAxfQ==
|
||||||
|
endCursor: eyJpZCIgOiAxfQ==
|
||||||
|
hasPreviousPage: false
|
||||||
|
hasNextPage: true
|
||||||
|
edges:
|
||||||
|
- cursor: eyJpZCIgOiAxfQ==
|
||||||
|
node:
|
||||||
|
title: Article 1
|
||||||
|
content: Sample article content 1
|
||||||
|
author_id: 1
|
@ -0,0 +1,49 @@
|
|||||||
|
description: Get 1st page of articles with 3 items
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
article_connection(
|
||||||
|
first: 3
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
title
|
||||||
|
content
|
||||||
|
author_id
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
article_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJpZCIgOiAxfQ==
|
||||||
|
endCursor: eyJpZCIgOiAzfQ==
|
||||||
|
hasPreviousPage: false
|
||||||
|
hasNextPage: true
|
||||||
|
edges:
|
||||||
|
- cursor: eyJpZCIgOiAxfQ==
|
||||||
|
node:
|
||||||
|
title: Article 1
|
||||||
|
content: Sample article content 1
|
||||||
|
author_id: 1
|
||||||
|
- cursor: eyJpZCIgOiAyfQ==
|
||||||
|
node:
|
||||||
|
title: Article 2
|
||||||
|
content: Sample article content 2
|
||||||
|
author_id: 1
|
||||||
|
- cursor: eyJpZCIgOiAzfQ==
|
||||||
|
node:
|
||||||
|
title: Article 3
|
||||||
|
content: Sample article content 3
|
||||||
|
author_id: 1
|
@ -0,0 +1,45 @@
|
|||||||
|
description: Get 2nd page of articles with 2 items
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
article_connection(
|
||||||
|
first: 2
|
||||||
|
after: "eyJpZCIgOiAzfQ=="
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
title
|
||||||
|
content
|
||||||
|
author_id
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
article_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJpZCIgOiA0fQ==
|
||||||
|
endCursor: eyJpZCIgOiA1fQ==
|
||||||
|
hasPreviousPage: true
|
||||||
|
hasNextPage: true
|
||||||
|
edges:
|
||||||
|
- cursor: eyJpZCIgOiA0fQ==
|
||||||
|
node:
|
||||||
|
title: Article 4
|
||||||
|
content: Sample article content 4
|
||||||
|
author_id: 2
|
||||||
|
- cursor: eyJpZCIgOiA1fQ==
|
||||||
|
node:
|
||||||
|
title: Article 5
|
||||||
|
content: Sample article content 5
|
||||||
|
author_id: 2
|
@ -0,0 +1,40 @@
|
|||||||
|
description: Get 3rd page of articles
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
article_connection(
|
||||||
|
first: 3
|
||||||
|
after: "eyJpZCIgOiA1fQ=="
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
title
|
||||||
|
content
|
||||||
|
author_id
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
article_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJpZCIgOiA2fQ==
|
||||||
|
endCursor: eyJpZCIgOiA2fQ==
|
||||||
|
hasPreviousPage: true
|
||||||
|
hasNextPage: false
|
||||||
|
edges:
|
||||||
|
- cursor: eyJpZCIgOiA2fQ==
|
||||||
|
node:
|
||||||
|
title: Article 6
|
||||||
|
content: Sample article content 6
|
||||||
|
author_id: 3
|
@ -0,0 +1,44 @@
|
|||||||
|
description: Fetch 1st page from last of articles ordered by their article count
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
author_connection(
|
||||||
|
last: 1
|
||||||
|
order_by: {articles_aggregate: {count: asc}}
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
name
|
||||||
|
articles_aggregate{
|
||||||
|
aggregate{
|
||||||
|
count
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
author_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAzfSwgImlkIiA6IDF9
|
||||||
|
endCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAzfSwgImlkIiA6IDF9
|
||||||
|
hasPreviousPage: true
|
||||||
|
hasNextPage: false
|
||||||
|
edges:
|
||||||
|
- cursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAzfSwgImlkIiA6IDF9
|
||||||
|
node:
|
||||||
|
name: Author 1
|
||||||
|
articles_aggregate:
|
||||||
|
aggregate:
|
||||||
|
count: 3
|
@ -0,0 +1,51 @@
|
|||||||
|
description: Fetch 2nd page from last of articles ordered by their article count
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
author_connection(
|
||||||
|
last: 2
|
||||||
|
order_by: {articles_aggregate: {count: asc}}
|
||||||
|
before: "eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAzfSwgImlkIiA6IDF9"
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
name
|
||||||
|
articles_aggregate{
|
||||||
|
aggregate{
|
||||||
|
count
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
author_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAxfSwgImlkIiA6IDN9
|
||||||
|
endCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAyfSwgImlkIiA6IDJ9
|
||||||
|
hasPreviousPage: true
|
||||||
|
hasNextPage: true
|
||||||
|
edges:
|
||||||
|
- cursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAxfSwgImlkIiA6IDN9
|
||||||
|
node:
|
||||||
|
name: Author 3
|
||||||
|
articles_aggregate:
|
||||||
|
aggregate:
|
||||||
|
count: 1
|
||||||
|
- cursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAyfSwgImlkIiA6IDJ9
|
||||||
|
node:
|
||||||
|
name: Author 2
|
||||||
|
articles_aggregate:
|
||||||
|
aggregate:
|
||||||
|
count: 2
|
@ -0,0 +1,45 @@
|
|||||||
|
description: Fetch 3rd page from last of articles ordered by their article count
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
author_connection(
|
||||||
|
last: 1
|
||||||
|
order_by: {articles_aggregate: {count: asc}}
|
||||||
|
before: "eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAxfSwgImlkIiA6IDN9"
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
name
|
||||||
|
articles_aggregate{
|
||||||
|
aggregate{
|
||||||
|
count
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
author_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAwfSwgImlkIiA6IDR9
|
||||||
|
endCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAwfSwgImlkIiA6IDR9
|
||||||
|
hasPreviousPage: false
|
||||||
|
hasNextPage: true
|
||||||
|
edges:
|
||||||
|
- cursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAwfSwgImlkIiA6IDR9
|
||||||
|
node:
|
||||||
|
name: Author 4
|
||||||
|
articles_aggregate:
|
||||||
|
aggregate:
|
||||||
|
count: 0
|
@ -0,0 +1,50 @@
|
|||||||
|
description: Fetch 1st page of articles ordered by their article count
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
author_connection(
|
||||||
|
first: 2
|
||||||
|
order_by: {articles_aggregate: {count: asc}}
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
name
|
||||||
|
articles_aggregate{
|
||||||
|
aggregate{
|
||||||
|
count
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
author_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAwfSwgImlkIiA6IDR9
|
||||||
|
endCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAxfSwgImlkIiA6IDN9
|
||||||
|
hasPreviousPage: false
|
||||||
|
hasNextPage: true
|
||||||
|
edges:
|
||||||
|
- cursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAwfSwgImlkIiA6IDR9
|
||||||
|
node:
|
||||||
|
name: Author 4
|
||||||
|
articles_aggregate:
|
||||||
|
aggregate:
|
||||||
|
count: 0
|
||||||
|
- cursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAxfSwgImlkIiA6IDN9
|
||||||
|
node:
|
||||||
|
name: Author 3
|
||||||
|
articles_aggregate:
|
||||||
|
aggregate:
|
||||||
|
count: 1
|
@ -0,0 +1,51 @@
|
|||||||
|
description: Fetch 2nd page of articles ordered by their article count
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
author_connection(
|
||||||
|
first: 2
|
||||||
|
order_by: {articles_aggregate: {count: asc}}
|
||||||
|
after: "eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAxfSwgImlkIiA6IDN9"
|
||||||
|
){
|
||||||
|
pageInfo{
|
||||||
|
startCursor
|
||||||
|
endCursor
|
||||||
|
hasPreviousPage
|
||||||
|
hasNextPage
|
||||||
|
}
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
node{
|
||||||
|
name
|
||||||
|
articles_aggregate{
|
||||||
|
aggregate{
|
||||||
|
count
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
data:
|
||||||
|
author_connection:
|
||||||
|
pageInfo:
|
||||||
|
startCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAyfSwgImlkIiA6IDJ9
|
||||||
|
endCursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAzfSwgImlkIiA6IDF9
|
||||||
|
hasPreviousPage: true
|
||||||
|
hasNextPage: false
|
||||||
|
edges:
|
||||||
|
- cursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAyfSwgImlkIiA6IDJ9
|
||||||
|
node:
|
||||||
|
name: Author 2
|
||||||
|
articles_aggregate:
|
||||||
|
aggregate:
|
||||||
|
count: 2
|
||||||
|
- cursor: eyJhcnRpY2xlc19hZ2dyZWdhdGUiIDogeyJjb3VudCIgOiAzfSwgImlkIiA6IDF9
|
||||||
|
node:
|
||||||
|
name: Author 1
|
||||||
|
articles_aggregate:
|
||||||
|
aggregate:
|
||||||
|
count: 3
|
@ -0,0 +1,19 @@
|
|||||||
|
description: Query node interface with invalid node id
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
node(id: "eyJpZCIgOiA0fQ=="){
|
||||||
|
__typename
|
||||||
|
... on author{
|
||||||
|
name
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
errors:
|
||||||
|
- extensions:
|
||||||
|
path: "$.selectionSet.node"
|
||||||
|
code: validation-failed
|
||||||
|
message: the node id is invalid
|
@ -0,0 +1,21 @@
|
|||||||
|
description: Use after and before arguments in the same query
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
author_connection(
|
||||||
|
after: "eyJpZCIgOiAyfQ=="
|
||||||
|
before: "eyJpZCIgOiA0fQ=="
|
||||||
|
){
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
errors:
|
||||||
|
- extensions:
|
||||||
|
path: "$.selectionSet.author_connection"
|
||||||
|
code: validation-failed
|
||||||
|
message: '"after" and "before" are not allowed at once'
|
@ -0,0 +1,21 @@
|
|||||||
|
description: Use first and last arguments in the same query
|
||||||
|
url: /v1/relay
|
||||||
|
status: 200
|
||||||
|
query:
|
||||||
|
query: |
|
||||||
|
query {
|
||||||
|
author_connection(
|
||||||
|
first: 1
|
||||||
|
last: 2
|
||||||
|
){
|
||||||
|
edges{
|
||||||
|
cursor
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
response:
|
||||||
|
errors:
|
||||||
|
- extensions:
|
||||||
|
path: "$.selectionSet.author_connection"
|
||||||
|
code: validation-failed
|
||||||
|
message: '"first" and "last" are not allowed at once'
|
79
server/tests-py/queries/graphql_query/relay/setup.yaml
Normal file
79
server/tests-py/queries/graphql_query/relay/setup.yaml
Normal file
@ -0,0 +1,79 @@
|
|||||||
|
type: bulk
|
||||||
|
args:
|
||||||
|
- type: run_sql
|
||||||
|
args:
|
||||||
|
sql: |
|
||||||
|
CREATE TABLE author(
|
||||||
|
id SERIAL PRIMARY KEY,
|
||||||
|
name TEXT UNIQUE NOT NULL
|
||||||
|
);
|
||||||
|
|
||||||
|
INSERT INTO author (name)
|
||||||
|
VALUES ('Author 1'), ('Author 2'), ('Author 3'), ('Author 4');
|
||||||
|
|
||||||
|
CREATE TABLE article (
|
||||||
|
id SERIAL PRIMARY KEY,
|
||||||
|
title TEXT,
|
||||||
|
content TEXT,
|
||||||
|
author_id INTEGER REFERENCES author(id)
|
||||||
|
);
|
||||||
|
|
||||||
|
INSERT INTO article (title, content, author_id)
|
||||||
|
VALUES
|
||||||
|
(
|
||||||
|
'Article 1',
|
||||||
|
'Sample article content 1',
|
||||||
|
1
|
||||||
|
),
|
||||||
|
(
|
||||||
|
'Article 2',
|
||||||
|
'Sample article content 2',
|
||||||
|
1
|
||||||
|
),
|
||||||
|
(
|
||||||
|
'Article 3',
|
||||||
|
'Sample article content 3',
|
||||||
|
1
|
||||||
|
),
|
||||||
|
(
|
||||||
|
'Article 4',
|
||||||
|
'Sample article content 4',
|
||||||
|
2
|
||||||
|
),
|
||||||
|
(
|
||||||
|
'Article 5',
|
||||||
|
'Sample article content 5',
|
||||||
|
2
|
||||||
|
),
|
||||||
|
(
|
||||||
|
'Article 6',
|
||||||
|
'Sample article content 6',
|
||||||
|
3
|
||||||
|
);
|
||||||
|
|
||||||
|
# Track tables and define relationships
|
||||||
|
- type: track_table
|
||||||
|
args:
|
||||||
|
name: author
|
||||||
|
schema: public
|
||||||
|
|
||||||
|
- type: track_table
|
||||||
|
args:
|
||||||
|
name: article
|
||||||
|
schema: public
|
||||||
|
|
||||||
|
- type: create_object_relationship
|
||||||
|
args:
|
||||||
|
table: article
|
||||||
|
name: author
|
||||||
|
using:
|
||||||
|
foreign_key_constraint_on: author_id
|
||||||
|
|
||||||
|
- type: create_array_relationship
|
||||||
|
args:
|
||||||
|
table: author
|
||||||
|
name: articles
|
||||||
|
using:
|
||||||
|
foreign_key_constraint_on:
|
||||||
|
table: article
|
||||||
|
column: author_id
|
@ -0,0 +1,8 @@
|
|||||||
|
type: bulk
|
||||||
|
args:
|
||||||
|
- type: run_sql
|
||||||
|
args:
|
||||||
|
cascade: true
|
||||||
|
sql: |
|
||||||
|
DROP TABLE article;
|
||||||
|
DROP TABLE author;
|
Loading…
Reference in New Issue
Block a user