mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-14 08:02:15 +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
|
||||
|
||||
|
||||
### Bug fixes and improvements
|
||||
|
||||
(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
|
||||
|
||||
#### Creating seed
|
||||
```
|
||||
```
|
||||
# create a new seed file and use editor to add SQL content
|
||||
hasura seed create new_table_seed
|
||||
|
||||
|
@ -2,7 +2,6 @@ import React from 'react';
|
||||
import OverlayTrigger from 'react-bootstrap/lib/OverlayTrigger';
|
||||
import Tooltip from 'react-bootstrap/lib/Tooltip';
|
||||
import styles from './Tooltip.scss';
|
||||
|
||||
const tooltipGen = (message: string) => {
|
||||
return <Tooltip id={message}>{message}</Tooltip>;
|
||||
};
|
||||
@ -28,5 +27,4 @@ const ToolTip: React.FC<TooltipProps> = ({
|
||||
)}
|
||||
</OverlayTrigger>
|
||||
);
|
||||
|
||||
export default ToolTip;
|
||||
export default ToolTip;
|
@ -233,6 +233,7 @@ library
|
||||
, ghc-heap-view
|
||||
|
||||
, directory
|
||||
, semigroups >= 0.19.1
|
||||
|
||||
exposed-modules: Control.Arrow.Extended
|
||||
, Control.Arrow.Trans
|
||||
|
@ -1,25 +1,25 @@
|
||||
module Data.HashMap.Strict.InsOrd.Extended
|
||||
( OMap.elems
|
||||
( module OMap
|
||||
, groupTuples
|
||||
, groupListWith
|
||||
) 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 Data.Hashable (Hashable)
|
||||
import Data.List (foldl')
|
||||
|
||||
import Prelude (Eq, Foldable, Functor, fmap, ($))
|
||||
import Prelude (Eq, Foldable, Functor, fmap, undefined, ($))
|
||||
|
||||
groupTuples
|
||||
:: (Eq k, Hashable k, Foldable t)
|
||||
=> t (k, v) -> OMap.InsOrdHashMap k (NE.NESeq v)
|
||||
groupTuples =
|
||||
foldl' groupFlds OMap.empty
|
||||
L.foldl' groupFlds OMap.empty
|
||||
where
|
||||
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
|
||||
:: (Eq k, Hashable k, Foldable t, Functor t)
|
||||
|
@ -5,8 +5,6 @@ module Data.Sequence.NonEmpty
|
||||
( NESeq
|
||||
, pattern (:<||)
|
||||
, pattern (:||>)
|
||||
, (<|)
|
||||
, (|>)
|
||||
, singleton
|
||||
, head
|
||||
, tail
|
||||
@ -22,9 +20,6 @@ import Data.Aeson
|
||||
import Data.Foldable
|
||||
import GHC.Generics (Generic)
|
||||
|
||||
infixr 5 <|
|
||||
infixl 5 |>
|
||||
|
||||
data NESeq a = NESeq
|
||||
{ head :: a
|
||||
, tail :: Seq.Seq a
|
||||
@ -59,12 +54,6 @@ instance ToJSON a => ToJSON (NESeq a) where
|
||||
singleton :: a -> NESeq a
|
||||
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 v l) = v Seq.<| l
|
||||
|
||||
|
@ -76,9 +76,9 @@ traverseAction f = \case
|
||||
RFRaw x -> pure $ RFRaw x
|
||||
|
||||
data QueryDB v
|
||||
= QDBSimple (RQL.AnnSimpleSelG v)
|
||||
| QDBPrimaryKey (RQL.AnnSimpleSelG v)
|
||||
| QDBAggregation (RQL.AnnAggSelG v)
|
||||
= QDBSimple (RQL.AnnSimpleSelG v)
|
||||
| QDBPrimaryKey (RQL.AnnSimpleSelG v)
|
||||
| QDBAggregation (RQL.AnnAggregateSelectG v)
|
||||
|
||||
data ActionQuery v
|
||||
= AQQuery !(RQL.AnnActionExecution v)
|
||||
|
@ -43,8 +43,7 @@ import Hasura.Prelude
|
||||
import Hasura.RQL.DDL.Headers
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Utils (RequestId, mkClientHeadersForward,
|
||||
mkSetCookieHeaders,
|
||||
userRoleHeader)
|
||||
mkSetCookieHeaders, userRoleHeader)
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
|
||||
@ -142,8 +141,8 @@ getExecPlanPartial userInfo sc enableAL queryType req = do
|
||||
getGCtx :: C.GQLContext
|
||||
getGCtx =
|
||||
case Map.lookup roleName contextMap of
|
||||
Nothing -> defaultContext
|
||||
Just gql -> gql
|
||||
Nothing -> defaultContext
|
||||
Just gql -> gql
|
||||
-- TODO FIXME implement backend-only field access
|
||||
{-
|
||||
Just (RoleContext defaultGCtx maybeBackendGCtx) ->
|
||||
@ -206,7 +205,7 @@ getResolvedExecPlan
|
||||
getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx
|
||||
enableAL sc scVer queryType httpManager reqHeaders reqUnparsed = do
|
||||
planM <- liftIO $ EP.getPlan scVer (_uiRole userInfo)
|
||||
opNameM queryStr planCache
|
||||
opNameM queryStr queryType planCache
|
||||
let usrVars = _uiSession userInfo
|
||||
case planM of
|
||||
-- plans are only for queries and subscriptions
|
||||
@ -246,7 +245,7 @@ getResolvedExecPlan pgExecCtx planCache userInfo sqlGenCtx
|
||||
G.TypedOperationDefinition G.OperationTypeMutation _ varDefs _ selSet -> do
|
||||
-- (Here the above fragment inlining is actually executed.)
|
||||
inlinedSelSet <- EI.inlineSelectionSet fragments selSet
|
||||
queryTx <- EM.convertMutationSelectionSet gCtx (_uiSession userInfo) httpManager reqHeaders
|
||||
queryTx <- EM.convertMutationSelectionSet gCtx userInfo httpManager reqHeaders
|
||||
inlinedSelSet varDefs (_grVariables reqUnparsed)
|
||||
-- traverse_ (addPlanToCache . EP.RPQuery) plan
|
||||
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.TH as J
|
||||
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.UUID.V4 as UUID
|
||||
import qualified Database.PG.Query as Q
|
||||
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
|
||||
import qualified Database.PG.Query.PTI as PTI
|
||||
@ -43,24 +44,25 @@ import qualified PostgreSQL.Binary.Encoding as PE
|
||||
import Control.Lens
|
||||
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.Transport.HTTP.Protocol as GH
|
||||
import qualified Hasura.RQL.DML.Select as DS
|
||||
import qualified Hasura.SQL.DML as S
|
||||
--import qualified Hasura.GraphQL.Execute.Query as GEQ
|
||||
|
||||
import Hasura.Db
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Parser.Column
|
||||
import Hasura.GraphQL.Context
|
||||
import Hasura.GraphQL.Execute.Prepare
|
||||
import Hasura.GraphQL.Execute.Query
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.GraphQL.Parser.Column
|
||||
import Hasura.GraphQL.Resolve.Action
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.Session
|
||||
import Hasura.SQL.Error
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.SQL.Value
|
||||
import Hasura.GraphQL.Context
|
||||
import Hasura.Session
|
||||
|
||||
-- -------------------------------------------------------------------------------------------------
|
||||
-- Multiplexed queries
|
||||
@ -72,7 +74,7 @@ toSQLSelect :: SubscriptionRootFieldResolved -> S.Select
|
||||
toSQLSelect = \case
|
||||
RFDB (QDBPrimaryKey s) -> DS.mkSQLSelect DS.JASSingleObject 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
|
||||
-- QRFActionSelect 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
|
||||
:: ( MonadError QErr m
|
||||
, MonadIO m
|
||||
, HasVersion
|
||||
)
|
||||
=> PGExecCtx
|
||||
-> UserInfo
|
||||
@ -310,7 +313,7 @@ buildLiveQueryPlan pgExecCtx userInfo unpreparedAST = do
|
||||
(preparedAST, (queryVariableValues, querySyntheticVariableValues)) <- flip runStateT (mempty, Seq.empty) $
|
||||
for unpreparedAST \unpreparedQuery -> do
|
||||
traverseQueryRootField resolveMultiplexedValue unpreparedQuery
|
||||
>>= traverseAction (DS.traverseAnnSimpleSel resolveMultiplexedValue . resolveAsyncActionQuery userInfo)
|
||||
>>= traverseAction (DS.traverseAnnSimpleSelect resolveMultiplexedValue . resolveAsyncActionQuery userInfo)
|
||||
|
||||
|
||||
|
||||
|
@ -67,37 +67,38 @@ convertMutationRootField
|
||||
, MonadIO m
|
||||
, MonadError QErr m
|
||||
)
|
||||
=> SessionVariables
|
||||
=> UserInfo
|
||||
-> HTTP.Manager
|
||||
-> HTTP.RequestHeaders
|
||||
-> Bool
|
||||
-> MutationRootField UnpreparedValue
|
||||
-> m (Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
||||
convertMutationRootField usrVars manager reqHeaders stringifyNum = \case
|
||||
RFDB (MDBInsert s) -> noResponseHeaders $ convertInsert usrVars s stringifyNum
|
||||
RFDB (MDBUpdate s) -> noResponseHeaders $ convertUpdate usrVars s stringifyNum
|
||||
RFDB (MDBDelete s) -> noResponseHeaders $ convertDelete usrVars s stringifyNum
|
||||
convertMutationRootField userInfo manager reqHeaders stringifyNum = \case
|
||||
RFDB (MDBInsert s) -> noResponseHeaders $ convertInsert userSession s stringifyNum
|
||||
RFDB (MDBUpdate s) -> noResponseHeaders $ convertUpdate userSession s stringifyNum
|
||||
RFDB (MDBDelete s) -> noResponseHeaders $ convertDelete userSession s stringifyNum
|
||||
RFRemote remote -> pure $ Right remote
|
||||
RFAction (AMSync s) -> Left <$> first liftTx <$> resolveActionExecution s actionExecContext
|
||||
RFAction (AMAsync s) -> noResponseHeaders =<< resolveActionMutationAsync s reqHeaders usrVars
|
||||
RFAction (AMSync s) -> Left <$> first liftTx <$> resolveActionExecution userInfo s actionExecContext
|
||||
RFAction (AMAsync s) -> noResponseHeaders =<< resolveActionMutationAsync s reqHeaders userSession
|
||||
RFRaw s -> noResponseHeaders $ pure $ encJFromJValue s
|
||||
where
|
||||
noResponseHeaders :: RespTx -> m (Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
||||
noResponseHeaders rTx = pure $ Left (liftTx rTx, [])
|
||||
|
||||
actionExecContext = ActionExecContext manager reqHeaders usrVars
|
||||
userSession = _uiSession userInfo
|
||||
actionExecContext = ActionExecContext manager reqHeaders $ _uiSession userInfo
|
||||
|
||||
convertMutationSelectionSet
|
||||
:: (HasVersion, MonadIO m, MonadError QErr m)
|
||||
=> GQLContext
|
||||
-> SessionVariables
|
||||
-> UserInfo
|
||||
-> HTTP.Manager
|
||||
-> HTTP.RequestHeaders
|
||||
-> G.SelectionSet G.NoFragments G.Name
|
||||
-> [G.VariableDefinition]
|
||||
-> Maybe GH.VariableValues
|
||||
-> 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
|
||||
(unpreparedQueries, _reusability)
|
||||
:: (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
|
||||
-- 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
|
||||
case (mapMaybe takeTx txList, mapMaybe takeRemote txList) of
|
||||
(dbPlans, []) -> do
|
||||
@ -148,9 +149,9 @@ convertMutationSelectionSet gqlContext usrVars manager reqHeaders fields varDefs
|
||||
:: (G.Name, Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
||||
-> Maybe (G.Name, (LazyRespTx, HTTP.ResponseHeaders))
|
||||
takeTx (name, Left tx) = Just (name, tx)
|
||||
takeTx _ = Nothing
|
||||
takeTx _ = Nothing
|
||||
takeRemote
|
||||
:: (G.Name, Either (LazyRespTx, HTTP.ResponseHeaders) RemoteField)
|
||||
-> Maybe (G.Name, RemoteField)
|
||||
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.GraphQL.Execute.LiveQuery as LQ
|
||||
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 Hasura.RQL.Types
|
||||
import Hasura.Session
|
||||
@ -29,17 +30,19 @@ data PlanId
|
||||
, _piRole :: !RoleName
|
||||
, _piOperationName :: !(Maybe GH.OperationName)
|
||||
, _piQuery :: !GH.GQLQueryText
|
||||
, _piQueryType :: !ET.GraphQLQueryType
|
||||
} deriving (Show, Eq, Ord, Generic)
|
||||
|
||||
instance Hashable PlanId
|
||||
|
||||
instance J.ToJSON PlanId where
|
||||
toJSON (PlanId scVer rn opNameM query) =
|
||||
toJSON (PlanId scVer rn opNameM query queryType) =
|
||||
J.object
|
||||
[ "schema_cache_version" J..= scVer
|
||||
, "role" J..= rn
|
||||
, "operation" J..= opNameM
|
||||
, "query" J..= query
|
||||
, "query_type" J..= queryType
|
||||
]
|
||||
|
||||
newtype PlanCache
|
||||
@ -68,19 +71,19 @@ initPlanCache options =
|
||||
|
||||
getPlan
|
||||
:: SchemaCacheVer -> RoleName -> Maybe GH.OperationName -> GH.GQLQueryText
|
||||
-> PlanCache -> IO (Maybe ReusablePlan)
|
||||
getPlan schemaVer rn opNameM q (PlanCache planCache) =
|
||||
-> ET.GraphQLQueryType -> PlanCache -> IO (Maybe ReusablePlan)
|
||||
getPlan schemaVer rn opNameM q queryType (PlanCache planCache) =
|
||||
Cache.lookup planId planCache
|
||||
where
|
||||
planId = PlanId schemaVer rn opNameM q
|
||||
planId = PlanId schemaVer rn opNameM q queryType
|
||||
|
||||
addPlan
|
||||
:: SchemaCacheVer -> RoleName -> Maybe GH.OperationName -> GH.GQLQueryText
|
||||
-> ReusablePlan -> PlanCache -> IO ()
|
||||
addPlan schemaVer rn opNameM q queryPlan (PlanCache planCache) =
|
||||
-> ReusablePlan -> ET.GraphQLQueryType -> PlanCache -> IO ()
|
||||
addPlan schemaVer rn opNameM q queryPlan queryType (PlanCache planCache) =
|
||||
Cache.insert planId queryPlan planCache
|
||||
where
|
||||
planId = PlanId schemaVer rn opNameM q
|
||||
planId = PlanId schemaVer rn opNameM q queryType
|
||||
|
||||
clearPlanCache :: PlanCache -> IO ()
|
||||
clearPlanCache (PlanCache planCache) =
|
||||
|
@ -37,9 +37,9 @@ import Hasura.Prelude
|
||||
import Hasura.RQL.DML.RemoteJoin
|
||||
import Hasura.RQL.DML.Select (asSingleRowJsonResp)
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Session
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.SQL.Value
|
||||
import Hasura.Session
|
||||
|
||||
import qualified Hasura.RQL.DML.Select as DS
|
||||
|
||||
@ -165,7 +165,7 @@ irToRootFieldPlan vars prepped = \case
|
||||
QDBPrimaryKey s -> mkPGPlan (DS.selectQuerySQL DS.JASSingleObject) s
|
||||
QDBAggregation s ->
|
||||
let (annAggSel, aggRemoteJoins) = getRemoteJoinsAggregateSelect s
|
||||
in PGPlan (DS.selectAggQuerySQL annAggSel) vars prepped aggRemoteJoins
|
||||
in PGPlan (DS.selectAggregateQuerySQL annAggSel) vars prepped aggRemoteJoins
|
||||
where
|
||||
mkPGPlan f simpleSel =
|
||||
let (simpleSel',remoteJoins) = getRemoteJoins simpleSel
|
||||
@ -182,9 +182,9 @@ traverseQueryRootField f =
|
||||
where
|
||||
f' :: QueryDB a -> f (QueryDB b)
|
||||
f' = \case
|
||||
QDBSimple s -> QDBSimple <$> DS.traverseAnnSimpleSel f s
|
||||
QDBPrimaryKey s -> QDBPrimaryKey <$> DS.traverseAnnSimpleSel f s
|
||||
QDBAggregation s -> QDBAggregation <$> DS.traverseAnnAggSel f s
|
||||
QDBSimple s -> QDBSimple <$> DS.traverseAnnSimpleSelect f s
|
||||
QDBPrimaryKey s -> QDBPrimaryKey <$> DS.traverseAnnSimpleSelect f s
|
||||
QDBAggregation s -> QDBAggregation <$> DS.traverseAnnAggregateSelect f s
|
||||
|
||||
convertQuerySelSet
|
||||
:: 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
|
||||
convertActionQuery = \case
|
||||
AQQuery s -> (AQPQuery . fst) <$>
|
||||
lift (resolveActionExecution s $ ActionExecContext manager reqHeaders usrVars)
|
||||
lift (resolveActionExecution userInfo s $ ActionExecContext manager reqHeaders usrVars)
|
||||
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
|
||||
queryOpFromPlan
|
||||
@ -341,3 +341,15 @@ mkGeneratedSqlMap resolved =
|
||||
RRSql ps -> Just ps
|
||||
RRActionQuery _ -> Nothing
|
||||
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 Hasura.EncJSON
|
||||
import Hasura.GraphQL.Resolve.Action
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.DML.Internal
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.SQL.Types
|
||||
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.LiveQuery as E
|
||||
@ -26,11 +26,12 @@ import qualified Hasura.SQL.DML as S
|
||||
|
||||
data GQLExplain
|
||||
= GQLExplain
|
||||
{ _gqeQuery :: !GH.GQLReqParsed
|
||||
, _gqeUser :: !(Maybe (Map.HashMap Text Text))
|
||||
{ _gqeQuery :: !GH.GQLReqParsed
|
||||
, _gqeUser :: !(Maybe (Map.HashMap Text Text))
|
||||
, _gqeIsRelay :: !(Maybe Bool)
|
||||
} deriving (Show, Eq)
|
||||
|
||||
$(J.deriveJSON (J.aesonDrop 4 J.camelCase){J.omitNothingFields=True}
|
||||
$(J.deriveJSON (J.aesonDrop 4 J.snakeCase){J.omitNothingFields=True}
|
||||
''GQLExplain
|
||||
)
|
||||
|
||||
@ -117,24 +118,26 @@ explainGQLQuery
|
||||
-> QueryActionExecuter
|
||||
-> GQLExplain
|
||||
-> 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 $
|
||||
E.getExecPlanPartial userInfo sc enableAL query
|
||||
E.getExecPlanPartial userInfo sc queryType enableAL query
|
||||
(gCtx, rootSelSet) <- case execPlan of
|
||||
E.GExPHasura (gCtx, rootSelSet) ->
|
||||
return (gCtx, rootSelSet)
|
||||
E.GExPRemote _ _ ->
|
||||
E.GExPRemote{} ->
|
||||
throw400 InvalidParams "only hasura queries can be explained"
|
||||
case rootSelSet of
|
||||
GV.RQuery selSet ->
|
||||
runInTx $ encJFromJValue <$> traverse (explainField userInfo gCtx sqlGenCtx actionExecuter)
|
||||
(toList selSet)
|
||||
runInTx $ encJFromJValue . map snd <$>
|
||||
GV.traverseObjectSelectionSet selSet (explainField userInfo gCtx sqlGenCtx actionExecuter)
|
||||
GV.RMutation _ ->
|
||||
throw400 InvalidParams "only queries can be explained"
|
||||
GV.RSubscription rootField -> do
|
||||
(plan, _) <- E.getSubsOp pgExecCtx gCtx sqlGenCtx userInfo queryReusability actionExecuter rootField
|
||||
GV.RSubscription fields -> do
|
||||
(plan, _) <- E.getSubsOp pgExecCtx gCtx sqlGenCtx userInfo
|
||||
queryReusability actionExecuter fields
|
||||
runInTx $ encJFromJValue <$> E.explainLiveQueryPlan plan
|
||||
where
|
||||
usrVars = mkUserVars $ maybe [] Map.toList userVarsRaw
|
||||
userInfo = mkUserInfo (fromMaybe adminRole $ roleFromVars usrVars) usrVars
|
||||
queryType = bool E.QueryHasura E.QueryRelay $ fromMaybe False maybeIsRelay
|
||||
sessionVariables = mkSessionVariablesText $ maybe [] Map.toList userVarsRaw
|
||||
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
|
||||
ObjRel -> [relFld]
|
||||
ArrRel -> bool [relFld] [relFld, aggRelFld] allowAgg
|
||||
SFComputedField cf -> pure
|
||||
SAFComputedField cf -> pure
|
||||
( (ty, mkComputedFieldName $ _cfName cf)
|
||||
, RFComputedField cf
|
||||
)
|
||||
|
@ -8,6 +8,8 @@ module Hasura.GraphQL.Schema.Builder
|
||||
, addFieldsToTyAgg
|
||||
, addTypeInfoToTyAgg
|
||||
, addScalarToTyAgg
|
||||
, QueryRootFieldMap
|
||||
, MutationRootFieldMap
|
||||
, RootFields(..)
|
||||
, addQueryField
|
||||
, addMutationField
|
||||
@ -57,11 +59,14 @@ instance Semigroup TyAgg where
|
||||
instance Monoid TyAgg where
|
||||
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.
|
||||
data RootFields
|
||||
= RootFields
|
||||
{ _rootQueryFields :: !(Map.HashMap G.Name (QueryCtx, ObjFldInfo))
|
||||
, _rootMutationFields :: !(Map.HashMap G.Name (MutationCtx, ObjFldInfo))
|
||||
{ _rootQueryFields :: !QueryRootFieldMap
|
||||
, _rootMutationFields :: !MutationRootFieldMap
|
||||
} deriving (Show, Eq)
|
||||
$(makeLenses ''RootFields)
|
||||
|
||||
|
@ -2,14 +2,17 @@ module Hasura.GraphQL.Schema.Function
|
||||
( procFuncArgs
|
||||
, mkFuncArgsInp
|
||||
, mkFuncQueryFld
|
||||
, mkFuncQueryConnectionFld
|
||||
, mkFuncAggQueryFld
|
||||
, mkFuncArgsTy
|
||||
, mkFuncArgItemSeq
|
||||
) where
|
||||
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
|
||||
import Hasura.GraphQL.Resolve.Types
|
||||
import Hasura.GraphQL.Schema.Common
|
||||
import Hasura.GraphQL.Schema.Select
|
||||
import Hasura.GraphQL.Validate.Types
|
||||
@ -92,6 +95,20 @@ mkFuncQueryFld funInfo descM =
|
||||
|
||||
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(
|
||||
@ -118,3 +135,15 @@ mkFuncAggQueryFld funInfo descM =
|
||||
fldName = qualObjectToName funcName <> "_aggregate"
|
||||
|
||||
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
|
||||
, QueryRootFldResolved
|
||||
, toPGQuery
|
||||
, toSQLFromItem
|
||||
|
||||
, RIntro.schemaR
|
||||
, 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.Mutation as RM
|
||||
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.RQL.DML.Select as DS
|
||||
import qualified Hasura.SQL.DML as S
|
||||
|
||||
data QueryRootFldAST v
|
||||
= QRFPk !(DS.AnnSimpleSelG v)
|
||||
= QRFNode !(DS.AnnSimpleSelG v)
|
||||
| QRFPk !(DS.AnnSimpleSelG v)
|
||||
| QRFSimple !(DS.AnnSimpleSelG v)
|
||||
| QRFAgg !(DS.AnnAggSelG v)
|
||||
| QRFAgg !(DS.AnnAggregateSelectG v)
|
||||
| QRFConnection !(DS.ConnectionSelect v)
|
||||
| QRFActionSelect !(DS.AnnSimpleSelG v)
|
||||
| QRFActionExecuteObject !(DS.AnnSimpleSelG v)
|
||||
| QRFActionExecuteList !(DS.AnnSimpleSelG v)
|
||||
@ -58,21 +62,28 @@ traverseQueryRootFldAST
|
||||
-> QueryRootFldAST a
|
||||
-> f (QueryRootFldAST b)
|
||||
traverseQueryRootFldAST f = \case
|
||||
QRFPk s -> QRFPk <$> DS.traverseAnnSimpleSel f s
|
||||
QRFSimple s -> QRFSimple <$> DS.traverseAnnSimpleSel f s
|
||||
QRFAgg s -> QRFAgg <$> DS.traverseAnnAggSel f s
|
||||
QRFActionSelect s -> QRFActionSelect <$> DS.traverseAnnSimpleSel f s
|
||||
QRFActionExecuteObject s -> QRFActionExecuteObject <$> DS.traverseAnnSimpleSel f s
|
||||
QRFActionExecuteList s -> QRFActionExecuteList <$> DS.traverseAnnSimpleSel f s
|
||||
QRFNode s -> QRFNode <$> DS.traverseAnnSimpleSelectect f s
|
||||
QRFPk s -> QRFPk <$> DS.traverseAnnSimpleSelect f s
|
||||
QRFSimple s -> QRFSimple <$> DS.traverseAnnSimpleSelect f s
|
||||
QRFAgg s -> QRFAgg <$> DS.traverseAnnAggregateSelect f s
|
||||
QRFActionSelect s -> QRFActionSelect <$> DS.traverseAnnSimpleSelect 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 = \case
|
||||
QRFPk s -> DS.selectQuerySQL DS.JASSingleObject s
|
||||
QRFSimple s -> DS.selectQuerySQL DS.JASMultipleRows s
|
||||
QRFAgg s -> DS.selectAggQuerySQL s
|
||||
QRFActionSelect s -> DS.selectQuerySQL DS.JASSingleObject s
|
||||
QRFActionExecuteObject s -> DS.selectQuerySQL DS.JASSingleObject s
|
||||
QRFActionExecuteList s -> DS.selectQuerySQL DS.JASMultipleRows s
|
||||
QRFNode s -> first (toQuery . DS.mkSQLSelect DS.JASSingleObject) $ RR.getRemoteJoins s
|
||||
QRFPk s -> first (toQuery . DS.mkSQLSelect DS.JASSingleObject) $ RR.getRemoteJoins s
|
||||
QRFSimple s -> first (toQuery . DS.mkSQLSelect DS.JASMultipleRows) $ RR.getRemoteJoins s
|
||||
QRFAgg s -> first (toQuery . DS.mkAggregateSelect) $ RR.getRemoteJoinsAggregateSelect s
|
||||
QRFActionSelect s -> first (toQuery . DS.mkSQLSelect DS.JASSingleObject) $ RR.getRemoteJoins 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
|
||||
:: (Foldable t, QErrM m) => UserInfo -> t Text -> m ()
|
||||
@ -101,6 +112,13 @@ queryFldToPGAST fld actionExecuter = do
|
||||
opCtx <- getOpCtx $ V._fName fld
|
||||
userInfo <- asks getter
|
||||
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
|
||||
validateHdrs userInfo (_socHeaders ctx)
|
||||
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
|
||||
-- and included in the action's webhook payload.
|
||||
markNotReusable
|
||||
let f = case jsonAggType of
|
||||
let jsonAggType = RA.mkJsonAggSelect $ _saecOutputType ctx
|
||||
f = case jsonAggType of
|
||||
DS.JASMultipleRows -> QRFActionExecuteList
|
||||
DS.JASSingleObject -> QRFActionExecuteObject
|
||||
f <$> actionExecuter (RA.resolveActionQuery fld ctx (userVars userInfo))
|
||||
where
|
||||
outputType = _saecOutputType ctx
|
||||
jsonAggType = RA.mkJsonAggSelect outputType
|
||||
f <$> actionExecuter (RA.resolveActionQuery fld ctx (_uiSession userInfo))
|
||||
QCSelectConnection pk ctx ->
|
||||
QRFConnection <$> RS.convertConnectionSelect pk ctx fld
|
||||
QCFuncConnection pk ctx ->
|
||||
QRFConnection <$> RS.convertConnectionFuncQuery pk ctx fld
|
||||
|
||||
mutFldToTx
|
||||
:: ( HasVersion
|
||||
@ -187,3 +207,17 @@ getOpCtx f = do
|
||||
opCtxMap <- asks getter
|
||||
onNothing (Map.lookup f opCtxMap) $ throw500 $
|
||||
"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 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.GraphQL.Execute.Prepare
|
||||
import Hasura.GraphQL.Parser
|
||||
@ -48,9 +58,34 @@ 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.SQL.Types
|
||||
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.SQL.Types
|
||||
import Hasura.SQL.Value (PGScalarValue (..), toTxtValue)
|
||||
|
||||
newtype ActionContext
|
||||
= ActionContext {_acName :: ActionName}
|
||||
@ -136,10 +171,11 @@ resolveActionExecution
|
||||
, MonadError QErr m
|
||||
, MonadIO m
|
||||
)
|
||||
=> AnnActionExecution UnpreparedValue
|
||||
=> UserInfo
|
||||
-> AnnActionExecution UnpreparedValue
|
||||
-> ActionExecContext
|
||||
-> m (RespTx, HTTP.ResponseHeaders)
|
||||
resolveActionExecution annAction execContext = do
|
||||
resolveActionExecution userInfo annAction execContext = do
|
||||
let actionContext = ActionContext actionName
|
||||
handlerPayload = ActionWebhookPayload actionContext sessionVariables inputPayload
|
||||
(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
|
||||
selectAstUnresolved = processOutputSelectionSet webhookResponseExpression
|
||||
outputType definitionList annFields stringifyNum
|
||||
astResolved <- RS.traverseAnnSimpleSel (pure . unpreparedToTextSQL) selectAstUnresolved
|
||||
let jsonAggType = mkJsonAggSelect outputType
|
||||
return $ (,respHeaders) $ asSingleRowJsonResp (RS.selectQuerySQL jsonAggType astResolved) []
|
||||
astResolved <- RS.traverseAnnSimpleSelect (pure . unpreparedToTextSQL) selectAstUnresolved
|
||||
let (astResolvedWithoutRemoteJoins,maybeRemoteJoins) = RJ.getRemoteJoins 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
|
||||
AnnActionExecution actionName outputType annFields inputPayload
|
||||
outputFields definitionList resolvedWebhook confHeaders
|
||||
@ -177,10 +221,17 @@ restrictActionExecuter errMsg _ =
|
||||
|
||||
-- resolveActionQuery
|
||||
-- :: ( HasVersion
|
||||
-- , MonadReusability m
|
||||
-- , MonadError QErr m
|
||||
-- , MonadReader r m
|
||||
-- , MonadIO m
|
||||
-- , Has FieldMap r
|
||||
-- , Has OrdByCtx r
|
||||
-- , Has SQLGenCtx r
|
||||
-- )
|
||||
-- => UserVars
|
||||
-- => Field
|
||||
-- -> ActionExecutionContext
|
||||
-- -> SessionVariables
|
||||
-- -> HTTP.Manager
|
||||
-- -> [HTTP.Header]
|
||||
-- -> m (RS.AnnSimpleSelG UnresolvedVal)
|
||||
@ -192,9 +243,10 @@ restrictActionExecuter errMsg _ =
|
||||
-- forwardClientHeaders resolvedWebhook handlerPayload
|
||||
-- let webhookResponseExpression = RS.AEInput $ UVSQL $
|
||||
-- toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes
|
||||
-- selSet <- asObjectSelectionSet $ _fSelSet field
|
||||
-- selectAstUnresolved <-
|
||||
-- processOutputSelectionSet webhookResponseExpression outputType definitionList
|
||||
-- (_fType field) $ _fSelSet field
|
||||
-- (_fType field) selSet
|
||||
-- return selectAstUnresolved
|
||||
-- where
|
||||
-- ActionExecutionContext actionName outputType outputFields definitionList resolvedWebhook confHeaders
|
||||
@ -254,12 +306,12 @@ resolveAsyncActionQuery
|
||||
-> RS.AnnSimpleSelG UnpreparedValue
|
||||
resolveAsyncActionQuery userInfo annAction =
|
||||
let annotatedFields = asyncFields <&> second \case
|
||||
AsyncTypename t -> RS.FExp t
|
||||
AsyncTypename t -> RS.AFExpression t
|
||||
AsyncOutput annFields ->
|
||||
-- See Note [Resolving async action query/subscription]
|
||||
let inputTableArgument = RS.AETableRow $ Just $ Iden "response_payload"
|
||||
jsonAggSelect = mkJsonAggSelect outputType
|
||||
in RS.FComputedField $ RS.CFSTable jsonAggSelect $
|
||||
in RS.AFComputedField $ RS.CFSTable jsonAggSelect $
|
||||
processOutputSelectionSet inputTableArgument outputType
|
||||
definitionList annFields stringifyNumerics
|
||||
|
||||
@ -268,20 +320,20 @@ resolveAsyncActionQuery userInfo annAction =
|
||||
AsyncErrors -> mkAnnFldFromPGCol "errors" PGJSONB
|
||||
|
||||
tableFromExp = RS.FromTable actionLogTable
|
||||
tableArguments = RS.noTableArgs
|
||||
{ RS._taWhere = Just tableBoolExpression}
|
||||
tableArguments = RS.noSelectArgs
|
||||
{ RS._saWhere = Just tableBoolExpression}
|
||||
tablePermissions = RS.TablePerm annBoolExpTrue Nothing
|
||||
|
||||
in RS.AnnSelG annotatedFields tableFromExp tablePermissions
|
||||
in RS.AnnSelectG annotatedFields tableFromExp tablePermissions
|
||||
tableArguments stringifyNumerics
|
||||
where
|
||||
AnnActionAsyncQuery actionName actionId outputType asyncFields definitionList stringifyNumerics = annAction
|
||||
actionLogTable = QualifiedObject (SchemaName "hdb_catalog") (TableName "hdb_action_log")
|
||||
|
||||
-- TODO:- Avoid using PGColumnInfo
|
||||
mkAnnFldFromPGCol col columnType =
|
||||
flip RS.mkAnnColField Nothing $
|
||||
PGColumnInfo (unsafePGCol col) (G.unsafeMkName col) 0 (PGColumnScalar columnType) True Nothing
|
||||
mkAnnFldFromPGCol column columnType =
|
||||
flip RS.mkAnnColumnField Nothing $
|
||||
PGColumnInfo (unsafePGCol column) (G.unsafeMkName column) 0 (PGColumnScalar columnType) True Nothing
|
||||
|
||||
tableBoolExpression =
|
||||
let actionIdColumnInfo = PGColumnInfo (unsafePGCol "id") $$(G.litName "id")
|
||||
@ -510,12 +562,12 @@ processOutputSelectionSet
|
||||
:: RS.ArgumentExp v
|
||||
-> GraphQLType
|
||||
-> [(PGCol, PGScalarType)]
|
||||
-> RS.AnnFldsG v
|
||||
-> RS.AnnFieldsG v
|
||||
-> Bool
|
||||
-> RS.AnnSimpleSelG v
|
||||
processOutputSelectionSet tableRowInput actionOutputType definitionList
|
||||
annotatedFields =
|
||||
RS.AnnSelG annotatedFields selectFrom RS.noTablePermissions RS.noTableArgs
|
||||
RS.AnnSelectG annotatedFields selectFrom RS.noTablePermissions RS.noSelectArgs
|
||||
where
|
||||
jsonbToPostgresRecordFunction =
|
||||
QualifiedObject "pg_catalog" $ FunctionName $
|
||||
|
@ -169,6 +169,10 @@ parseColExp nt n val = do
|
||||
fmapAnnBoolExp partialSQLExpToUnresolvedVal permExp
|
||||
RFComputedField _ -> throw500
|
||||
"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
|
||||
:: ( MonadReusability m
|
||||
|
@ -23,7 +23,7 @@ module Hasura.GraphQL.Resolve.Context
|
||||
|
||||
, txtConverter
|
||||
|
||||
, withSelSet
|
||||
, traverseObjectSelectionSet
|
||||
, fieldAsPath
|
||||
, resolvePGCol
|
||||
, module Hasura.GraphQL.Utils
|
||||
@ -33,21 +33,21 @@ module Hasura.GraphQL.Resolve.Context
|
||||
import Data.Has
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
|
||||
import Hasura.GraphQL.Resolve.Types
|
||||
import Hasura.GraphQL.Utils
|
||||
import Hasura.GraphQL.Validate.Field
|
||||
import Hasura.GraphQL.Validate.SelectionSet
|
||||
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.SQL.Types
|
||||
import Hasura.SQL.Value
|
||||
|
||||
import qualified Hasura.SQL.DML as S
|
||||
import qualified Hasura.SQL.DML as S
|
||||
|
||||
getFldInfo
|
||||
:: (MonadError QErr m, MonadReader r m, Has FieldMap r)
|
||||
@ -65,9 +65,11 @@ getPGColInfo
|
||||
getPGColInfo nt n = do
|
||||
fldInfo <- getFldInfo nt n
|
||||
case fldInfo of
|
||||
RFPGColumn pgColInfo -> return pgColInfo
|
||||
RFRelationship _ -> throw500 $ mkErrMsg "relation"
|
||||
RFComputedField _ -> throw500 $ mkErrMsg "computed field"
|
||||
RFPGColumn pgColInfo -> return pgColInfo
|
||||
RFRelationship _ -> throw500 $ mkErrMsg "relation"
|
||||
RFComputedField _ -> throw500 $ mkErrMsg "computed field"
|
||||
RFRemoteRelationship _ -> throw500 $ mkErrMsg "remote relationship"
|
||||
RFNodeId _ _ -> throw500 $ mkErrMsg "node id"
|
||||
where
|
||||
mkErrMsg ty =
|
||||
"found " <> ty <> " when expecting pgcolinfo for "
|
||||
@ -139,12 +141,6 @@ prepareColVal (WithScalarType scalarType colVal) = do
|
||||
txtConverter :: Applicative f => AnnPGVal -> f S.SQLExp
|
||||
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 = nameAsPath . _fName
|
||||
|
||||
|
@ -8,34 +8,36 @@ import Data.Has
|
||||
import Hasura.EncJSON
|
||||
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 as OMap
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
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 as OMap
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Hasura.RQL.DML.Insert as RI
|
||||
import qualified Hasura.RQL.DML.Returning as RR
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Hasura.RQL.DML.Insert as RI
|
||||
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.Context
|
||||
import Hasura.GraphQL.Resolve.InputValue
|
||||
import Hasura.GraphQL.Resolve.Mutation
|
||||
import Hasura.GraphQL.Resolve.Select
|
||||
import Hasura.GraphQL.Validate.Field
|
||||
import Hasura.GraphQL.Validate.SelectionSet
|
||||
import Hasura.GraphQL.Validate.Types
|
||||
import Hasura.RQL.DML.Insert (insertOrUpdateCheckExpr)
|
||||
import Hasura.RQL.DML.Internal (convAnnBoolExpPartialSQL, convPartialSQLExp,
|
||||
dmlTxErrorHandler, sessVarFromCurrentSetting)
|
||||
import Hasura.RQL.DML.Insert (insertOrUpdateCheckExpr)
|
||||
import Hasura.RQL.DML.Internal (convAnnBoolExpPartialSQL, convPartialSQLExp,
|
||||
sessVarFromCurrentSetting)
|
||||
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.Server.Version (HasVersion)
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.SQL.Value
|
||||
|
||||
@ -473,7 +475,8 @@ convertInsert
|
||||
-> Field -- the mutation field
|
||||
-> m RespTx
|
||||
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
|
||||
annVals <- withArg arguments "objects" asArray
|
||||
-- if insert input objects is empty array then
|
||||
@ -508,7 +511,8 @@ convertInsertOne
|
||||
-> Field -- the mutation field
|
||||
-> m RespTx
|
||||
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
|
||||
mutationOutputResolved <- RR.traverseMutationOutput resolveValTxt mutationOutputUnresolved
|
||||
annInputObj <- withArg arguments "object" asObject
|
||||
|
@ -6,17 +6,19 @@ module Hasura.GraphQL.Resolve.Introspect
|
||||
import Data.Has
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson 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 Data.Aeson as J
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashSet as Set
|
||||
import qualified Data.Text as T
|
||||
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.InputValue
|
||||
import Hasura.GraphQL.Validate.Context
|
||||
import Hasura.GraphQL.Validate.Field
|
||||
import Hasura.GraphQL.Validate.InputValue
|
||||
import Hasura.GraphQL.Validate.SelectionSet
|
||||
import Hasura.GraphQL.Validate.Types
|
||||
import Hasura.RQL.Types
|
||||
|
||||
@ -35,14 +37,15 @@ instance J.ToJSON TypeKind where
|
||||
toJSON = J.toJSON . T.pack . drop 2 . show
|
||||
|
||||
withSubFields
|
||||
:: (Monad m)
|
||||
=> SelSet
|
||||
:: (MonadError QErr m)
|
||||
=> SelectionSet
|
||||
-> (Field -> m J.Value)
|
||||
-> m J.Object
|
||||
withSubFields selSet fn =
|
||||
fmap Map.fromList $ forM (toList selSet) $ \fld -> do
|
||||
val <- fn fld
|
||||
return (G.unName $ G.unAlias $ _fAlias fld, val)
|
||||
withSubFields selSet fn = do
|
||||
objectSelectionSet <- asObjectSelectionSet selSet
|
||||
Map.fromList <$> traverseObjectSelectionSet objectSelectionSet fn
|
||||
-- val <- fn fld
|
||||
-- return (G.unName $ G.unAlias $ _fAlias fld, val)
|
||||
|
||||
namedTyToTxt :: G.NamedType -> Text
|
||||
namedTyToTxt = G.unName . G.unNamedType
|
||||
@ -101,9 +104,9 @@ notBuiltinFld f =
|
||||
|
||||
getImplTypes :: (MonadReader t m, Has TypeMap t) => AsObjType -> m [ObjTyInfo]
|
||||
getImplTypes aot = do
|
||||
tyInfo :: TypeMap <- asks getter
|
||||
tyInfo <- asks getter
|
||||
return $ sortOn _otiName $
|
||||
Map.elems $ getPossibleObjTypes' tyInfo aot
|
||||
Map.elems $ getPossibleObjTypes tyInfo aot
|
||||
|
||||
-- 4.5.2.3
|
||||
unionR
|
||||
@ -139,19 +142,24 @@ ifaceR'
|
||||
=> IFaceTyInfo
|
||||
-> Field
|
||||
-> m J.Object
|
||||
ifaceR' i@(IFaceTyInfo descM n flds) fld =
|
||||
ifaceR' ifaceTyInfo fld = do
|
||||
dummyReadIncludeDeprecated fld
|
||||
withSubFields (_fSelSet fld) $ \subFld ->
|
||||
case _fName subFld of
|
||||
"__typename" -> retJT "__Type"
|
||||
"kind" -> retJ TKINTERFACE
|
||||
"name" -> retJ $ namedTyToTxt n
|
||||
"description" -> retJ $ fmap G.unDescription descM
|
||||
"fields" -> fmap J.toJSON $ mapM (`fieldR` subFld) $
|
||||
sortOn _fiName $
|
||||
filter notBuiltinFld $ Map.elems flds
|
||||
"possibleTypes" -> fmap J.toJSON $ mapM (`objectTypeR` subFld)
|
||||
=<< getImplTypes (AOTIFace i)
|
||||
_ -> return J.Null
|
||||
case _fName subFld of
|
||||
"__typename" -> retJT "__Type"
|
||||
"kind" -> retJ TKINTERFACE
|
||||
"name" -> retJ $ namedTyToTxt name
|
||||
"description" -> retJ $ fmap G.unDescription maybeDescription
|
||||
"fields" -> fmap J.toJSON $ mapM (`fieldR` subFld) $
|
||||
sortOn _fiName $
|
||||
filter notBuiltinFld $ Map.elems fields
|
||||
"possibleTypes" -> fmap J.toJSON $ mapM (`objectTypeR` subFld)
|
||||
=<< getImplTypes (AOTIFace ifaceTyInfo)
|
||||
_ -> return J.Null
|
||||
where
|
||||
maybeDescription = _ifDesc ifaceTyInfo
|
||||
name = _ifName ifaceTyInfo
|
||||
fields = _ifFields ifaceTyInfo
|
||||
|
||||
-- 4.5.2.5
|
||||
enumTypeR
|
||||
@ -161,14 +169,64 @@ enumTypeR
|
||||
-> m J.Object
|
||||
enumTypeR (EnumTyInfo descM n vals _) fld =
|
||||
withSubFields (_fSelSet fld) $ \subFld ->
|
||||
case _fName subFld of
|
||||
"__typename" -> retJT "__Type"
|
||||
"kind" -> retJ TKENUM
|
||||
"name" -> retJ $ namedTyToTxt n
|
||||
"description" -> retJ $ fmap G.unDescription descM
|
||||
"enumValues" -> fmap J.toJSON $ mapM (enumValueR subFld) $
|
||||
sortOn _eviVal $ Map.elems (normalizeEnumValues vals)
|
||||
_ -> return J.Null
|
||||
case _fName subFld of
|
||||
"__typename" -> retJT "__Type"
|
||||
"kind" -> retJ TKENUM
|
||||
"name" -> retJ $ namedTyToTxt n
|
||||
"description" -> retJ $ fmap G.unDescription descM
|
||||
"enumValues" -> do
|
||||
includeDeprecated <- readIncludeDeprecated subFld
|
||||
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
|
||||
inputObjR
|
||||
@ -276,7 +334,7 @@ inputValueR fld (InpValInfo descM n defM ty) =
|
||||
|
||||
-- 4.5.5
|
||||
enumValueR
|
||||
:: (Monad m)
|
||||
:: (MonadError QErr m)
|
||||
=> Field -> EnumValInfo -> m J.Object
|
||||
enumValueR fld (EnumValInfo descM enumVal isDeprecated) =
|
||||
withSubFields (_fSelSet fld) $ \subFld ->
|
||||
|
@ -33,7 +33,7 @@ import Hasura.GraphQL.Resolve.BoolExp
|
||||
import Hasura.GraphQL.Resolve.Context
|
||||
import Hasura.GraphQL.Resolve.InputValue
|
||||
import Hasura.GraphQL.Resolve.Select (processTableSelectionSet)
|
||||
import Hasura.GraphQL.Validate.Field
|
||||
import Hasura.GraphQL.Validate.SelectionSet
|
||||
import Hasura.GraphQL.Validate.Types
|
||||
import Hasura.RQL.DML.Internal (currentSession, sessVarFromCurrentSetting)
|
||||
import Hasura.RQL.Types
|
||||
@ -44,15 +44,16 @@ resolveMutationFields
|
||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||
, Has OrdByCtx r, Has SQLGenCtx r
|
||||
)
|
||||
=> G.NamedType -> SelSet -> m (RR.MutFldsG UnresolvedVal)
|
||||
=> G.NamedType -> ObjectSelectionSet -> m (RR.MutFldsG UnresolvedVal)
|
||||
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
|
||||
"affected_rows" -> return RR.MCount
|
||||
"returning" -> do
|
||||
annFlds <- processTableSelectionSet (_fType fld) $ _fSelSet fld
|
||||
annFlds <- asObjectSelectionSet (_fSelSet fld)
|
||||
>>= processTableSelectionSet (_fType fld)
|
||||
annFldsResolved <- traverse
|
||||
(traverse (RS.traverseAnnFld convertPGValueToTextValue)) annFlds
|
||||
(traverse (RS.traverseAnnField convertPGValueToTextValue)) annFlds
|
||||
return $ RR.MRet annFldsResolved
|
||||
G.Name t -> throw500 $ "unexpected field in mutation resp : " <> t
|
||||
where
|
||||
@ -321,8 +322,9 @@ mutationFieldsResolver
|
||||
, Has OrdByCtx r, Has SQLGenCtx r
|
||||
)
|
||||
=> Field -> m (RR.MutationOutputG UnresolvedVal)
|
||||
mutationFieldsResolver field =
|
||||
RR.MOutMultirowFields <$> resolveMutationFields (_fType field) (_fSelSet field)
|
||||
mutationFieldsResolver field = do
|
||||
asObjectSelectionSet (_fSelSet field) >>= \selSet ->
|
||||
RR.MOutMultirowFields <$> resolveMutationFields (_fType field) selSet
|
||||
|
||||
tableSelectionAsMutationOutput
|
||||
:: ( MonadReusability m, MonadError QErr m
|
||||
@ -331,7 +333,8 @@ tableSelectionAsMutationOutput
|
||||
)
|
||||
=> Field -> m (RR.MutationOutputG UnresolvedVal)
|
||||
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
|
||||
buildEmptyMutResp :: RR.MutationOutput -> EncJSON
|
||||
|
@ -1,37 +1,47 @@
|
||||
module Hasura.GraphQL.Resolve.Select
|
||||
( convertSelect
|
||||
, convertConnectionSelect
|
||||
, convertConnectionFuncQuery
|
||||
, convertSelectByPKey
|
||||
, convertAggSelect
|
||||
, convertFuncQuerySimple
|
||||
, convertFuncQueryAgg
|
||||
, parseColumns
|
||||
, processTableSelectionSet
|
||||
, resolveNodeId
|
||||
, convertNodeSelect
|
||||
, AnnSimpleSelect
|
||||
) where
|
||||
|
||||
import Control.Lens ((^?), _2)
|
||||
import Control.Lens (to, (^..), (^?), _2)
|
||||
import Data.Has
|
||||
import Data.Parser.JSONPath
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
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 Data.Aeson as J
|
||||
import qualified Data.Aeson.Internal as J
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashMap.Strict.InsOrd as OMap
|
||||
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.SQL.DML as S
|
||||
import qualified Hasura.RQL.DML.Select as RS
|
||||
import qualified Hasura.SQL.DML as S
|
||||
|
||||
import Hasura.GraphQL.Resolve.BoolExp
|
||||
import Hasura.GraphQL.Resolve.Context
|
||||
import Hasura.GraphQL.Resolve.InputValue
|
||||
import Hasura.GraphQL.Schema (isAggFld)
|
||||
import Hasura.GraphQL.Validate.Field
|
||||
import Hasura.GraphQL.Schema (isAggregateField)
|
||||
import Hasura.GraphQL.Schema.Common (mkTableTy)
|
||||
import Hasura.GraphQL.Validate
|
||||
import Hasura.GraphQL.Validate.SelectionSet
|
||||
import Hasura.GraphQL.Validate.Types
|
||||
import Hasura.RQL.DML.Internal (onlyPositiveInt)
|
||||
import Hasura.RQL.DML.Internal (onlyPositiveInt)
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Utils
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.SQL.Value
|
||||
|
||||
@ -45,27 +55,29 @@ jsonPathToColExp t = case parseJSONPath t of
|
||||
elToColExp (Index i) = S.SELit $ T.pack (show i)
|
||||
|
||||
|
||||
argsToColOp :: (MonadReusability m, MonadError QErr m) => ArgsMap -> m (Maybe RS.ColOp)
|
||||
argsToColOp args = maybe (return Nothing) toOp $ Map.lookup "path" args
|
||||
where
|
||||
toJsonPathExp = fmap (RS.ColOp S.jsonbPathOp) . jsonPathToColExp
|
||||
toOp v = asPGColTextM v >>= traverse toJsonPathExp
|
||||
argsToColumnOp :: (MonadReusability m, MonadError QErr m) => ArgsMap -> m (Maybe RS.ColumnOp)
|
||||
argsToColumnOp args = case Map.lookup "path" args of
|
||||
Nothing -> return Nothing
|
||||
Just txt -> do
|
||||
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
|
||||
:: ( MonadReusability m, MonadReader r m, Has FieldMap r
|
||||
, 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
|
||||
funcArgs <- parseFunctionArgs argSeq argFn $ Map.lookup "args" $ _fArguments fld
|
||||
let argsWithTableArgument = withTableArgument funcArgs
|
||||
case fieldType of
|
||||
CFTScalar scalarTy -> do
|
||||
colOpM <- argsToColOp $ _fArguments fld
|
||||
colOpM <- argsToColumnOp $ _fArguments fld
|
||||
pure $ RS.CFSScalar $
|
||||
RS.ComputedFieldScalarSel qf argsWithTableArgument scalarTy colOpM
|
||||
RS.ComputedFieldScalarSelectect qf argsWithTableArgument scalarTy colOpM
|
||||
CFTTable (ComputedFieldTable _ cols permFilter permLimit) -> do
|
||||
let functionFrom = RS.FromFunction qf argsWithTableArgument Nothing
|
||||
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
|
||||
, Has OrdByCtx r, Has SQLGenCtx r
|
||||
)
|
||||
=> G.NamedType -> SelSet -> m AnnFlds
|
||||
=> G.NamedType -> ObjectSelectionSet -> m AnnFields
|
||||
processTableSelectionSet fldTy flds =
|
||||
forM (toList flds) $ \fld -> do
|
||||
fmap (map (\(a, b) -> (FieldName a, b))) $ traverseObjectSelectionSet flds $ \fld -> do
|
||||
let fldName = _fName fld
|
||||
let rqlFldName = FieldName $ G.unName $ G.unAlias $ _fAlias fld
|
||||
(rqlFldName,) <$> case fldName of
|
||||
"__typename" -> return $ RS.FExp $ G.unName $ G.unNamedType fldTy
|
||||
case fldName of
|
||||
"__typename" -> return $ RS.AFExpression $ G.unName $ G.unNamedType fldTy
|
||||
_ -> do
|
||||
fldInfo <- getFldInfo fldTy fldName
|
||||
case fldInfo of
|
||||
RFNodeId tn pkeys -> pure $ RS.AFNodeId tn pkeys
|
||||
RFPGColumn colInfo ->
|
||||
RS.mkAnnColField colInfo <$> argsToColOp (_fArguments fld)
|
||||
RS.mkAnnColumnField colInfo <$> argsToColumnOp (_fArguments fld)
|
||||
RFComputedField computedField ->
|
||||
RS.FComputedField <$> resolveComputedField computedField fld
|
||||
RFRelationship (RelationshipField relInfo isAgg colGNameMap tableFilter tableLimit) -> do
|
||||
RS.AFComputedField <$> resolveComputedField computedField fld
|
||||
RFRelationship (RelationshipField relInfo fieldKind colGNameMap tableFilter tableLimit) -> do
|
||||
let relTN = riRTable relInfo
|
||||
colMapping = riMapping relInfo
|
||||
rn = riName relInfo
|
||||
if isAgg then do
|
||||
aggSel <- fromAggField (RS.FromTable relTN) colGNameMap tableFilter tableLimit fld
|
||||
return $ RS.FArr $ RS.ASAgg $ RS.AnnRelG rn colMapping aggSel
|
||||
else do
|
||||
annSel <- fromField (RS.FromTable relTN) colGNameMap tableFilter tableLimit fld
|
||||
let annRel = RS.AnnRelG rn colMapping annSel
|
||||
return $ case riType relInfo of
|
||||
ObjRel -> RS.FObj annRel
|
||||
ArrRel -> RS.FArr $ RS.ASSimple annRel
|
||||
case fieldKind of
|
||||
RFKSimple -> do
|
||||
annSel <- fromField (RS.FromTable relTN) colGNameMap tableFilter tableLimit fld
|
||||
let annRel = RS.AnnRelationSelectG rn colMapping annSel
|
||||
pure $ case riType relInfo of
|
||||
ObjRel -> RS.AFObjectRelation annRel
|
||||
ArrRel -> RS.AFArrayRelation $ RS.ASSimple annRel
|
||||
RFKAggregate -> do
|
||||
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
|
||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap 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 $
|
||||
withSelSet selSet $ \f -> do
|
||||
let fTy = _fType f
|
||||
fSelSet = _fSelSet f
|
||||
case _fName f of
|
||||
traverseObjectSelectionSet selSet $ \Field{..} ->
|
||||
case _fName of
|
||||
"__typename" -> return $ RS.TAFExp $ G.unName $ G.unNamedType fldTy
|
||||
"aggregate" -> RS.TAFAgg <$> convertAggFld colGNameMap fTy fSelSet
|
||||
"nodes" -> RS.TAFNodes <$> processTableSelectionSet fTy fSelSet
|
||||
"aggregate" -> do
|
||||
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
|
||||
|
||||
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
|
||||
, Has FieldMap r, Has OrdByCtx r
|
||||
)
|
||||
=> PGColGNameMap -> ArgsMap -> m TableArgs
|
||||
parseTableArgs colGNameMap args = do
|
||||
=> PGColGNameMap -> ArgsMap -> m SelectArgs
|
||||
parseSelectArgs colGNameMap args = do
|
||||
whereExpM <- withArgM args "where" parseBoolExp
|
||||
ordByExpML <- withArgM args "order_by" parseOrderBy
|
||||
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
|
||||
distOnColsML <- withArgM args "distinct_on" $ parseColumns colGNameMap
|
||||
let distOnColsM = NE.nonEmpty =<< distOnColsML
|
||||
mapM_ (validateDistOn ordByExpM) distOnColsM
|
||||
return $ RS.TableArgs whereExpM ordByExpM limitExpM offsetExpM distOnColsM
|
||||
return $ RS.SelectArgs whereExpM ordByExpM limitExpM offsetExpM distOnColsM
|
||||
where
|
||||
validateDistOn Nothing _ = return ()
|
||||
validateDistOn (Just ordBys) cols = withPathK "args" $ do
|
||||
let colsLen = length cols
|
||||
initOrdBys = take colsLen $ toList ordBys
|
||||
initOrdByCols = flip mapMaybe initOrdBys $ \ob ->
|
||||
case obiColumn ob of
|
||||
RS.AOCPG pgCol -> Just pgCol
|
||||
_ -> Nothing
|
||||
case obiColumn ob of
|
||||
RS.AOCColumn pgCol -> Just $ pgiColumn pgCol
|
||||
_ -> Nothing
|
||||
isValid = (colsLen == length initOrdByCols)
|
||||
&& all (`elem` initOrdByCols) (toList cols)
|
||||
|
||||
@ -175,12 +252,13 @@ fromField
|
||||
-> Maybe Int
|
||||
-> Field -> m AnnSimpleSelect
|
||||
fromField selFrom colGNameMap permFilter permLimitM fld = fieldAsPath fld $ do
|
||||
tableArgs <- parseTableArgs colGNameMap args
|
||||
annFlds <- processTableSelectionSet (_fType fld) $ _fSelSet fld
|
||||
tableArgs <- parseSelectArgs colGNameMap args
|
||||
selSet <- asObjectSelectionSet $ _fSelSet fld
|
||||
annFlds <- processTableSelectionSet (_fType fld) selSet
|
||||
let unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter
|
||||
let tabPerm = RS.TablePerm unresolvedPermFltr permLimitM
|
||||
strfyNum <- stringifyNum <$> asks getter
|
||||
return $ RS.AnnSelG annFlds selFrom tabPerm tableArgs strfyNum
|
||||
return $ RS.AnnSelectG annFlds selFrom tabPerm tableArgs strfyNum
|
||||
where
|
||||
args = _fArguments fld
|
||||
|
||||
@ -201,7 +279,8 @@ parseOrderBy
|
||||
, MonadReader r m
|
||||
, Has OrdByCtx r
|
||||
)
|
||||
=> AnnInpVal -> m [RS.AnnOrderByItemG UnresolvedVal]
|
||||
=> AnnInpVal
|
||||
-> m [RS.AnnOrderByItemG UnresolvedVal]
|
||||
parseOrderBy = fmap concat . withArray f
|
||||
where
|
||||
f _ = mapM (withObject (getAnnObItems id))
|
||||
@ -212,7 +291,7 @@ getAnnObItems
|
||||
, MonadReader r m
|
||||
, Has OrdByCtx r
|
||||
)
|
||||
=> (RS.AnnObColG UnresolvedVal -> RS.AnnObColG UnresolvedVal)
|
||||
=> (RS.AnnOrderByElement UnresolvedVal -> RS.AnnOrderByElement UnresolvedVal)
|
||||
-> G.NamedType
|
||||
-> AnnGObject
|
||||
-> m [RS.AnnOrderByItemG UnresolvedVal]
|
||||
@ -224,7 +303,7 @@ getAnnObItems f nt obj = do
|
||||
<> showNamedTy nt <> " map"
|
||||
case ordByItem of
|
||||
OBIPGCol ci -> do
|
||||
let aobCol = f $ RS.AOCPG $ pgiColumn ci
|
||||
let aobCol = f $ RS.AOCColumn ci
|
||||
(_, enumValM) <- asEnumValM v
|
||||
ordByItemM <- forM enumValM $ \enumVal -> do
|
||||
(ordTy, nullsOrd) <- parseOrderByEnum enumVal
|
||||
@ -233,13 +312,13 @@ getAnnObItems f nt obj = do
|
||||
|
||||
OBIRel ri fltr -> do
|
||||
let unresolvedFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal fltr
|
||||
let annObColFn = f . RS.AOCObj ri unresolvedFltr
|
||||
let annObColFn = f . RS.AOCObjectRelation ri unresolvedFltr
|
||||
flip withObjectM v $ \nameTy objM ->
|
||||
maybe (pure []) (getAnnObItems annObColFn nameTy) objM
|
||||
|
||||
OBIAgg ri relColGNameMap fltr -> do
|
||||
let unresolvedFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal fltr
|
||||
let aobColFn = f . RS.AOCAgg ri unresolvedFltr
|
||||
let aobColFn = f . RS.AOCArrayAggregation ri unresolvedFltr
|
||||
flip withObjectM v $ \_ objM ->
|
||||
maybe (pure []) (parseAggOrdBy relColGNameMap aobColFn) objM
|
||||
|
||||
@ -250,7 +329,7 @@ mkOrdByItemG ordTy aobCol nullsOrd =
|
||||
parseAggOrdBy
|
||||
:: (MonadReusability m, MonadError QErr m)
|
||||
=> PGColGNameMap
|
||||
-> (RS.AnnAggOrdBy -> RS.AnnObColG UnresolvedVal)
|
||||
-> (RS.AnnAggregateOrderBy -> RS.AnnOrderByElement UnresolvedVal)
|
||||
-> AnnGObject
|
||||
-> m [RS.AnnOrderByItemG UnresolvedVal]
|
||||
parseAggOrdBy colGNameMap f annObj =
|
||||
@ -263,14 +342,14 @@ parseAggOrdBy colGNameMap f annObj =
|
||||
return $ mkOrdByItemG ordTy (f RS.AAOCount) nullsOrd
|
||||
return $ maybe [] pure ordByItemM
|
||||
|
||||
G.Name opT ->
|
||||
G.Name opText ->
|
||||
flip withObject obVal $ \_ opObObj -> fmap catMaybes $
|
||||
forM (OMap.toList opObObj) $ \(colName, eVal) -> do
|
||||
(_, enumValM) <- asEnumValM eVal
|
||||
forM enumValM $ \enumVal -> do
|
||||
(ordTy, nullsOrd) <- parseOrderByEnum enumVal
|
||||
col <- pgiColumn <$> resolvePGCol colGNameMap colName
|
||||
let aobCol = f $ RS.AAOOp opT col
|
||||
col <- resolvePGCol colGNameMap colName
|
||||
let aobCol = f $ RS.AAOOp opText col
|
||||
return $ mkOrdByItemG ordTy aobCol nullsOrd
|
||||
|
||||
parseOrderByEnum
|
||||
@ -287,15 +366,14 @@ parseOrderByEnum = \case
|
||||
G.EnumValue v -> throw500 $
|
||||
"enum value " <> showName v <> " not found in type order_by"
|
||||
|
||||
parseLimit :: (MonadReusability m, MonadError QErr m) => AnnInpVal -> m Int
|
||||
parseLimit v = do
|
||||
parseNonNegativeInt
|
||||
:: (MonadReusability m, MonadError QErr m) => Text -> AnnInpVal -> m Int
|
||||
parseNonNegativeInt errMsg v = do
|
||||
pgColVal <- openOpaqueValue =<< asPGColumnValue v
|
||||
limit <- maybe noIntErr return . pgColValueToInt . pstValue $ _apvValue pgColVal
|
||||
limit <- maybe (throwVE errMsg) return . pgColValueToInt . pstValue $ _apvValue pgColVal
|
||||
-- validate int value
|
||||
onlyPositiveInt limit
|
||||
return limit
|
||||
where
|
||||
noIntErr = throwVE "expecting Integer value for \"limit\""
|
||||
|
||||
type AnnSimpleSel = RS.AnnSimpleSelG UnresolvedVal
|
||||
|
||||
@ -311,14 +389,15 @@ fromFieldByPKey
|
||||
-> AnnBoolExpPartialSQL -> Field -> m AnnSimpleSel
|
||||
fromFieldByPKey tn colArgMap permFilter fld = fieldAsPath fld $ do
|
||||
boolExp <- pgColValToBoolExp colArgMap $ _fArguments fld
|
||||
annFlds <- processTableSelectionSet fldTy $ _fSelSet fld
|
||||
selSet <- asObjectSelectionSet $ _fSelSet fld
|
||||
annFlds <- processTableSelectionSet fldTy selSet
|
||||
let tabFrom = RS.FromTable tn
|
||||
unresolvedPermFltr = fmapAnnBoolExp partialSQLExpToUnresolvedVal
|
||||
permFilter
|
||||
tabPerm = RS.TablePerm unresolvedPermFltr Nothing
|
||||
tabArgs = RS.noTableArgs { RS._taWhere = Just boolExp}
|
||||
tabArgs = RS.noSelectArgs { RS._saWhere = Just boolExp}
|
||||
strfyNum <- stringifyNum <$> asks getter
|
||||
return $ RS.AnnSelG annFlds tabFrom tabPerm tabArgs strfyNum
|
||||
return $ RS.AnnSelectG annFlds tabFrom tabPerm tabArgs strfyNum
|
||||
where
|
||||
fldTy = _fType fld
|
||||
|
||||
@ -345,14 +424,18 @@ convertSelectByPKey opCtx fld =
|
||||
SelPkOpCtx qt _ permFilter colArgMap = opCtx
|
||||
|
||||
-- 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 =
|
||||
flip withArray val $ \_ vals ->
|
||||
forM vals $ \v -> do
|
||||
(_, G.EnumValue enumVal) <- asEnumVal v
|
||||
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
|
||||
columnsM <- withArgM args "columns" $ parseColumns colGNameMap
|
||||
isDistinct <- or <$> withArgM args "distinct" parseDistinct
|
||||
@ -371,34 +454,33 @@ convertCount colGNameMap args = do
|
||||
toFields :: [(T.Text, a)] -> RS.Fields a
|
||||
toFields = map (first FieldName)
|
||||
|
||||
convertColFlds
|
||||
convertColumnFields
|
||||
:: (MonadError QErr m)
|
||||
=> PGColGNameMap -> G.NamedType -> SelSet -> m RS.ColFlds
|
||||
convertColFlds colGNameMap ty selSet = fmap toFields $
|
||||
withSelSet selSet $ \fld ->
|
||||
=> PGColGNameMap -> G.NamedType -> ObjectSelectionSet -> m RS.ColumnFields
|
||||
convertColumnFields colGNameMap ty selSet = fmap toFields $
|
||||
traverseObjectSelectionSet selSet $ \fld ->
|
||||
case _fName fld of
|
||||
"__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)
|
||||
=> PGColGNameMap -> G.NamedType -> SelSet -> m RS.AggFlds
|
||||
convertAggFld colGNameMap ty selSet = fmap toFields $
|
||||
withSelSet selSet $ \fld -> do
|
||||
let fType = _fType fld
|
||||
fSelSet = _fSelSet fld
|
||||
case _fName fld of
|
||||
=> PGColGNameMap -> G.NamedType -> ObjectSelectionSet -> m RS.AggregateFields
|
||||
convertAggregateField colGNameMap ty selSet = fmap toFields $
|
||||
traverseObjectSelectionSet selSet $ \Field{..} ->
|
||||
case _fName of
|
||||
"__typename" -> return $ RS.AFExp $ G.unName $ G.unNamedType ty
|
||||
"count" -> RS.AFCount <$> convertCount colGNameMap (_fArguments fld)
|
||||
n -> do
|
||||
colFlds <- convertColFlds colGNameMap fType fSelSet
|
||||
unless (isAggFld n) $ throwInvalidFld n
|
||||
return $ RS.AFOp $ RS.AggOp (G.unName n) colFlds
|
||||
fSelSet <- asObjectSelectionSet _fSelSet
|
||||
colFlds <- convertColumnFields colGNameMap _fType fSelSet
|
||||
unless (isAggregateField n) $ throwInvalidFld n
|
||||
return $ RS.AFOp $ RS.AggregateOp (G.unName n) colFlds
|
||||
where
|
||||
throwInvalidFld (G.Name t) =
|
||||
throw500 $ "unexpected field in _aggregate node: " <> t
|
||||
|
||||
type AnnAggSel = RS.AnnAggSelG UnresolvedVal
|
||||
type AnnAggregateSelect = RS.AnnAggregateSelectG UnresolvedVal
|
||||
|
||||
fromAggField
|
||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||
@ -408,29 +490,162 @@ fromAggField
|
||||
-> PGColGNameMap
|
||||
-> AnnBoolExpPartialSQL
|
||||
-> Maybe Int
|
||||
-> Field -> m AnnAggSel
|
||||
-> Field -> m AnnAggregateSelect
|
||||
fromAggField selectFrom colGNameMap permFilter permLimit fld = fieldAsPath fld $ do
|
||||
tableArgs <- parseTableArgs colGNameMap args
|
||||
aggSelFlds <- fromAggSelSet colGNameMap (_fType fld) (_fSelSet fld)
|
||||
tableArgs <- parseSelectArgs colGNameMap args
|
||||
selSet <- asObjectSelectionSet $ _fSelSet fld
|
||||
aggSelFlds <- fromAggSelSet colGNameMap (_fType fld) selSet
|
||||
let unresolvedPermFltr =
|
||||
fmapAnnBoolExp partialSQLExpToUnresolvedVal permFilter
|
||||
let tabPerm = RS.TablePerm unresolvedPermFltr permLimit
|
||||
strfyNum <- stringifyNum <$> asks getter
|
||||
return $ RS.AnnSelG aggSelFlds selectFrom tabPerm tableArgs strfyNum
|
||||
return $ RS.AnnSelectG aggSelFlds selectFrom tabPerm tableArgs strfyNum
|
||||
where
|
||||
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
|
||||
:: ( MonadReusability m, MonadError QErr m, MonadReader r m, Has FieldMap r
|
||||
, Has OrdByCtx r, Has SQLGenCtx r
|
||||
)
|
||||
=> SelOpCtx -> Field -> m (RS.AnnAggSelG UnresolvedVal)
|
||||
=> SelOpCtx -> Field -> m (RS.AnnAggregateSelectG UnresolvedVal)
|
||||
convertAggSelect opCtx fld =
|
||||
withPathK "selectionSet" $
|
||||
fromAggField (RS.FromTable qt) colGNameMap permFilter permLimit fld
|
||||
where
|
||||
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
|
||||
:: (MonadReusability m, MonadError QErr m)
|
||||
=> Seq.Seq a
|
||||
@ -506,10 +721,77 @@ convertFuncQueryAgg
|
||||
, Has OrdByCtx r
|
||||
, Has SQLGenCtx r
|
||||
)
|
||||
=> FuncQOpCtx -> Field -> m AnnAggSel
|
||||
=> FuncQOpCtx -> Field -> m AnnAggregateSelect
|
||||
convertFuncQueryAgg funcOpCtx fld =
|
||||
withPathK "selectionSet" $ fieldAsPath fld $ do
|
||||
selectFrom <- makeFunctionSelectFrom qf argSeq fld
|
||||
fromAggField selectFrom colGNameMap permFilter permLimit fld
|
||||
where
|
||||
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 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.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
@ -27,12 +30,17 @@ import Hasura.SQL.Value
|
||||
|
||||
import qualified Hasura.SQL.DML as S
|
||||
|
||||
type NodeSelectMap = Map.HashMap G.NamedType SelOpCtx
|
||||
|
||||
data QueryCtx
|
||||
= QCSelect !SelOpCtx
|
||||
= QCNodeSelect !NodeSelectMap
|
||||
| QCSelect !SelOpCtx
|
||||
| QCSelectConnection !(NonEmpty PGColumnInfo) !SelOpCtx
|
||||
| QCSelectPkey !SelPkOpCtx
|
||||
| QCSelectAgg !SelOpCtx
|
||||
| QCFuncQuery !FuncQOpCtx
|
||||
| QCFuncAggQuery !FuncQOpCtx
|
||||
| QCFuncConnection !(NonEmpty PGColumnInfo) !FuncQOpCtx
|
||||
| QCAsyncActionFetch !ActionSelectOpContext
|
||||
| QCAction !ActionExecutionContext
|
||||
deriving (Show, Eq)
|
||||
@ -130,10 +138,16 @@ data ActionSelectOpContext
|
||||
-- used in resolvers
|
||||
type PGColGNameMap = Map.HashMap G.Name PGColumnInfo
|
||||
|
||||
data RelationshipFieldKind
|
||||
= RFKAggregate
|
||||
| RFKSimple
|
||||
| RFKConnection !(NonEmpty PGColumnInfo)
|
||||
deriving (Show, Eq)
|
||||
|
||||
data RelationshipField
|
||||
= RelationshipField
|
||||
{ _rfInfo :: !RelInfo
|
||||
, _rfIsAgg :: !Bool
|
||||
, _rfIsAgg :: !RelationshipFieldKind
|
||||
, _rfCols :: !PGColGNameMap
|
||||
, _rfPermFilter :: !AnnBoolExpPartialSQL
|
||||
, _rfPermLimit :: !(Maybe Int)
|
||||
@ -166,6 +180,8 @@ data ResolveField
|
||||
= RFPGColumn !PGColumnInfo
|
||||
| RFRelationship !RelationshipField
|
||||
| RFComputedField !ComputedField
|
||||
| RFRemoteRelationship !RemoteFieldInfo
|
||||
| RFNodeId !QualifiedTable !(NonEmpty PGColumnInfo)
|
||||
deriving (Show, Eq)
|
||||
|
||||
type FieldMap = Map.HashMap (G.NamedType, G.Name) ResolveField
|
||||
@ -245,6 +261,13 @@ data InputFunctionArgument
|
||||
| IFAUnknown !FunctionArgItem -- ^ Unknown value, need to be parsed
|
||||
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
|
||||
$(makePrisms ''ResolveField)
|
||||
$(makeLenses ''ComputedField)
|
||||
|
@ -132,7 +132,7 @@ actionIdParser =
|
||||
actionOutputFields
|
||||
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m, Has QueryContext r)
|
||||
=> AnnotatedObjectType
|
||||
-> MaybeT m (Parser 'Output n (RQL.AnnFldsG UnpreparedValue))
|
||||
-> MaybeT m (Parser 'Output n (RQL.AnnFieldsG UnpreparedValue))
|
||||
actionOutputFields outputObject = do
|
||||
let scalarOrEnumFields = map scalarOrEnumFieldParser $ toList $ _otdFields outputObject
|
||||
relationshipFields <- forM (_otdRelationships outputObject) $ traverse relationshipFieldParser
|
||||
@ -141,11 +141,11 @@ actionOutputFields outputObject = do
|
||||
outputTypeName = unObjectTypeName $ _otdName outputObject
|
||||
outputTypeDescription = _otdDescription outputObject
|
||||
pure $ P.selectionSet outputTypeName outputTypeDescription allFieldParsers
|
||||
<&> parsedSelectionsToFields RQL.FExp
|
||||
<&> parsedSelectionsToFields RQL.AFExpression
|
||||
where
|
||||
scalarOrEnumFieldParser
|
||||
:: ObjectFieldDefinition (G.GType, AnnotatedObjectFieldType)
|
||||
-> FieldParser n (RQL.AnnFldG UnpreparedValue)
|
||||
-> FieldParser n (RQL.AnnFieldG UnpreparedValue)
|
||||
scalarOrEnumFieldParser (ObjectFieldDefinition name _ description ty) =
|
||||
let (gType, objectFieldType) = ty
|
||||
fieldName = unObjectFieldName name
|
||||
@ -157,11 +157,11 @@ actionOutputFields outputObject = do
|
||||
AOFTEnum def -> customEnumParser def
|
||||
in bool P.nonNullableField id (G.isNullable gType) $
|
||||
P.selection_ (unObjectFieldName name) description fieldParser
|
||||
$> RQL.mkAnnColField pgColumnInfo Nothing
|
||||
$> RQL.mkAnnColumnField pgColumnInfo Nothing
|
||||
|
||||
relationshipFieldParser
|
||||
:: TypeRelationship TableInfo PGColumnInfo
|
||||
-> MaybeT m (FieldParser n (RQL.AnnFldG UnpreparedValue))
|
||||
-> MaybeT m (FieldParser n (RQL.AnnFieldG UnpreparedValue))
|
||||
relationshipFieldParser typeRelationship = do
|
||||
let TypeRelationship relName relType tableInfo fieldMapping = typeRelationship
|
||||
tableName = _tciName $ _tiCoreInfo tableInfo
|
||||
@ -175,10 +175,10 @@ actionOutputFields outputObject = do
|
||||
[ (unsafePGCol $ G.unName $ unObjectFieldName k, pgiColumn v)
|
||||
| (k, v) <- Map.toList fieldMapping
|
||||
]
|
||||
annotatedRelationship = RQL.AnnRelG tableRelName columnMapping selectExp
|
||||
annotatedRelationship = RQL.AnnRelationSelectG tableRelName columnMapping selectExp
|
||||
in case relType of
|
||||
ObjRel -> RQL.FObj annotatedRelationship
|
||||
ArrRel -> RQL.FArr $ RQL.ASSimple annotatedRelationship
|
||||
ObjRel -> RQL.AFObjectRelation annotatedRelationship
|
||||
ArrRel -> RQL.AFArrayRelation $ RQL.ASSimple annotatedRelationship
|
||||
|
||||
mkDefinitionList :: AnnotatedObjectType -> [(PGCol, PGScalarType)]
|
||||
mkDefinitionList annotatedOutputType =
|
||||
|
@ -52,7 +52,7 @@ orderByExp table selectPermissions = memoizeOn 'orderByExp table $ do
|
||||
FIColumn columnInfo -> do
|
||||
let fieldName = pgiName columnInfo
|
||||
pure $ P.fieldOptional fieldName Nothing orderByOperator
|
||||
<&> fmap (pure . mkOrderByItemG (RQL.AOCPG $ pgiColumn columnInfo)) . join
|
||||
<&> fmap (pure . mkOrderByItemG (RQL.AOCColumn columnInfo)) . join
|
||||
FIRelationship relationshipInfo -> do
|
||||
let remoteTable = riRTable 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
|
||||
pure $ do
|
||||
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
|
||||
let aggregateFieldName = fieldName <> $$(G.litName "_aggregate")
|
||||
aggregationParser <- lift $ orderByAggregation remoteTable perms
|
||||
pure $ do
|
||||
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
|
||||
FIRemoteRelationship _ -> empty
|
||||
|
||||
@ -84,7 +84,7 @@ orderByAggregation
|
||||
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
||||
=> QualifiedTable
|
||||
-> SelPermInfo
|
||||
-> m (Parser 'Input n [OrderByItemG RQL.AnnAggOrdBy])
|
||||
-> m (Parser 'Input n [OrderByItemG RQL.AnnAggregateOrderBy])
|
||||
orderByAggregation table selectPermissions = do
|
||||
-- WIP NOTE
|
||||
-- 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 <<> "\""
|
||||
pure $ P.object objectName (Just description) aggFields
|
||||
where
|
||||
mkField :: PGColumnInfo -> InputFieldsParser n (Maybe (PGCol, OrderInfo))
|
||||
mkField :: PGColumnInfo -> InputFieldsParser n (Maybe (PGColumnInfo, OrderInfo))
|
||||
mkField columnInfo =
|
||||
P.fieldOptional (pgiName columnInfo) (pgiDescription columnInfo) orderByOperator
|
||||
<&> fmap (pgiColumn columnInfo,) . join
|
||||
<&> fmap (columnInfo,) . join
|
||||
|
||||
parseOperator
|
||||
:: G.Name
|
||||
-> G.Name
|
||||
-> InputFieldsParser n [(PGCol, OrderInfo)]
|
||||
-> InputFieldsParser n (Maybe [OrderByItemG RQL.AnnAggOrdBy])
|
||||
-> InputFieldsParser n [(PGColumnInfo, OrderInfo)]
|
||||
-> InputFieldsParser n (Maybe [OrderByItemG RQL.AnnAggregateOrderBy])
|
||||
parseOperator operator tableName columns =
|
||||
let opText = G.unName operator
|
||||
-- FIXME: isn't G.Name a Monoid?
|
||||
|
@ -51,11 +51,11 @@ import Hasura.SQL.Value
|
||||
|
||||
|
||||
type SelectExp = RQL.AnnSimpleSelG UnpreparedValue
|
||||
type AggSelectExp = RQL.AnnAggSelG UnpreparedValue
|
||||
type TableArgs = RQL.TableArgsG UnpreparedValue
|
||||
type AggSelectExp = RQL.AnnAggregateSelectG UnpreparedValue
|
||||
type SelectArgs = RQL.SelectArgsG UnpreparedValue
|
||||
type TablePerms = RQL.TablePermG UnpreparedValue
|
||||
type AnnotatedFields = RQL.AnnFldsG UnpreparedValue
|
||||
type AnnotatedField = RQL.AnnFldG UnpreparedValue
|
||||
type AnnotatedFields = RQL.AnnFieldsG UnpreparedValue
|
||||
type AnnotatedField = RQL.AnnFieldG UnpreparedValue
|
||||
|
||||
|
||||
|
||||
@ -83,7 +83,7 @@ selectTable table fieldName description selectPermissions = do
|
||||
tableArgsParser <- tableArgs table selectPermissions
|
||||
selectionSetParser <- tableSelectionSet table selectPermissions Nothing
|
||||
pure $ P.subselection fieldName description tableArgsParser selectionSetParser
|
||||
<&> \(args, fields) -> RQL.AnnSelG
|
||||
<&> \(args, fields) -> RQL.AnnSelectG
|
||||
{ RQL._asnFields = fields
|
||||
, RQL._asnFrom = RQL.FromTable table
|
||||
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
||||
@ -121,13 +121,13 @@ selectTableByPk table fieldName description selectPermissions = runMaybeT do
|
||||
<&> \(boolExpr, fields) ->
|
||||
let defaultPerms = tablePermissionsInfo selectPermissions
|
||||
whereExpr = Just $ BoolAnd $ toList boolExpr
|
||||
in RQL.AnnSelG
|
||||
in RQL.AnnSelectG
|
||||
{ RQL._asnFields = fields
|
||||
, RQL._asnFrom = RQL.FromTable table
|
||||
, RQL._asnPerm = defaultPerms { RQL._tpLimit = Nothing }
|
||||
-- TODO: check whether this is necessary: ^^^^^^^
|
||||
-- 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
|
||||
}
|
||||
|
||||
@ -161,7 +161,7 @@ selectTableAggregate table fieldName description selectPermissions = runMaybeT d
|
||||
, RQL.TAFAgg <$> P.subselection_ $$(G.litName "aggregate") Nothing aggregateParser
|
||||
]
|
||||
pure $ P.subselection fieldName description tableArgsParser aggregationParser
|
||||
<&> \(args, fields) -> RQL.AnnSelG
|
||||
<&> \(args, fields) -> RQL.AnnSelectG
|
||||
{ RQL._asnFields = fields
|
||||
, RQL._asnFrom = RQL.FromTable table
|
||||
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
||||
@ -249,7 +249,7 @@ tableSelectionSet table selectPermissions interfaceM = memoizeOn 'tableSelection
|
||||
|
||||
let description = G.Description . getPGDescription <$> _tciDescription tableInfo
|
||||
pure $ P.selectionSetObject tableName description fieldParsers (toList interfaceM)
|
||||
<&> parsedSelectionsToFields RQL.FExp
|
||||
<&> parsedSelectionsToFields RQL.AFExpression
|
||||
|
||||
|
||||
-- | User-defined function (AKA custom function)
|
||||
@ -268,7 +268,7 @@ selectFunction function fieldName description selectPermissions = do
|
||||
selectionSetParser <- tableSelectionSet table selectPermissions Nothing
|
||||
let argsParser = liftA2 (,) functionArgsParser tableArgsParser
|
||||
pure $ P.subselection fieldName description argsParser selectionSetParser
|
||||
<&> \((funcArgs, tableArgs'), fields) -> RQL.AnnSelG
|
||||
<&> \((funcArgs, tableArgs'), fields) -> RQL.AnnSelectG
|
||||
{ RQL._asnFields = fields
|
||||
, RQL._asnFrom = RQL.FromFunction (fiName function) funcArgs Nothing
|
||||
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
||||
@ -299,7 +299,7 @@ selectFunctionAggregate function fieldName description selectPermissions = runMa
|
||||
, RQL.TAFAgg <$> P.subselection_ $$(G.litName "aggregate") Nothing aggregateParser
|
||||
]
|
||||
pure $ P.subselection fieldName description argsParser aggregationParser
|
||||
<&> \((funcArgs, tableArgs'), fields) -> RQL.AnnSelG
|
||||
<&> \((funcArgs, tableArgs'), fields) -> RQL.AnnSelectG
|
||||
{ RQL._asnFields = fields
|
||||
, RQL._asnFrom = RQL.FromFunction (fiName function) funcArgs Nothing
|
||||
, RQL._asnPerm = tablePermissionsInfo selectPermissions
|
||||
@ -323,7 +323,7 @@ tableArgs
|
||||
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
||||
=> QualifiedTable
|
||||
-> SelPermInfo
|
||||
-> m (InputFieldsParser n TableArgs)
|
||||
-> m (InputFieldsParser n SelectArgs)
|
||||
tableArgs table selectPermissions = do
|
||||
boolExpParser <- boolExp table (Just 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
|
||||
-- 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
|
||||
-- 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.
|
||||
--
|
||||
-- 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
|
||||
-- the check at Resolve/Select.hs:152 must be ported here
|
||||
|
||||
pure $ RQL.TableArgs
|
||||
{ RQL._taWhere = whereF
|
||||
, RQL._taOrderBy = nonEmpty . concat =<< orderBy
|
||||
, RQL._taLimit = fromIntegral <$> limit
|
||||
, RQL._taOffset = txtEncoder . PGValInteger <$> offset
|
||||
, RQL._taDistCols = nonEmpty =<< distinct
|
||||
pure $ RQL.SelectArgs
|
||||
{ RQL._saWhere = whereF
|
||||
, RQL._saOrderBy = nonEmpty . concat =<< orderBy
|
||||
, RQL._saLimit = fromIntegral <$> limit
|
||||
, RQL._saOffset = txtEncoder . PGValInteger <$> offset
|
||||
, RQL._saDistinct = nonEmpty =<< distinct
|
||||
}
|
||||
where
|
||||
-- TH splices mess up ApplicativeDo
|
||||
@ -398,7 +398,7 @@ tableAggregationFields
|
||||
:: forall m n r. (MonadSchema n m, MonadTableInfo r m, MonadRole r m)
|
||||
=> QualifiedTable
|
||||
-> SelPermInfo
|
||||
-> m (Parser 'Output n RQL.AggFlds)
|
||||
-> m (Parser 'Output n RQL.AggregateFields)
|
||||
tableAggregationFields table selectPermissions = do
|
||||
tableName <- qualifiedObjectToName table
|
||||
allColumns <- tableSelectColumns table selectPermissions
|
||||
@ -447,7 +447,7 @@ tableAggregationFields table selectPermissions = do
|
||||
:: G.Name
|
||||
-> G.Name
|
||||
-> [FieldParser n RQL.PGColFld]
|
||||
-> FieldParser n RQL.AggFld
|
||||
-> FieldParser n RQL.AggregateField
|
||||
parseOperator operator tableName columns =
|
||||
let opText = G.unName operator
|
||||
setName = tableName <> $$(G.litName "_") <> operator <> $$(G.litName "_fields")
|
||||
@ -455,7 +455,7 @@ tableAggregationFields table selectPermissions = do
|
||||
subselectionParser = P.selectionSet setName setDesc columns
|
||||
<&> parsedSelectionsToFields RQL.PCFExp
|
||||
in P.subselection_ operator Nothing subselectionParser
|
||||
<&> (RQL.AFOp . RQL.AggOp opText)
|
||||
<&> (RQL.AFOp . RQL.AggregateOp opText)
|
||||
|
||||
lookupRemoteField'
|
||||
:: (MonadSchema n m, MonadTableInfo r m)
|
||||
@ -499,7 +499,7 @@ fieldSelection fieldInfo selectPermissions = do
|
||||
pathArg = jsonPathArg $ pgiType columnInfo
|
||||
field <- lift $ P.column (pgiType columnInfo) (G.Nullability $ pgiIsNullable columnInfo)
|
||||
pure $ P.selection fieldName (pgiDescription columnInfo) pathArg field
|
||||
<&> RQL.mkAnnColField columnInfo
|
||||
<&> RQL.mkAnnColumnField columnInfo
|
||||
|
||||
FIRelationship relationshipInfo -> concat . maybeToList <$> runMaybeT do
|
||||
-- TODO: move this to a separate function?
|
||||
@ -514,10 +514,10 @@ fieldSelection fieldInfo selectPermissions = do
|
||||
relFieldName <- lift $ textToName $ relNameToTxt relName
|
||||
otherTableParser <- lift $ selectTable otherTable relFieldName desc remotePerms
|
||||
let field = otherTableParser <&> \selectExp ->
|
||||
let annotatedRelationship = RQL.AnnRelG relName colMapping selectExp
|
||||
let annotatedRelationship = RQL.AnnRelationSelectG relName colMapping selectExp
|
||||
in case riType relationshipInfo of
|
||||
ObjRel -> RQL.FObj annotatedRelationship
|
||||
ArrRel -> RQL.FArr $ RQL.ASSimple annotatedRelationship
|
||||
ObjRel -> RQL.AFObjectRelation annotatedRelationship
|
||||
ArrRel -> RQL.AFArrayRelation $ RQL.ASSimple annotatedRelationship
|
||||
case riType relationshipInfo of
|
||||
ObjRel -> pure [field]
|
||||
ArrRel -> do
|
||||
@ -525,7 +525,7 @@ fieldSelection fieldInfo selectPermissions = do
|
||||
relAggDesc = Just $ G.Description "An aggregate relationship"
|
||||
remoteAggField <- lift $ selectTableAggregate otherTable relAggFieldName relAggDesc remotePerms
|
||||
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 ->
|
||||
@ -562,7 +562,7 @@ fieldSelection fieldInfo selectPermissions = do
|
||||
pure $ pure $ P.unsafeRawField (P.mkDefinition fieldName Nothing fieldInfo')
|
||||
`P.bindField` \G.Field{ G._fArguments = args, G._fSelectionSet = selSet } -> do
|
||||
remoteArgs <- P.ifParser remoteFieldsArgumentsParser args
|
||||
pure $ RQL.FRemote $ RQL.RemoteSelect
|
||||
pure $ RQL.AFRemote $ RQL.RemoteSelect
|
||||
{ _rselArgs = remoteArgs
|
||||
, _rselSelection = selSet
|
||||
, _rselHasuraColumns = _rfiHasuraFields remoteFieldInfo
|
||||
@ -697,7 +697,7 @@ computedFieldFunctionArgs ComputedFieldFunction{..} =
|
||||
|
||||
|
||||
-- FIXME: move to common?
|
||||
jsonPathArg :: MonadParse n => PGColumnType -> InputFieldsParser n (Maybe RQL.ColOp)
|
||||
jsonPathArg :: MonadParse n => PGColumnType -> InputFieldsParser n (Maybe RQL.ColumnOp)
|
||||
jsonPathArg columnType
|
||||
| isScalarColumnWhere isJSONType columnType =
|
||||
P.fieldOptional fieldName description P.string `P.bindFields` traverse toColExp
|
||||
@ -707,7 +707,7 @@ jsonPathArg columnType
|
||||
description = Just "JSON select path"
|
||||
toColExp textValue = case parseJSONPath textValue of
|
||||
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 (Index i) = SQL.SELit $ T.pack (show i)
|
||||
|
||||
@ -726,7 +726,7 @@ computedField ComputedFieldInfo{..} selectPermissions = runMaybeT do
|
||||
let fieldArgsParser = do
|
||||
args <- functionArgsParser
|
||||
colOp <- jsonPathArg $ PGColumnScalar scalarReturnType
|
||||
pure $ RQL.FComputedField $ RQL.CFSScalar $ RQL.ComputedFieldScalarSel
|
||||
pure $ RQL.AFComputedField $ RQL.CFSScalar $ RQL.ComputedFieldScalarSelect
|
||||
{ RQL._cfssFunction = _cffName _cfiFunction
|
||||
, RQL._cfssType = scalarReturnType
|
||||
, RQL._cfssColumnOp = colOp
|
||||
@ -741,7 +741,7 @@ computedField ComputedFieldInfo{..} selectPermissions = runMaybeT do
|
||||
let fieldArgsParser = liftA2 (,) functionArgsParser selectArgsParser
|
||||
pure $ P.subselection fieldName Nothing fieldArgsParser selectionSetParser <&>
|
||||
\((functionArgs', args), fields) ->
|
||||
RQL.FComputedField $ RQL.CFSTable RQL.JASMultipleRows $ RQL.AnnSelG
|
||||
RQL.AFComputedField $ RQL.CFSTable RQL.JASMultipleRows $ RQL.AnnSelectG
|
||||
{ RQL._asnFields = fields
|
||||
, RQL._asnFrom = RQL.FromFunction (_cffName _cfiFunction) functionArgs' Nothing
|
||||
, RQL._asnPerm = tablePermissionsInfo remotePerms
|
||||
@ -891,16 +891,16 @@ nodeField allTables = do
|
||||
(perms, pkeyColumns, fields) <-
|
||||
onNothing (Map.lookup table parseds) $ throwInvalidNodeId $ "the table " <>> ident
|
||||
whereExp <- buildNodeIdBoolExp columnValues pkeyColumns
|
||||
return $ RQL.AnnSelG
|
||||
return $ RQL.AnnSelectG
|
||||
{ RQL._asnFields = fields
|
||||
, RQL._asnFrom = RQL.FromTable table
|
||||
, RQL._asnPerm = tablePermissionsInfo perms
|
||||
, RQL._asnArgs = RQL.TableArgs
|
||||
{ RQL._taWhere = Just whereExp
|
||||
, RQL._taOrderBy = Nothing
|
||||
, RQL._taLimit = Nothing
|
||||
, RQL._taOffset = Nothing
|
||||
, RQL._taDistCols = Nothing
|
||||
, RQL._asnArgs = RQL.SelectArgs
|
||||
{ RQL._saWhere = Just whereExp
|
||||
, RQL._saOrderBy = Nothing
|
||||
, RQL._saLimit = Nothing
|
||||
, RQL._saOffset = Nothing
|
||||
, RQL._saDistinct = Nothing
|
||||
}
|
||||
, RQL._asnStrfyNum = stringifyNum
|
||||
}
|
||||
|
@ -44,7 +44,7 @@ runGQ reqId userInfo reqHdrs queryType req = do
|
||||
(telemTimeTot_DT, (telemCacheHit, telemLocality, (telemTimeIO_DT, telemQueryType, !resp))) <- withElapsedTime $ do
|
||||
E.ExecutionCtx _ sqlGenCtx pgExecCtx planCache sc scVer httpManager enableAL <- ask
|
||||
(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
|
||||
E.QueryExecutionPlan queryPlan -> do
|
||||
case queryPlan of
|
||||
@ -76,8 +76,8 @@ runGQ reqId userInfo reqHdrs queryType req = do
|
||||
return (telemCacheHit, Telem.Local, (telemTimeIO, telemQueryType, HttpResponse resp respHdrs))
|
||||
E.GExPRemote rsi opDef -> do
|
||||
let telemQueryType | G._todType opDef == G.OperationTypeMutation = Telem.Mutation
|
||||
| otherwise = Telem.Query
|
||||
(telemTimeIO, resp) <- E.execRemoteGQ reqId userInfo reqHdrs req rsi opDef
|
||||
| otherwise = Telem.Query
|
||||
(telemTimeIO, resp) <- E.execRemoteGQ reqId userInfo reqHdrs req rsi $ G._todType opDef
|
||||
return (telemCacheHit, Telem.Remote, (telemTimeIO, telemQueryType, resp))
|
||||
-}
|
||||
let telemTimeIO = fromUnits telemTimeIO_DT
|
||||
|
@ -1,8 +1,8 @@
|
||||
module Hasura.GraphQL.Validate
|
||||
( validateGQ
|
||||
, showVars
|
||||
, RootSelSet(..)
|
||||
, SelSet
|
||||
, RootSelectionSet(..)
|
||||
, SelectionSet(..)
|
||||
, Field(..)
|
||||
, getTypedOp
|
||||
, QueryParts(..)
|
||||
@ -13,6 +13,9 @@ module Hasura.GraphQL.Validate
|
||||
, validateVariablesForReuse
|
||||
|
||||
, isQueryInAllowlist
|
||||
, unValidateArgsMap
|
||||
, unValidateSelectionSet
|
||||
, unValidateField
|
||||
) where
|
||||
|
||||
import Hasura.Prelude
|
||||
@ -22,16 +25,24 @@ import Data.Has
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
import qualified Data.HashSet as HS
|
||||
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 Hasura.GraphQL.NormalForm
|
||||
import Hasura.GraphQL.Resolve.InputValue (annInpValueToJson)
|
||||
import Hasura.GraphQL.Schema
|
||||
import Hasura.GraphQL.Transport.HTTP.Protocol
|
||||
import Hasura.GraphQL.Validate.Context
|
||||
import Hasura.GraphQL.Validate.Field
|
||||
import Hasura.GraphQL.Validate.InputValue
|
||||
import Hasura.GraphQL.Validate.SelectionSet
|
||||
import Hasura.GraphQL.Validate.Types
|
||||
import Hasura.RQL.DML.Select.Types
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.RQL.Types.QueryCollection
|
||||
import Hasura.SQL.Time
|
||||
import Hasura.SQL.Value
|
||||
|
||||
data QueryParts
|
||||
= QueryParts
|
||||
@ -137,19 +148,12 @@ validateFrag
|
||||
validateFrag (G.FragmentDefinition n onTy dirs selSet) = do
|
||||
unless (null dirs) $ throwVE
|
||||
"unexpected directives at fragment definition"
|
||||
tyInfo <- getTyInfoVE onTy
|
||||
objTyInfo <- onNothing (getObjTyM tyInfo) $ throwVE
|
||||
"fragments can only be defined on object types"
|
||||
return $ FragDef n objTyInfo selSet
|
||||
|
||||
data RootSelSet
|
||||
= RQuery !SelSet
|
||||
| RMutation !SelSet
|
||||
| RSubscription !Field
|
||||
deriving (Show, Eq)
|
||||
fragmentTypeInfo <- getFragmentTyInfo onTy
|
||||
return $ FragDef n fragmentTypeInfo selSet
|
||||
|
||||
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
|
||||
ctx <- ask
|
||||
|
||||
@ -165,19 +169,22 @@ validateGQ (QueryParts opDef opRoot fragDefsL varValsM) = do
|
||||
-- build a validation ctx
|
||||
let valCtx = ValidationCtx (_gTypes ctx) annVarVals annFragDefs
|
||||
|
||||
selSet <- flip runReaderT valCtx $ denormSelSet [] opRoot $
|
||||
selSet <- flip runReaderT valCtx $ parseObjectSelectionSet valCtx opRoot $
|
||||
G._todSelectionSet opDef
|
||||
|
||||
case G._todType opDef of
|
||||
G.OperationTypeQuery -> return $ RQuery selSet
|
||||
G.OperationTypeMutation -> return $ RMutation selSet
|
||||
G.OperationTypeSubscription ->
|
||||
case Seq.viewl selSet of
|
||||
Seq.EmptyL -> throw500 "empty selset for subscription"
|
||||
fld Seq.:< rst -> do
|
||||
unless (null rst) $
|
||||
throwVE "subscription must select only one top level field"
|
||||
return $ RSubscription fld
|
||||
case OMap.toList $ unAliasedFields $ unObjectSelectionSet selSet of
|
||||
[] -> throw500 "empty selset for subscription"
|
||||
(_:rst) -> do
|
||||
-- As an internal testing feature, we support subscribing to multiple
|
||||
-- selection sets. First check if the corresponding directive is set.
|
||||
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 q = HS.member gqlQuery
|
||||
@ -204,3 +211,119 @@ getQueryParts (GQLReq opNameM q varValsM) = do
|
||||
return $ QueryParts opDef opRoot fragDefsL varValsM
|
||||
where
|
||||
(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
|
||||
, getTyInfo
|
||||
, getTyInfoVE
|
||||
, getFragmentTyInfo
|
||||
, module Hasura.GraphQL.Utils
|
||||
) where
|
||||
|
||||
@ -19,11 +20,11 @@ import Hasura.RQL.Types
|
||||
|
||||
getFieldInfo
|
||||
:: ( MonadError QErr m)
|
||||
=> ObjTyInfo -> G.Name -> m ObjFldInfo
|
||||
getFieldInfo oti fldName =
|
||||
onNothing (Map.lookup fldName $ _otiFields oti) $ throwVE $
|
||||
=> G.NamedType -> ObjFieldMap -> G.Name -> m ObjFldInfo
|
||||
getFieldInfo typeName fieldMap fldName =
|
||||
onNothing (Map.lookup fldName fieldMap) $ throwVE $
|
||||
"field " <> showName fldName <>
|
||||
" not found in type: " <> showNamedTy (_otiName oti)
|
||||
" not found in type: " <> showNamedTy typeName
|
||||
|
||||
getInpFieldInfo
|
||||
:: ( MonadError QErr m)
|
||||
@ -65,3 +66,13 @@ getTyInfoVE namedTy = do
|
||||
tyMap <- asks getter
|
||||
onNothing (Map.lookup namedTy tyMap) $
|
||||
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
|
||||
|
||||
import Hasura.EncJSON
|
||||
-- import Hasura.GraphQL.NormalForm
|
||||
import Hasura.GraphQL.RemoteServer
|
||||
-- import Hasura.GraphQL.Schema.Merge
|
||||
import Hasura.Prelude
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
@ -121,3 +124,34 @@ fetchRemoteSchemas =
|
||||
where
|
||||
fromRow (name, Q.AltJ 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.EventTrigger
|
||||
import Hasura.RQL.DDL.RemoteSchema
|
||||
-- import Hasura.RQL.DDL.ScheduledTrigger
|
||||
import Hasura.RQL.DDL.Schema.Cache.Common
|
||||
import Hasura.RQL.DDL.Schema.Cache.Dependencies
|
||||
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
|
||||
{ scTables = _boTables resolvedOutputs
|
||||
, scActions = _boActions resolvedOutputs
|
||||
|
@ -71,7 +71,7 @@ mutateAndFetchCols qt cols (cte, p) strfyNum =
|
||||
tabFrom = FromIden aliasIden
|
||||
tabPerm = TablePerm annBoolExpTrue Nothing
|
||||
selFlds = flip map cols $
|
||||
\ci -> (fromPGCol $ pgiColumn ci, mkAnnColFieldAsText ci)
|
||||
\ci -> (fromPGCol $ pgiColumn ci, mkAnnColumnFieldAsText ci)
|
||||
|
||||
sql = toSQL selectWith
|
||||
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]
|
||||
}
|
||||
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.
|
||||
-- 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 Data.List (nub)
|
||||
import Data.Validation
|
||||
import Data.Scientific (toBoundedInteger, toRealFloat)
|
||||
import Data.Validation
|
||||
|
||||
import Hasura.EncJSON
|
||||
import Hasura.GraphQL.Parser
|
||||
import Hasura.GraphQL.RemoteServer (execRemoteGQ')
|
||||
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.Returning
|
||||
import Hasura.RQL.DML.Returning.Types
|
||||
import Hasura.RQL.DML.Select.Types
|
||||
import Hasura.RQL.Types
|
||||
import Hasura.Server.Version (HasVersion)
|
||||
import Hasura.SQL.Types ((<<>))
|
||||
import Hasura.Session
|
||||
import Hasura.SQL.Types ((<<>))
|
||||
|
||||
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 Network.HTTP.Client as HTTP
|
||||
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.
|
||||
executeQueryWithRemoteJoins
|
||||
@ -106,7 +101,7 @@ pathToAlias path counter = do
|
||||
parseGraphQLName $ T.intercalate "_" (map getFieldNameTxt $ unFieldPath path)
|
||||
<> "__" <> (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
|
||||
= RemoteJoin
|
||||
{ _rjName :: !FieldName -- ^ The remote join field name.
|
||||
@ -139,14 +134,14 @@ transformSelect path sel = do
|
||||
pure sel{_asnFields = transformedFields}
|
||||
|
||||
-- | Traverse through @'AnnAggregateSelect' and collect remote join fields (if any).
|
||||
getRemoteJoinsAggregateSelect :: AnnAggSel -> (AnnAggSel, Maybe RemoteJoins)
|
||||
getRemoteJoinsAggregateSelect :: AnnAggregateSelect -> (AnnAggregateSelect, Maybe RemoteJoins)
|
||||
getRemoteJoinsAggregateSelect =
|
||||
second mapToNonEmpty . flip runState mempty . transformAggregateSelect mempty
|
||||
|
||||
transformAggregateSelect
|
||||
:: FieldPath
|
||||
-> AnnAggSel
|
||||
-> State RemoteJoinMap AnnAggSel
|
||||
-> AnnAggregateSelect
|
||||
-> State RemoteJoinMap AnnAggregateSelect
|
||||
transformAggregateSelect path sel = do
|
||||
let aggFields = _asnFields sel
|
||||
transformedFields <- forM aggFields $ \(fieldName, aggField) ->
|
||||
@ -156,32 +151,32 @@ transformAggregateSelect path sel = do
|
||||
TAFExp t -> pure $ TAFExp t
|
||||
pure sel{_asnFields = transformedFields}
|
||||
|
||||
-- -- | Traverse through @'ConnectionSelect' and collect remote join fields (if any).
|
||||
-- getRemoteJoinsConnectionSelect :: ConnectionSelect S.SQLExp -> (ConnectionSelect S.SQLExp, Maybe RemoteJoins)
|
||||
-- getRemoteJoinsConnectionSelect =
|
||||
-- second mapToNonEmpty . flip runState mempty . transformConnectionSelect mempty
|
||||
-- | Traverse through @'ConnectionSelect' and collect remote join fields (if any).
|
||||
getRemoteJoinsConnectionSelect :: ConnectionSelect S.SQLExp -> (ConnectionSelect S.SQLExp, Maybe RemoteJoins)
|
||||
getRemoteJoinsConnectionSelect =
|
||||
second mapToNonEmpty . flip runState mempty . transformConnectionSelect mempty
|
||||
|
||||
-- transformConnectionSelect
|
||||
-- :: FieldPath
|
||||
-- -> ConnectionSelect S.SQLExp
|
||||
-- -> State RemoteJoinMap (ConnectionSelect S.SQLExp)
|
||||
-- transformConnectionSelect path ConnectionSelect{..} = do
|
||||
-- let connectionFields = _asnFields _csSelect
|
||||
-- transformedFields <- forM connectionFields $ \(fieldName, field) ->
|
||||
-- (fieldName,) <$> case field of
|
||||
-- ConnectionTypename t -> pure $ ConnectionTypename t
|
||||
-- ConnectionPageInfo p -> pure $ ConnectionPageInfo p
|
||||
-- ConnectionEdges edges -> ConnectionEdges <$> transformEdges (appendPath fieldName path) edges
|
||||
-- let select = _csSelect{_asnFields = transformedFields}
|
||||
-- pure $ ConnectionSelect _csPrimaryKeyColumns _csSplit _csSlice select
|
||||
-- where
|
||||
-- transformEdges edgePath edgeFields =
|
||||
-- forM edgeFields $ \(fieldName, edgeField) ->
|
||||
-- (fieldName,) <$> case edgeField of
|
||||
-- EdgeTypename t -> pure $ EdgeTypename t
|
||||
-- EdgeCursor -> pure EdgeCursor
|
||||
-- EdgeNode annFields ->
|
||||
-- EdgeNode <$> transformAnnFields (appendPath fieldName edgePath) annFields
|
||||
transformConnectionSelect
|
||||
:: FieldPath
|
||||
-> ConnectionSelect S.SQLExp
|
||||
-> State RemoteJoinMap (ConnectionSelect S.SQLExp)
|
||||
transformConnectionSelect path ConnectionSelect{..} = do
|
||||
let connectionFields = _asnFields _csSelect
|
||||
transformedFields <- forM connectionFields $ \(fieldName, field) ->
|
||||
(fieldName,) <$> case field of
|
||||
ConnectionTypename t -> pure $ ConnectionTypename t
|
||||
ConnectionPageInfo p -> pure $ ConnectionPageInfo p
|
||||
ConnectionEdges edges -> ConnectionEdges <$> transformEdges (appendPath fieldName path) edges
|
||||
let select = _csSelect{_asnFields = transformedFields}
|
||||
pure $ ConnectionSelect _csPrimaryKeyColumns _csSplit _csSlice select
|
||||
where
|
||||
transformEdges edgePath edgeFields =
|
||||
forM edgeFields $ \(fieldName, edgeField) ->
|
||||
(fieldName,) <$> case edgeField of
|
||||
EdgeTypename t -> pure $ EdgeTypename t
|
||||
EdgeCursor -> pure EdgeCursor
|
||||
EdgeNode annFields ->
|
||||
EdgeNode <$> transformAnnFields (appendPath fieldName edgePath) annFields
|
||||
|
||||
-- | Traverse through 'MutationOutput' and collect remote join fields (if any)
|
||||
getRemoteJoinsMutationOutput :: MutationOutput -> (MutationOutput, Maybe RemoteJoins)
|
||||
@ -203,10 +198,10 @@ getRemoteJoinsMutationOutput =
|
||||
MExp t -> pure $ MExp t
|
||||
MRet annFields -> MRet <$> transformAnnFields fieldPath annFields
|
||||
|
||||
transformAnnFields :: FieldPath -> AnnFlds -> State RemoteJoinMap AnnFlds
|
||||
transformAnnFields :: FieldPath -> AnnFields -> State RemoteJoinMap AnnFields
|
||||
transformAnnFields path fields = do
|
||||
let pgColumnFields = map fst $ getFields _FCol fields
|
||||
remoteSelects = getFields _FRemote fields
|
||||
let pgColumnFields = map fst $ getFields _AFColumn fields
|
||||
remoteSelects = getFields _AFRemote fields
|
||||
remoteJoins = flip map remoteSelects $ \(fieldName, remoteSelect) ->
|
||||
let RemoteSelect argsMap selSet hasuraColumns remoteFields rsi = remoteSelect
|
||||
hasuraColumnL = toList hasuraColumns
|
||||
@ -217,44 +212,46 @@ transformAnnFields path fields = do
|
||||
transformedFields <- forM fields $ \(fieldName, field') -> do
|
||||
let fieldPath = appendPath fieldName path
|
||||
(fieldName,) <$> case field' of
|
||||
FCol c -> pure $ FCol c
|
||||
FObj annRel ->
|
||||
FObj <$> transformAnnRelation fieldPath annRel
|
||||
FArr (ASSimple annRel) ->
|
||||
FArr . ASSimple <$> transformAnnRelation fieldPath annRel
|
||||
FArr (ASAgg aggRel) ->
|
||||
FArr . ASAgg <$> transformAnnAggregateRelation fieldPath aggRel
|
||||
-- AFArrayRelation (ASConnection annRel) ->
|
||||
-- AFArrayRelation . ASConnection <$> transformArrayConnection fieldPath annRel
|
||||
FComputedField computedField ->
|
||||
FComputedField <$> case computedField of
|
||||
AFNodeId qt pkeys -> pure $ AFNodeId qt pkeys
|
||||
AFColumn c -> pure $ AFColumn c
|
||||
AFObjectRelation annRel ->
|
||||
AFObjectRelation <$> transformAnnRelation fieldPath annRel
|
||||
AFArrayRelation (ASSimple annRel) ->
|
||||
AFArrayRelation . ASSimple <$> transformAnnRelation fieldPath annRel
|
||||
AFArrayRelation (ASAggregate aggRel) ->
|
||||
AFArrayRelation . ASAggregate <$> transformAnnAggregateRelation fieldPath aggRel
|
||||
AFArrayRelation (ASConnection annRel) ->
|
||||
AFArrayRelation . ASConnection <$> transformArrayConnection fieldPath annRel
|
||||
AFComputedField computedField ->
|
||||
AFComputedField <$> case computedField of
|
||||
CFSScalar _ -> pure computedField
|
||||
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
|
||||
Nothing -> pure transformedFields
|
||||
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
|
||||
modify (Map.insert path nonEmptyRemoteJoins)
|
||||
pure $ transformedFields <> phantomColumns
|
||||
where
|
||||
getFields f = mapMaybe (sequence . second (^? f))
|
||||
transformAnnRelation fieldPath annRel = do
|
||||
let annSel = aarAnnSel annRel
|
||||
let annSel = aarAnnSelect annRel
|
||||
transformedSel <- transformSelect fieldPath annSel
|
||||
pure annRel{aarAnnSel = transformedSel}
|
||||
pure annRel{aarAnnSelect = transformedSel}
|
||||
|
||||
transformAnnAggregateRelation fieldPath annRel = do
|
||||
let annSel = aarAnnSel annRel
|
||||
let annSel = aarAnnSelect annRel
|
||||
transformedSel <- transformAggregateSelect fieldPath annSel
|
||||
pure annRel{aarAnnSel = transformedSel}
|
||||
pure annRel{aarAnnSelect = transformedSel}
|
||||
|
||||
-- transformArrayConnection fieldPath annRel = do
|
||||
-- let connectionSelect = aarAnnSelect annRel
|
||||
-- transformedConnectionSelect <- transformConnectionSelect fieldPath connectionSelect
|
||||
-- pure annRel{aarAnnSelect = transformedConnectionSelect}
|
||||
transformArrayConnection fieldPath annRel = do
|
||||
let connectionSelect = aarAnnSelect annRel
|
||||
transformedConnectionSelect <- transformConnectionSelect fieldPath connectionSelect
|
||||
pure annRel{aarAnnSelect = transformedConnectionSelect}
|
||||
|
||||
type CompositeObject a = OMap.InsOrdHashMap Text (CompositeValue a)
|
||||
|
||||
@ -338,7 +335,7 @@ traverseQueryResponseJSON rjm =
|
||||
A.Number val ->
|
||||
case (toBoundedInteger val) of
|
||||
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.Object vals ->
|
||||
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 Hasura.SQL.DML as S
|
||||
|
||||
|
||||
traverseMutFld
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
@ -19,8 +18,7 @@ traverseMutFld
|
||||
traverseMutFld f = \case
|
||||
MCount -> pure MCount
|
||||
MExp t -> pure $ MExp t
|
||||
MRet flds -> MRet <$> traverse (traverse (traverseAnnFld f)) flds
|
||||
|
||||
MRet flds -> MRet <$> traverse (traverse (traverseAnnField f)) flds
|
||||
|
||||
traverseMutationOutput
|
||||
:: (Applicative f)
|
||||
@ -30,7 +28,7 @@ traverseMutationOutput f = \case
|
||||
MOutMultirowFields mutationFields ->
|
||||
MOutMultirowFields <$> traverse (traverse (traverseMutFld f)) mutationFields
|
||||
MOutSinglerowObject annFields ->
|
||||
MOutSinglerowObject <$> traverseAnnFlds f annFields
|
||||
MOutSinglerowObject <$> traverseAnnFields f annFields
|
||||
|
||||
traverseMutFlds
|
||||
:: (Applicative f)
|
||||
@ -43,15 +41,15 @@ traverseMutFlds f =
|
||||
hasNestedFld :: MutationOutputG a -> Bool
|
||||
hasNestedFld = \case
|
||||
MOutMultirowFields flds -> any isNestedMutFld flds
|
||||
MOutSinglerowObject annFlds -> any isNestedAnnFld annFlds
|
||||
MOutSinglerowObject annFlds -> any isNestedAnnField annFlds
|
||||
where
|
||||
isNestedMutFld (_, mutFld) = case mutFld of
|
||||
MRet annFlds -> any isNestedAnnFld annFlds
|
||||
MRet annFlds -> any isNestedAnnField annFlds
|
||||
_ -> False
|
||||
isNestedAnnFld (_, annFld) = case annFld of
|
||||
FObj _ -> True
|
||||
FArr _ -> True
|
||||
_ -> False
|
||||
isNestedAnnField (_, annFld) = case annFld of
|
||||
AFObjectRelation _ -> True
|
||||
AFArrayRelation _ -> True
|
||||
_ -> False
|
||||
|
||||
pgColsFromMutFld :: MutFld -> [(PGCol, PGColumnType)]
|
||||
pgColsFromMutFld = \case
|
||||
@ -59,16 +57,16 @@ pgColsFromMutFld = \case
|
||||
MExp _ -> []
|
||||
MRet selFlds ->
|
||||
flip mapMaybe selFlds $ \(_, annFld) -> case annFld of
|
||||
FCol (AnnColField (PGColumnInfo col _ _ colTy _ _) _ _) -> Just (col, colTy)
|
||||
_ -> Nothing
|
||||
AFColumn (AnnColumnField (PGColumnInfo col _ _ colTy _ _) _ _) -> Just (col, colTy)
|
||||
_ -> Nothing
|
||||
|
||||
pgColsFromMutFlds :: MutFlds -> [(PGCol, PGColumnType)]
|
||||
pgColsFromMutFlds = concatMap (pgColsFromMutFld . snd)
|
||||
|
||||
pgColsToSelFlds :: [PGColumnInfo] -> [(FieldName, AnnFld)]
|
||||
pgColsToSelFlds :: [PGColumnInfo] -> [(FieldName, AnnField)]
|
||||
pgColsToSelFlds cols =
|
||||
flip map cols $
|
||||
\pgColInfo -> (fromPGCol $ pgiColumn pgColInfo, mkAnnColField pgColInfo Nothing)
|
||||
\pgColInfo -> (fromPGCol $ pgiColumn pgColInfo, mkAnnColumnField pgColInfo Nothing)
|
||||
|
||||
mkDefaultMutFlds :: Maybe [PGColumnInfo] -> MutationOutput
|
||||
mkDefaultMutFlds = MOutMultirowFields . \case
|
||||
@ -95,7 +93,7 @@ mkMutFldExp qt preCalAffRows strfyNum = \case
|
||||
let tabFrom = FromIden cteAlias
|
||||
tabPerm = TablePerm annBoolExpTrue Nothing
|
||||
in S.SESelect $ mkSQLSelect JASMultipleRows $
|
||||
AnnSelG selFlds tabFrom tabPerm noTableArgs strfyNum
|
||||
AnnSelectG selFlds tabFrom tabPerm noSelectArgs strfyNum
|
||||
where
|
||||
cteAlias = qualTableToAliasIden qt
|
||||
|
||||
@ -117,7 +115,7 @@ mkMutationOutputExp qt preCalAffRows cte mutOutput strfyNum =
|
||||
let tabFrom = FromIden cteAlias
|
||||
tabPerm = TablePerm annBoolExpTrue Nothing
|
||||
in S.SESelect $ mkSQLSelect JASSingleObject $
|
||||
AnnSelG annFlds tabFrom tabPerm noTableArgs strfyNum
|
||||
AnnSelectG annFlds tabFrom tabPerm noSelectArgs strfyNum
|
||||
|
||||
|
||||
checkRetCols
|
||||
|
@ -12,7 +12,7 @@ import Hasura.RQL.DML.Select.Types
|
||||
data MutFldG v
|
||||
= MCount
|
||||
| MExp !T.Text
|
||||
| MRet !(AnnFldsG v)
|
||||
| MRet !(AnnFieldsG v)
|
||||
deriving (Show, Eq)
|
||||
|
||||
type MutFld = MutFldG S.SQLExp
|
||||
@ -21,7 +21,7 @@ type MutFldsG v = Fields (MutFldG v)
|
||||
|
||||
data MutationOutputG v
|
||||
= MOutMultirowFields !(MutFldsG v)
|
||||
| MOutSinglerowObject !(AnnFldsG v)
|
||||
| MOutSinglerowObject !(AnnFieldsG v)
|
||||
deriving (Show, Eq)
|
||||
|
||||
type MutationOutput = MutationOutputG S.SQLExp
|
||||
|
@ -1,11 +1,11 @@
|
||||
module Hasura.RQL.DML.Select
|
||||
( selectP2
|
||||
, selectQuerySQL
|
||||
, selectAggQuerySQL
|
||||
, convSelectQuery
|
||||
, asSingleRowJsonResp
|
||||
, module Hasura.RQL.DML.Select.Internal
|
||||
, runSelect
|
||||
, selectQuerySQL
|
||||
, selectAggregateQuerySQL
|
||||
, module Hasura.RQL.DML.Select.Internal
|
||||
)
|
||||
where
|
||||
|
||||
@ -105,7 +105,7 @@ convOrderByElem
|
||||
=> SessVarBldr m
|
||||
-> (FieldInfoMap FieldInfo, SelPermInfo)
|
||||
-> OrderByCol
|
||||
-> m AnnObCol
|
||||
-> m (AnnOrderByElement S.SQLExp)
|
||||
convOrderByElem sessVarBldr (flds, spi) = \case
|
||||
OCPG fldName -> do
|
||||
fldInfo <- askFieldInfo flds fldName
|
||||
@ -118,7 +118,7 @@ convOrderByElem sessVarBldr (flds, spi) = \case
|
||||
[ fldName <<> " has type 'geometry'"
|
||||
, " and cannot be used in order_by"
|
||||
]
|
||||
else return $ AOCPG $ pgiColumn colInfo
|
||||
else return $ AOCColumn colInfo
|
||||
FIRelationship _ -> throw400 UnexpectedPayload $ mconcat
|
||||
[ fldName <<> " is a"
|
||||
, " relationship and should be expanded"
|
||||
@ -149,7 +149,7 @@ convOrderByElem sessVarBldr (flds, spi) = \case
|
||||
]
|
||||
(relFim, relSpi) <- fetchRelDet (riName relInfo) (riRTable relInfo)
|
||||
resolvedSelFltr <- convAnnBoolExpPartialSQL sessVarBldr $ spiFilter relSpi
|
||||
AOCObj relInfo resolvedSelFltr <$>
|
||||
AOCObjectRelation relInfo resolvedSelFltr <$>
|
||||
convOrderByElem sessVarBldr (relFim, relSpi) rest
|
||||
FIRemoteRelationship {} ->
|
||||
throw400 UnexpectedPayload (mconcat [ fldName <<> " is a remote field" ])
|
||||
@ -168,12 +168,12 @@ convSelectQ fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do
|
||||
indexedForM (sqColumns selQ) $ \case
|
||||
(ECSimple pgCol) -> do
|
||||
colInfo <- convExtSimple fieldInfoMap selPermInfo pgCol
|
||||
return (fromPGCol pgCol, mkAnnColField colInfo Nothing)
|
||||
return (fromPGCol pgCol, mkAnnColumnField colInfo Nothing)
|
||||
(ECRel relName mAlias relSelQ) -> do
|
||||
annRel <- convExtRel fieldInfoMap relName mAlias
|
||||
relSelQ sessVarBldr prepValBldr
|
||||
return ( fromRel $ fromMaybe relName mAlias
|
||||
, either FObj FArr annRel
|
||||
, either AFObjectRelation AFArrayRelation annRel
|
||||
)
|
||||
|
||||
-- let spiT = spiTable selPermInfo
|
||||
@ -198,11 +198,11 @@ convSelectQ fieldInfoMap selPermInfo selQ sessVarBldr prepValBldr = do
|
||||
|
||||
let tabFrom = FromTable $ spiTable selPermInfo
|
||||
tabPerm = TablePerm resolvedSelFltr mPermLimit
|
||||
tabArgs = TableArgs wClause annOrdByM mQueryLimit
|
||||
tabArgs = SelectArgs wClause annOrdByM mQueryLimit
|
||||
(S.intToSQLExp <$> mQueryOffset) Nothing
|
||||
|
||||
strfyNum <- stringifyNum <$> askSQLGenCtx
|
||||
return $ AnnSelG annFlds tabFrom tabPerm tabArgs strfyNum
|
||||
return $ AnnSelectG annFlds tabFrom tabPerm tabArgs strfyNum
|
||||
|
||||
where
|
||||
mQueryOffset = sqOffset selQ
|
||||
@ -229,7 +229,7 @@ convExtRel
|
||||
-> SelectQExt
|
||||
-> SessVarBldr m
|
||||
-> (PGColumnType -> Value -> m S.SQLExp)
|
||||
-> m (Either ObjSel ArrSel)
|
||||
-> m (Either ObjectRelationSelect ArraySelect)
|
||||
convExtRel fieldInfoMap relName mAlias selQ sessVarBldr prepValBldr = do
|
||||
-- Point to the name key
|
||||
relInfo <- withPathK "name" $
|
||||
@ -240,9 +240,9 @@ convExtRel fieldInfoMap relName mAlias selQ sessVarBldr prepValBldr = do
|
||||
case relTy of
|
||||
ObjRel -> do
|
||||
when misused $ throw400 UnexpectedPayload objRelMisuseMsg
|
||||
return $ Left $ AnnRelG (fromMaybe relName mAlias) colMapping annSel
|
||||
return $ Left $ AnnRelationSelectG (fromMaybe relName mAlias) colMapping annSel
|
||||
ArrRel ->
|
||||
return $ Right $ ASSimple $ AnnRelG (fromMaybe relName mAlias)
|
||||
return $ Right $ ASSimple $ AnnRelationSelectG (fromMaybe relName mAlias)
|
||||
colMapping annSel
|
||||
where
|
||||
pgWhenRelErr = "only relationships can be expanded"
|
||||
@ -270,8 +270,7 @@ convSelectQuery sessVarBldr prepArgBuilder (DMLQuery qt selQ) = do
|
||||
let fieldInfo = _tciFieldInfoMap $ _tiCoreInfo tabInfo
|
||||
extSelQ <- resolveStar fieldInfo selPermInfo selQ
|
||||
validateHeaders $ spiRequiredHeaders selPermInfo
|
||||
convSelectQ fieldInfo selPermInfo
|
||||
extSelQ sessVarBldr prepArgBuilder
|
||||
convSelectQ fieldInfo selPermInfo extSelQ sessVarBldr prepArgBuilder
|
||||
|
||||
selectP2 :: JsonAggSelect -> (AnnSimpleSel, DS.Seq Q.PrepArg) -> Q.TxE QErr EncJSON
|
||||
selectP2 jsonAggSelect (sel, p) =
|
||||
@ -284,9 +283,9 @@ selectQuerySQL :: JsonAggSelect -> AnnSimpleSel -> Q.Query
|
||||
selectQuerySQL jsonAggSelect sel =
|
||||
Q.fromBuilder $ toSQL $ mkSQLSelect jsonAggSelect sel
|
||||
|
||||
selectAggQuerySQL :: AnnAggSel -> Q.Query
|
||||
selectAggQuerySQL =
|
||||
Q.fromBuilder . toSQL . mkAggSelect
|
||||
selectAggregateQuerySQL :: AnnAggregateSelect -> Q.Query
|
||||
selectAggregateQuerySQL =
|
||||
Q.fromBuilder . toSQL . mkAggregateSelect
|
||||
|
||||
asSingleRowJsonResp :: Q.Query -> [Q.PrepArg] -> Q.TxE QErr EncJSON
|
||||
asSingleRowJsonResp query args =
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -3,19 +3,19 @@
|
||||
|
||||
module Hasura.RQL.DML.Select.Types where
|
||||
|
||||
import Control.Lens.TH (makeLenses, makePrisms)
|
||||
import Data.Aeson.Types
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
import Control.Lens.TH (makePrisms)
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
import qualified Data.List.NonEmpty as NE
|
||||
import qualified Data.Sequence as Seq
|
||||
import qualified Data.Text as T
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Language.GraphQL.Draft.Syntax as G
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.HashMap.Strict as HM
|
||||
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 Hasura.Prelude
|
||||
import Hasura.GraphQL.Parser.Schema
|
||||
import Hasura.Prelude
|
||||
import Hasura.RQL.Types.BoolExp
|
||||
import Hasura.RQL.Types.Column
|
||||
import Hasura.RQL.Types.Common
|
||||
@ -23,7 +23,7 @@ import Hasura.RQL.Types.DML
|
||||
import Hasura.RQL.Types.Function
|
||||
import Hasura.RQL.Types.RemoteRelationship
|
||||
import Hasura.RQL.Types.RemoteSchema
|
||||
import qualified Hasura.SQL.DML as S
|
||||
import qualified Hasura.SQL.DML as S
|
||||
import Hasura.SQL.Types
|
||||
|
||||
type SelectQExt = SelectG ExtCol BoolExp Int
|
||||
@ -31,7 +31,8 @@ type SelectQExt = SelectG ExtCol BoolExp Int
|
||||
data JsonAggSelect
|
||||
= JASMultipleRows
|
||||
| JASSingleObject
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq, Generic)
|
||||
instance Hashable JsonAggSelect
|
||||
|
||||
-- Columns in RQL
|
||||
data ExtCol
|
||||
@ -60,118 +61,129 @@ instance FromJSON ExtCol where
|
||||
, "object (relationship)"
|
||||
]
|
||||
|
||||
data AnnAggOrdBy
|
||||
data AnnAggregateOrderBy
|
||||
= AAOCount
|
||||
| AAOOp !T.Text !PGCol
|
||||
deriving (Show, Eq)
|
||||
| AAOOp !T.Text !PGColumnInfo
|
||||
deriving (Show, Eq, Generic)
|
||||
instance Hashable AnnAggregateOrderBy
|
||||
|
||||
data AnnObColG v
|
||||
= AOCPG !PGCol
|
||||
| AOCObj !RelInfo !(AnnBoolExp v) !(AnnObColG v)
|
||||
| AOCAgg !RelInfo !(AnnBoolExp v) !AnnAggOrdBy
|
||||
deriving (Show, Eq)
|
||||
data AnnOrderByElementG v
|
||||
= AOCColumn !PGColumnInfo
|
||||
| AOCObjectRelation !RelInfo !v !(AnnOrderByElementG v)
|
||||
| AOCArrayAggregation !RelInfo !v !AnnAggregateOrderBy
|
||||
deriving (Show, Eq, Generic, Functor)
|
||||
instance (Hashable v) => Hashable (AnnOrderByElementG v)
|
||||
|
||||
traverseAnnObCol
|
||||
type AnnOrderByElement v = AnnOrderByElementG (AnnBoolExp v)
|
||||
|
||||
traverseAnnOrderByElement
|
||||
:: (Applicative f)
|
||||
=> (a -> f b) -> AnnObColG a -> f (AnnObColG b)
|
||||
traverseAnnObCol f = \case
|
||||
AOCPG pgColInfo -> pure $ AOCPG pgColInfo
|
||||
AOCObj relInfo annBoolExp annObCol ->
|
||||
AOCObj relInfo
|
||||
=> (a -> f b) -> AnnOrderByElement a -> f (AnnOrderByElement b)
|
||||
traverseAnnOrderByElement f = \case
|
||||
AOCColumn pgColInfo -> pure $ AOCColumn pgColInfo
|
||||
AOCObjectRelation relInfo annBoolExp annObCol ->
|
||||
AOCObjectRelation relInfo
|
||||
<$> traverseAnnBoolExp f annBoolExp
|
||||
<*> traverseAnnObCol f annObCol
|
||||
AOCAgg relInfo annBoolExp annAggOb ->
|
||||
AOCAgg relInfo
|
||||
<*> traverseAnnOrderByElement f annObCol
|
||||
AOCArrayAggregation relInfo annBoolExp annAggOb ->
|
||||
AOCArrayAggregation relInfo
|
||||
<$> traverseAnnBoolExp f annBoolExp
|
||||
<*> pure annAggOb
|
||||
|
||||
type AnnObCol = AnnObColG S.SQLExp
|
||||
|
||||
type AnnOrderByItemG v = OrderByItemG (AnnObColG v)
|
||||
type AnnOrderByItemG v = OrderByItemG (AnnOrderByElement v)
|
||||
|
||||
traverseAnnOrderByItem
|
||||
:: (Applicative f)
|
||||
=> (a -> f b) -> AnnOrderByItemG a -> f (AnnOrderByItemG b)
|
||||
traverseAnnOrderByItem f =
|
||||
traverse (traverseAnnObCol f)
|
||||
traverse (traverseAnnOrderByElement f)
|
||||
|
||||
type AnnOrderByItem = AnnOrderByItemG S.SQLExp
|
||||
|
||||
data AnnRelG a
|
||||
= AnnRelG
|
||||
{ aarName :: !RelName -- Relationship name
|
||||
, aarMapping :: !(HashMap PGCol PGCol) -- Column of left table to join with
|
||||
, aarAnnSel :: !a -- Current table. Almost ~ to SQL Select
|
||||
type OrderByItemExp =
|
||||
OrderByItemG (AnnOrderByElement S.SQLExp, (S.Alias, S.SQLExp))
|
||||
|
||||
data AnnRelationSelectG a
|
||||
= 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)
|
||||
|
||||
type ObjSelG v = AnnRelG (AnnSimpleSelG v)
|
||||
type ObjSel = ObjSelG S.SQLExp
|
||||
type ObjectRelationSelectG v = AnnRelationSelectG (AnnSimpleSelG v)
|
||||
type ObjectRelationSelect = ObjectRelationSelectG S.SQLExp
|
||||
|
||||
type ArrRelG v = AnnRelG (AnnSimpleSelG v)
|
||||
type ArrRelAggG v = AnnRelG (AnnAggSelG v)
|
||||
type ArrRelAgg = ArrRelAggG S.SQLExp
|
||||
type ArrayRelationSelectG v = AnnRelationSelectG (AnnSimpleSelG v)
|
||||
type ArrayAggregateSelectG v = AnnRelationSelectG (AnnAggregateSelectG v)
|
||||
type ArrayConnectionSelect v = AnnRelationSelectG (ConnectionSelect v)
|
||||
type ArrayAggregateSelect = ArrayAggregateSelectG S.SQLExp
|
||||
|
||||
data ComputedFieldScalarSel v
|
||||
= ComputedFieldScalarSel
|
||||
data ComputedFieldScalarSelect v
|
||||
= ComputedFieldScalarSelect
|
||||
{ _cfssFunction :: !QualifiedFunction
|
||||
, _cfssArguments :: !(FunctionArgsExpTableRow v)
|
||||
, _cfssType :: !PGScalarType
|
||||
, _cfssColumnOp :: !(Maybe ColOp)
|
||||
, _cfssColumnOp :: !(Maybe ColumnOp)
|
||||
} deriving (Show, Eq, Functor, Foldable, Traversable)
|
||||
|
||||
data ComputedFieldSel v
|
||||
= CFSScalar !(ComputedFieldScalarSel v)
|
||||
data ComputedFieldSelect v
|
||||
= CFSScalar !(ComputedFieldScalarSelect v)
|
||||
| CFSTable !JsonAggSelect !(AnnSimpleSelG v)
|
||||
deriving (Show, Eq)
|
||||
|
||||
traverseComputedFieldSel
|
||||
traverseComputedFieldSelect
|
||||
:: (Applicative f)
|
||||
=> (v -> f w)
|
||||
-> ComputedFieldSel v -> f (ComputedFieldSel w)
|
||||
traverseComputedFieldSel fv = \case
|
||||
-> ComputedFieldSelect v -> f (ComputedFieldSelect w)
|
||||
traverseComputedFieldSelect fv = \case
|
||||
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)]
|
||||
|
||||
data ArrSelG v
|
||||
= ASSimple !(ArrRelG v)
|
||||
| ASAgg !(ArrRelAggG v)
|
||||
data ArraySelectG v
|
||||
= ASSimple !(ArrayRelationSelectG v)
|
||||
| ASAggregate !(ArrayAggregateSelectG v)
|
||||
| ASConnection !(ArrayConnectionSelect v)
|
||||
deriving (Show, Eq)
|
||||
|
||||
traverseArrSel
|
||||
traverseArraySelect
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> ArrSelG a
|
||||
-> f (ArrSelG b)
|
||||
traverseArrSel f = \case
|
||||
ASSimple arrRel -> ASSimple <$> traverse (traverseAnnSimpleSel f) arrRel
|
||||
ASAgg arrRelAgg -> ASAgg <$> traverse (traverseAnnAggSel f) arrRelAgg
|
||||
-> ArraySelectG a
|
||||
-> f (ArraySelectG b)
|
||||
traverseArraySelect f = \case
|
||||
ASSimple arrRel ->
|
||||
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
|
||||
= ColOp
|
||||
data ColumnOp
|
||||
= ColumnOp
|
||||
{ _colOp :: S.SQLOp
|
||||
, _colExp :: S.SQLExp
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data AnnColField
|
||||
= AnnColField
|
||||
data AnnColumnField
|
||||
= AnnColumnField
|
||||
{ _acfInfo :: !PGColumnInfo
|
||||
, _acfAsText :: !Bool
|
||||
-- ^ 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
|
||||
-- https://github.com/hasura/graphql-engine/pull/3198 for more details.
|
||||
, _acfOp :: !(Maybe ColOp)
|
||||
, _acfOp :: !(Maybe ColumnOp)
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data RemoteFieldArgument
|
||||
= RemoteFieldArgument
|
||||
{ _rfaName :: !G.Name
|
||||
, _rfaValue :: !(G.Value Variable)
|
||||
{ _rfaName :: !G.Name
|
||||
, _rfaValue :: !(G.Value Variable)
|
||||
, _rfaVariable :: !(Maybe [(G.VariableDefinition,J.Value)])
|
||||
} deriving (Eq,Show)
|
||||
|
||||
@ -184,50 +196,53 @@ data RemoteSelect
|
||||
, _rselRemoteSchema :: !RemoteSchemaInfo
|
||||
} deriving (Show,Eq)
|
||||
|
||||
data AnnFldG v
|
||||
= FCol !AnnColField
|
||||
| FObj !(ObjSelG v)
|
||||
| FArr !(ArrSelG v)
|
||||
| FComputedField !(ComputedFieldSel v)
|
||||
| FExp !T.Text
|
||||
| FRemote !RemoteSelect
|
||||
deriving (Show,Eq)
|
||||
data AnnFieldG v
|
||||
= AFColumn !AnnColumnField
|
||||
| AFObjectRelation !(ObjectRelationSelectG v)
|
||||
| AFArrayRelation !(ArraySelectG v)
|
||||
| AFComputedField !(ComputedFieldSelect v)
|
||||
| AFRemote !RemoteSelect
|
||||
| AFNodeId !QualifiedTable !(NonEmpty PGColumnInfo)
|
||||
| AFExpression !T.Text
|
||||
deriving (Show, Eq)
|
||||
|
||||
mkAnnColField :: PGColumnInfo -> Maybe ColOp -> AnnFldG v
|
||||
mkAnnColField ci colOpM =
|
||||
FCol $ AnnColField ci False colOpM
|
||||
mkAnnColumnField :: PGColumnInfo -> Maybe ColumnOp -> AnnFieldG v
|
||||
mkAnnColumnField ci colOpM =
|
||||
AFColumn $ AnnColumnField ci False colOpM
|
||||
|
||||
mkAnnColFieldAsText :: PGColumnInfo -> AnnFldG v
|
||||
mkAnnColFieldAsText ci =
|
||||
FCol $ AnnColField ci True Nothing
|
||||
mkAnnColumnFieldAsText :: PGColumnInfo -> AnnFieldG v
|
||||
mkAnnColumnFieldAsText ci =
|
||||
AFColumn $ AnnColumnField ci True Nothing
|
||||
|
||||
traverseAnnFld
|
||||
traverseAnnField
|
||||
:: (Applicative f)
|
||||
=> (a -> f b) -> AnnFldG a -> f (AnnFldG b)
|
||||
traverseAnnFld f = \case
|
||||
FCol colFld -> pure $ FCol colFld
|
||||
FObj sel -> FObj <$> traverse (traverseAnnSimpleSel f) sel
|
||||
FArr sel -> FArr <$> traverseArrSel f sel
|
||||
FComputedField sel -> FComputedField <$> traverseComputedFieldSel f sel
|
||||
FExp t -> FExp <$> pure t
|
||||
FRemote s -> pure $ FRemote s
|
||||
=> (a -> f b) -> AnnFieldG a -> f (AnnFieldG b)
|
||||
traverseAnnField f = \case
|
||||
AFColumn colFld -> pure $ AFColumn colFld
|
||||
AFObjectRelation sel -> AFObjectRelation <$> traverse (traverseAnnSimpleSelect f) sel
|
||||
AFArrayRelation sel -> AFArrayRelation <$> traverseArraySelect f sel
|
||||
AFComputedField sel -> AFComputedField <$> traverseComputedFieldSelect f sel
|
||||
AFRemote s -> pure $ AFRemote 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
|
||||
= TableArgs
|
||||
{ _taWhere :: !(Maybe (AnnBoolExp v))
|
||||
, _taOrderBy :: !(Maybe (NE.NonEmpty (AnnOrderByItemG v)))
|
||||
, _taLimit :: !(Maybe Int)
|
||||
, _taOffset :: !(Maybe S.SQLExp)
|
||||
, _taDistCols :: !(Maybe (NE.NonEmpty PGCol))
|
||||
} deriving (Show, Eq)
|
||||
data SelectArgsG v
|
||||
= SelectArgs
|
||||
{ _saWhere :: !(Maybe (AnnBoolExp v))
|
||||
, _saOrderBy :: !(Maybe (NE.NonEmpty (AnnOrderByItemG v)))
|
||||
, _saLimit :: !(Maybe Int)
|
||||
, _saOffset :: !(Maybe S.SQLExp)
|
||||
, _saDistinct :: !(Maybe (NE.NonEmpty PGCol))
|
||||
} deriving (Show, Eq, Generic)
|
||||
instance (Hashable v) => Hashable (SelectArgsG v)
|
||||
|
||||
traverseTableArgs
|
||||
traverseSelectArgs
|
||||
:: (Applicative f)
|
||||
=> (a -> f b) -> TableArgsG a -> f (TableArgsG b)
|
||||
traverseTableArgs f (TableArgs wh ordBy lmt ofst distCols) =
|
||||
TableArgs
|
||||
=> (a -> f b) -> SelectArgsG a -> f (SelectArgsG b)
|
||||
traverseSelectArgs f (SelectArgs wh ordBy lmt ofst distCols) =
|
||||
SelectArgs
|
||||
<$> traverse (traverseAnnBoolExp f) wh
|
||||
-- traversing through maybe -> nonempty -> annorderbyitem
|
||||
<*> traverse (traverse (traverseAnnOrderByItem f)) ordBy
|
||||
@ -235,62 +250,103 @@ traverseTableArgs f (TableArgs wh ordBy lmt ofst distCols) =
|
||||
<*> pure ofst
|
||||
<*> pure distCols
|
||||
|
||||
type TableArgs = TableArgsG S.SQLExp
|
||||
type SelectArgs = SelectArgsG S.SQLExp
|
||||
|
||||
noTableArgs :: TableArgsG v
|
||||
noTableArgs = TableArgs Nothing Nothing Nothing Nothing Nothing
|
||||
noSelectArgs :: SelectArgsG v
|
||||
noSelectArgs = SelectArgs Nothing Nothing Nothing Nothing Nothing
|
||||
|
||||
data PGColFld
|
||||
= PCFCol !PGCol
|
||||
| PCFExp !T.Text
|
||||
deriving (Show, Eq)
|
||||
|
||||
type ColFlds = Fields PGColFld
|
||||
type ColumnFields = Fields PGColFld
|
||||
|
||||
data AggOp
|
||||
= AggOp
|
||||
{ _aoOp :: !T.Text
|
||||
, _aoFlds :: !ColFlds
|
||||
data AggregateOp
|
||||
= AggregateOp
|
||||
{ _aoOp :: !T.Text
|
||||
, _aoFields :: !ColumnFields
|
||||
} deriving (Show, Eq)
|
||||
|
||||
data AggFld
|
||||
data AggregateField
|
||||
= AFCount !S.CountType
|
||||
| AFOp !AggOp
|
||||
| AFOp !AggregateOp
|
||||
| AFExp !T.Text
|
||||
deriving (Show, Eq)
|
||||
|
||||
type AggFlds = Fields AggFld
|
||||
type AnnFldsG v = Fields (AnnFldG v)
|
||||
type AggregateFields = Fields AggregateField
|
||||
type AnnFieldsG v = Fields (AnnFieldG v)
|
||||
|
||||
traverseAnnFlds
|
||||
traverseAnnFields
|
||||
:: (Applicative f)
|
||||
=> (a -> f b) -> AnnFldsG a -> f (AnnFldsG b)
|
||||
traverseAnnFlds f = traverse (traverse (traverseAnnFld f))
|
||||
=> (a -> f b) -> AnnFieldsG a -> f (AnnFieldsG b)
|
||||
traverseAnnFields f = traverse (traverse (traverseAnnField f))
|
||||
|
||||
type AnnFlds = AnnFldsG S.SQLExp
|
||||
type AnnFields = AnnFieldsG S.SQLExp
|
||||
|
||||
data TableAggFldG v
|
||||
= TAFAgg !AggFlds
|
||||
| TAFNodes !(AnnFldsG v)
|
||||
data TableAggregateFieldG v
|
||||
= TAFAgg !AggregateFields
|
||||
| TAFNodes !(AnnFieldsG v)
|
||||
| TAFExp !T.Text
|
||||
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)
|
||||
=> (a -> f b) -> TableAggFldG a -> f (TableAggFldG b)
|
||||
traverseTableAggFld f = \case
|
||||
=> (a -> f b) -> EdgeField a -> f (EdgeField b)
|
||||
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
|
||||
TAFNodes annFlds -> TAFNodes <$> traverseAnnFlds f annFlds
|
||||
TAFNodes annFlds -> TAFNodes <$> traverseAnnFields f annFlds
|
||||
TAFExp t -> pure $ TAFExp t
|
||||
|
||||
type TableAggFld = TableAggFldG S.SQLExp
|
||||
type TableAggFldsG v = Fields (TableAggFldG v)
|
||||
type TableAggFlds = TableAggFldsG S.SQLExp
|
||||
type TableAggregateField = TableAggregateFieldG S.SQLExp
|
||||
type TableAggregateFieldsG v = Fields (TableAggregateFieldG v)
|
||||
type TableAggregateFields = TableAggregateFieldsG S.SQLExp
|
||||
|
||||
data ArgumentExp a
|
||||
= AETableRow !(Maybe Iden) -- ^ table row accessor
|
||||
| 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)
|
||||
|
||||
@ -299,8 +355,10 @@ data SelectFromG v
|
||||
| FromIden !Iden
|
||||
| FromFunction !QualifiedFunction
|
||||
!(FunctionArgsExpTableRow v)
|
||||
-- a definition list
|
||||
!(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
|
||||
|
||||
@ -308,7 +366,8 @@ data TablePermG v
|
||||
= TablePerm
|
||||
{ _tpFilter :: !(AnnBoolExp v)
|
||||
, _tpLimit :: !(Maybe Int)
|
||||
} deriving (Eq, Show)
|
||||
} deriving (Eq, Show, Generic)
|
||||
instance (Hashable v) => Hashable (TablePermG v)
|
||||
|
||||
traverseTablePerm
|
||||
:: (Applicative f)
|
||||
@ -326,62 +385,105 @@ noTablePermissions =
|
||||
|
||||
type TablePerm = TablePermG S.SQLExp
|
||||
|
||||
data AnnSelG a v
|
||||
= AnnSelG
|
||||
data AnnSelectG a v
|
||||
= AnnSelectG
|
||||
{ _asnFields :: !a
|
||||
, _asnFrom :: !(SelectFromG v)
|
||||
, _asnPerm :: !(TablePermG v)
|
||||
, _asnArgs :: !(TableArgsG v)
|
||||
, _asnArgs :: !(SelectArgsG v)
|
||||
, _asnStrfyNum :: !Bool
|
||||
} deriving (Show, Eq)
|
||||
|
||||
getPermLimit :: AnnSelG a v -> Maybe Int
|
||||
getPermLimit = _tpLimit . _asnPerm
|
||||
|
||||
traverseAnnSimpleSel
|
||||
traverseAnnSimpleSelect
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> AnnSimpleSelG a -> f (AnnSimpleSelG b)
|
||||
traverseAnnSimpleSel f = traverseAnnSel (traverseAnnFlds f) f
|
||||
traverseAnnSimpleSelect f = traverseAnnSelect (traverseAnnFields f) f
|
||||
|
||||
traverseAnnAggSel
|
||||
traverseAnnAggregateSelect
|
||||
:: (Applicative f)
|
||||
=> (a -> f b)
|
||||
-> AnnAggSelG a -> f (AnnAggSelG b)
|
||||
traverseAnnAggSel f =
|
||||
traverseAnnSel (traverse (traverse (traverseTableAggFld f))) f
|
||||
-> AnnAggregateSelectG a -> f (AnnAggregateSelectG b)
|
||||
traverseAnnAggregateSelect f =
|
||||
traverseAnnSelect (traverse (traverse (traverseTableAggregateField f))) f
|
||||
|
||||
traverseAnnSel
|
||||
traverseAnnSelect
|
||||
:: (Applicative f)
|
||||
=> (a -> f b) -> (v -> f w)
|
||||
-> AnnSelG a v -> f (AnnSelG b w)
|
||||
traverseAnnSel f1 f2 (AnnSelG flds tabFrom perm args strfyNum) =
|
||||
AnnSelG
|
||||
-> AnnSelectG a v -> f (AnnSelectG b w)
|
||||
traverseAnnSelect f1 f2 (AnnSelectG flds tabFrom perm args strfyNum) =
|
||||
AnnSelectG
|
||||
<$> f1 flds
|
||||
<*> traverse f2 tabFrom
|
||||
<*> traverseTablePerm f2 perm
|
||||
<*> traverseTableArgs f2 args
|
||||
<*> traverseSelectArgs f2 args
|
||||
<*> pure strfyNum
|
||||
|
||||
type AnnSimpleSelG v = AnnSelG (AnnFldsG v) v
|
||||
type AnnSimpleSelG v = AnnSelectG (AnnFieldsG v) v
|
||||
type AnnSimpleSel = AnnSimpleSelG S.SQLExp
|
||||
|
||||
type AnnAggSelG v = AnnSelG (TableAggFldsG v) v
|
||||
type AnnAggSel = AnnAggSelG S.SQLExp
|
||||
type AnnAggregateSelectG v = AnnSelectG (TableAggregateFieldsG v) v
|
||||
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
|
||||
= FunctionArgsExp
|
||||
{ _faePositional :: ![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 = FunctionArgsExp [] HM.empty
|
||||
|
||||
type FunctionArgExp = FunctionArgsExpG S.SQLExp
|
||||
|
||||
-- | If argument positional index is less than or equal to length of 'positional' arguments then
|
||||
-- insert the value in 'positional' arguments else insert the value with argument name in 'named' arguments
|
||||
-- | If argument positional index is less than or equal to length of
|
||||
-- 'positional' arguments then insert the value in 'positional' arguments else
|
||||
-- insert the value with argument name in 'named' arguments
|
||||
insertFunctionArg
|
||||
:: FunctionArgName
|
||||
-> Int
|
||||
@ -396,113 +498,106 @@ insertFunctionArg argName index value (FunctionArgsExp positional named) =
|
||||
where
|
||||
insertAt i a = toList . Seq.insertAt i a . Seq.fromList
|
||||
|
||||
data BaseNode
|
||||
= BaseNode
|
||||
{ _bnPrefix :: !Iden
|
||||
, _bnDistinct :: !(Maybe S.DistinctExpr)
|
||||
, _bnFrom :: !S.FromItem
|
||||
, _bnWhere :: !S.BoolExp
|
||||
, _bnOrderBy :: !(Maybe S.OrderByExp)
|
||||
, _bnLimit :: !(Maybe Int)
|
||||
, _bnOffset :: !(Maybe S.SQLExp)
|
||||
data SourcePrefixes
|
||||
= SourcePrefixes
|
||||
{ _pfThis :: !Iden -- ^ Current source prefix
|
||||
, _pfBase :: !Iden
|
||||
-- ^ Base table source row identifier to generate
|
||||
-- the table's column identifiers for computed field
|
||||
-- function input parameters
|
||||
} deriving (Show, Eq, Generic)
|
||||
instance Hashable SourcePrefixes
|
||||
|
||||
, _bnExtrs :: !(HM.HashMap S.Alias S.SQLExp)
|
||||
, _bnObjs :: !(HM.HashMap RelName ObjNode)
|
||||
, _bnArrs :: !(HM.HashMap S.Alias ArrNode)
|
||||
, _bnComputedFieldTables :: !(HM.HashMap FieldName CFTableNode)
|
||||
data SelectSource
|
||||
= SelectSource
|
||||
{ _ssPrefix :: !Iden
|
||||
, _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)
|
||||
|
||||
mergeBaseNodes :: BaseNode -> BaseNode -> BaseNode
|
||||
mergeBaseNodes lNodeDet rNodeDet =
|
||||
BaseNode pfx dExp f whr ordBy limit offset
|
||||
(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
|
||||
instance Semigroup SelectNode where
|
||||
SelectNode lExtrs lJoinTree <> SelectNode rExtrs rJoinTree =
|
||||
SelectNode (lExtrs <> rExtrs) (lJoinTree <> rJoinTree)
|
||||
|
||||
data OrderByNode
|
||||
= OBNNothing
|
||||
| OBNObjNode !RelName !ObjNode
|
||||
| OBNArrNode !S.Alias !ArrNode
|
||||
data ObjectRelationSource
|
||||
= ObjectRelationSource
|
||||
{ _orsRelationshipName :: !RelName
|
||||
, _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)
|
||||
|
||||
data ArrRelCtxG v
|
||||
= ArrRelCtx
|
||||
{ aacFields :: !(ArrSelFldsG v)
|
||||
, 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)
|
||||
$(makeLenses ''AnnSelectG)
|
||||
$(makePrisms ''AnnFieldG)
|
||||
$(makePrisms ''AnnOrderByElementG)
|
||||
|
@ -55,9 +55,9 @@ import Hasura.RQL.DDL.Headers
|
||||
import Hasura.RQL.DML.Select.Types
|
||||
import Hasura.RQL.Types.CustomTypes
|
||||
import Hasura.RQL.Types.Permission
|
||||
import Hasura.Session
|
||||
import Hasura.SQL.Types
|
||||
import Language.Haskell.TH.Syntax (Lift)
|
||||
import Hasura.Session
|
||||
|
||||
import qualified Data.Aeson as J
|
||||
import qualified Data.Aeson.Casing as J
|
||||
@ -273,7 +273,7 @@ data AnnActionExecution v
|
||||
= AnnActionExecution
|
||||
{ _aaeName :: !ActionName
|
||||
, _aaeOutputType :: !GraphQLType -- ^ output type
|
||||
, _aaeFields :: !(AnnFldsG v) -- ^ output selection
|
||||
, _aaeFields :: !(AnnFieldsG v) -- ^ output selection
|
||||
, _aaePayload :: !J.Value -- ^ jsonified input arguments
|
||||
, _aaeOutputFields :: !ActionOutputFields
|
||||
-- ^ to validate the response fields from webhook
|
||||
@ -292,7 +292,7 @@ data AnnActionMutationAsync
|
||||
|
||||
data AsyncActionQueryFieldG v
|
||||
= AsyncTypename !Text
|
||||
| AsyncOutput !(AnnFldsG v)
|
||||
| AsyncOutput !(AnnFieldsG v)
|
||||
| AsyncId
|
||||
| AsyncCreatedAt
|
||||
| AsyncErrors
|
||||
|
@ -66,6 +66,7 @@ data GExists a
|
||||
instance (NFData a) => NFData (GExists a)
|
||||
instance (Data a) => Plated (GExists a)
|
||||
instance (Cacheable a) => Cacheable (GExists a)
|
||||
instance (Hashable a) => Hashable (GExists a)
|
||||
|
||||
gExistsToJSON :: (a -> (Text, Value)) -> GExists a -> Value
|
||||
gExistsToJSON f (GExists qt wh) =
|
||||
@ -92,6 +93,7 @@ data GBoolExp a
|
||||
instance (NFData a) => NFData (GBoolExp a)
|
||||
instance (Data a) => Plated (GBoolExp a)
|
||||
instance (Cacheable a) => Cacheable (GBoolExp a)
|
||||
instance (Hashable a) => Hashable (GBoolExp a)
|
||||
|
||||
gBoolExpTrue :: GBoolExp a
|
||||
gBoolExpTrue = BoolAnd []
|
||||
@ -143,6 +145,7 @@ data DWithinGeomOp a =
|
||||
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
||||
instance (NFData a) => NFData (DWithinGeomOp a)
|
||||
instance (Cacheable a) => Cacheable (DWithinGeomOp a)
|
||||
instance (Hashable a) => Hashable (DWithinGeomOp a)
|
||||
$(deriveJSON (aesonDrop 6 snakeCase) ''DWithinGeomOp)
|
||||
|
||||
data DWithinGeogOp a =
|
||||
@ -153,6 +156,7 @@ data DWithinGeogOp a =
|
||||
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
||||
instance (NFData a) => NFData (DWithinGeogOp a)
|
||||
instance (Cacheable a) => Cacheable (DWithinGeogOp a)
|
||||
instance (Hashable a) => Hashable (DWithinGeogOp a)
|
||||
$(deriveJSON (aesonDrop 6 snakeCase) ''DWithinGeogOp)
|
||||
|
||||
data STIntersectsNbandGeommin a =
|
||||
@ -162,6 +166,7 @@ data STIntersectsNbandGeommin a =
|
||||
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
||||
instance (NFData a) => NFData (STIntersectsNbandGeommin a)
|
||||
instance (Cacheable a) => Cacheable (STIntersectsNbandGeommin a)
|
||||
instance (Hashable a) => Hashable (STIntersectsNbandGeommin a)
|
||||
$(deriveJSON (aesonDrop 4 snakeCase) ''STIntersectsNbandGeommin)
|
||||
|
||||
data STIntersectsGeomminNband a =
|
||||
@ -171,6 +176,7 @@ data STIntersectsGeomminNband a =
|
||||
} deriving (Show, Eq, Functor, Foldable, Traversable, Generic, Data)
|
||||
instance (NFData a) => NFData (STIntersectsGeomminNband a)
|
||||
instance (Cacheable a) => Cacheable (STIntersectsGeomminNband a)
|
||||
instance (Hashable a) => Hashable (STIntersectsGeomminNband a)
|
||||
$(deriveJSON (aesonDrop 4 snakeCase) ''STIntersectsGeomminNband)
|
||||
|
||||
type CastExp a = M.HashMap PGScalarType [OpExpG a]
|
||||
@ -230,6 +236,7 @@ data OpExpG a
|
||||
deriving (Eq, Show, Functor, Foldable, Traversable, Generic, Data)
|
||||
instance (NFData a) => NFData (OpExpG a)
|
||||
instance (Cacheable a) => Cacheable (OpExpG a)
|
||||
instance (Hashable a) => Hashable (OpExpG a)
|
||||
|
||||
opExpDepCol :: OpExpG a -> Maybe PGCol
|
||||
opExpDepCol = \case
|
||||
@ -303,6 +310,7 @@ data AnnBoolExpFld a
|
||||
deriving (Show, Eq, Functor, Foldable, Traversable, Generic)
|
||||
instance (NFData a) => NFData (AnnBoolExpFld a)
|
||||
instance (Cacheable a) => Cacheable (AnnBoolExpFld a)
|
||||
instance (Hashable a) => Hashable (AnnBoolExpFld a)
|
||||
|
||||
type AnnBoolExp a
|
||||
= GBoolExp (AnnBoolExpFld a)
|
||||
|
@ -143,6 +143,7 @@ data RelInfo
|
||||
} deriving (Show, Eq, Generic)
|
||||
instance NFData RelInfo
|
||||
instance Cacheable RelInfo
|
||||
instance Hashable RelInfo
|
||||
$(deriveToJSON (aesonDrop 2 snakeCase) ''RelInfo)
|
||||
|
||||
newtype FieldName
|
||||
@ -150,6 +151,7 @@ newtype FieldName
|
||||
deriving ( Show, Eq, Ord, Hashable, FromJSON, ToJSON
|
||||
, FromJSONKey, ToJSONKey, Lift, Data, Generic
|
||||
, IsString, Arbitrary, NFData, Cacheable
|
||||
, Semigroup
|
||||
)
|
||||
|
||||
instance IsIden FieldName where
|
||||
@ -212,7 +214,7 @@ data PrimaryKey a
|
||||
= PrimaryKey
|
||||
{ _pkConstraint :: !Constraint
|
||||
, _pkColumns :: !(NESeq a)
|
||||
} deriving (Show, Eq, Generic)
|
||||
} deriving (Show, Eq, Generic, Foldable)
|
||||
instance (NFData a) => NFData (PrimaryKey a)
|
||||
instance (Cacheable a) => Cacheable (PrimaryKey a)
|
||||
$(makeLenses ''PrimaryKey)
|
||||
|
@ -101,6 +101,7 @@ instance (FromJSON a) => FromJSON (DMLQuery a) where
|
||||
newtype OrderType
|
||||
= OrderType { unOrderType :: S.OrderType }
|
||||
deriving (Show, Eq, Lift, Generic)
|
||||
instance Hashable OrderType
|
||||
|
||||
instance FromJSON OrderType where
|
||||
parseJSON =
|
||||
@ -112,6 +113,7 @@ instance FromJSON OrderType where
|
||||
newtype NullsOrder
|
||||
= NullsOrder { unNullsOrder :: S.NullsOrder }
|
||||
deriving (Show, Eq, Lift, Generic)
|
||||
instance Hashable NullsOrder
|
||||
|
||||
instance FromJSON NullsOrder where
|
||||
parseJSON =
|
||||
@ -176,7 +178,8 @@ data OrderByItemG a
|
||||
{ obiType :: !(Maybe OrderType)
|
||||
, obiColumn :: !a
|
||||
, 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
|
||||
|
||||
|
@ -133,8 +133,8 @@ import Hasura.RQL.Types.QueryCollection
|
||||
import Hasura.RQL.Types.RemoteSchema
|
||||
import Hasura.RQL.Types.SchemaCacheTypes
|
||||
import Hasura.RQL.Types.Table
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.Session
|
||||
import Hasura.SQL.Types
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Aeson.Casing
|
||||
@ -198,18 +198,18 @@ type ActionCache = M.HashMap ActionName ActionInfo -- info of all actions
|
||||
|
||||
data SchemaCache
|
||||
= SchemaCache
|
||||
{ scTables :: !TableCache
|
||||
, scActions :: !ActionCache
|
||||
, scFunctions :: !FunctionCache
|
||||
, scRemoteSchemas :: !RemoteSchemaMap
|
||||
, scAllowlist :: !(HS.HashSet GQLQuery)
|
||||
, scGQLContext :: !(HashMap RoleName GQLContext)
|
||||
, scUnauthenticatedGQLContext :: !GQLContext
|
||||
, scRelayContext :: !(HashMap RoleName GQLContext)
|
||||
{ scTables :: !TableCache
|
||||
, scActions :: !ActionCache
|
||||
, scFunctions :: !FunctionCache
|
||||
, scRemoteSchemas :: !RemoteSchemaMap
|
||||
, scAllowlist :: !(HS.HashSet GQLQuery)
|
||||
, scGQLContext :: !(HashMap RoleName GQLContext)
|
||||
, scUnauthenticatedGQLContext :: !GQLContext
|
||||
, scRelayContext :: !(HashMap RoleName GQLContext)
|
||||
, scUnauthenticatedRelayContext :: !GQLContext
|
||||
-- , scCustomTypes :: !(NonObjectTypeMap, AnnotatedObjects)
|
||||
, scDepMap :: !DepMap
|
||||
, scInconsistentObjs :: ![InconsistentMetadata]
|
||||
, scDepMap :: !DepMap
|
||||
, scInconsistentObjs :: ![InconsistentMetadata]
|
||||
}
|
||||
$(deriveToJSON (aesonDrop 2 snakeCase) ''SchemaCache)
|
||||
|
||||
|
@ -35,6 +35,7 @@ data Select
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
instance NFData Select
|
||||
instance Cacheable Select
|
||||
instance Hashable Select
|
||||
|
||||
mkSelect :: Select
|
||||
mkSelect = Select Nothing [] Nothing
|
||||
@ -43,7 +44,7 @@ mkSelect = Select Nothing [] Nothing
|
||||
|
||||
newtype LimitExp
|
||||
= LimitExp SQLExp
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL LimitExp where
|
||||
toSQL (LimitExp se) =
|
||||
@ -51,15 +52,15 @@ instance ToSQL LimitExp where
|
||||
|
||||
newtype OffsetExp
|
||||
= OffsetExp SQLExp
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL OffsetExp where
|
||||
toSQL (OffsetExp se) =
|
||||
"OFFSET" <-> toSQL se
|
||||
|
||||
newtype OrderByExp
|
||||
= OrderByExp [OrderByItem]
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
= OrderByExp (NonEmpty OrderByItem)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
data OrderByItem
|
||||
= OrderByItem
|
||||
@ -69,6 +70,7 @@ data OrderByItem
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
instance NFData OrderByItem
|
||||
instance Cacheable OrderByItem
|
||||
instance Hashable OrderByItem
|
||||
|
||||
instance ToSQL OrderByItem where
|
||||
toSQL (OrderByItem e ot no) =
|
||||
@ -78,6 +80,7 @@ data OrderType = OTAsc | OTDesc
|
||||
deriving (Show, Eq, Lift, Generic, Data)
|
||||
instance NFData OrderType
|
||||
instance Cacheable OrderType
|
||||
instance Hashable OrderType
|
||||
|
||||
instance ToSQL OrderType where
|
||||
toSQL OTAsc = "ASC"
|
||||
@ -89,6 +92,7 @@ data NullsOrder
|
||||
deriving (Show, Eq, Lift, Generic, Data)
|
||||
instance NFData NullsOrder
|
||||
instance Cacheable NullsOrder
|
||||
instance Hashable NullsOrder
|
||||
|
||||
instance ToSQL NullsOrder where
|
||||
toSQL NFirst = "NULLS FIRST"
|
||||
@ -96,11 +100,11 @@ instance ToSQL NullsOrder where
|
||||
|
||||
instance ToSQL OrderByExp where
|
||||
toSQL (OrderByExp l) =
|
||||
"ORDER BY" <-> (", " <+> l)
|
||||
"ORDER BY" <-> (", " <+> toList l)
|
||||
|
||||
newtype GroupByExp
|
||||
= GroupByExp [SQLExp]
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL GroupByExp where
|
||||
toSQL (GroupByExp idens) =
|
||||
@ -108,7 +112,7 @@ instance ToSQL GroupByExp where
|
||||
|
||||
newtype FromExp
|
||||
= FromExp [FromItem]
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL FromExp where
|
||||
toSQL (FromExp items) =
|
||||
@ -148,7 +152,7 @@ mkRowExp extrs = let
|
||||
|
||||
newtype HavingExp
|
||||
= HavingExp BoolExp
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL HavingExp where
|
||||
toSQL (HavingExp be) =
|
||||
@ -156,7 +160,7 @@ instance ToSQL HavingExp where
|
||||
|
||||
newtype WhereFrag
|
||||
= WhereFrag { getWFBoolExp :: BoolExp }
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL WhereFrag where
|
||||
toSQL (WhereFrag be) =
|
||||
@ -188,6 +192,7 @@ data Qual
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData Qual
|
||||
instance Cacheable Qual
|
||||
instance Hashable Qual
|
||||
|
||||
mkQual :: QualifiedTable -> Qual
|
||||
mkQual = QualTable
|
||||
@ -205,6 +210,7 @@ data QIden
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData QIden
|
||||
instance Cacheable QIden
|
||||
instance Hashable QIden
|
||||
|
||||
instance ToSQL QIden where
|
||||
toSQL (QIden qual iden) =
|
||||
@ -212,7 +218,7 @@ instance ToSQL QIden where
|
||||
|
||||
newtype SQLOp
|
||||
= SQLOp {sqlOpTxt :: T.Text}
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
incOp :: SQLOp
|
||||
incOp = SQLOp "+"
|
||||
@ -234,7 +240,7 @@ jsonbDeleteAtPathOp = SQLOp "#-"
|
||||
|
||||
newtype TypeAnn
|
||||
= TypeAnn { unTypeAnn :: T.Text }
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL TypeAnn where
|
||||
toSQL (TypeAnn ty) = "::" <> TB.text ty
|
||||
@ -260,6 +266,9 @@ jsonTypeAnn = mkTypeAnn $ PGTypeScalar PGJSON
|
||||
jsonbTypeAnn :: TypeAnn
|
||||
jsonbTypeAnn = mkTypeAnn $ PGTypeScalar PGJSONB
|
||||
|
||||
boolTypeAnn :: TypeAnn
|
||||
boolTypeAnn = mkTypeAnn $ PGTypeScalar PGBoolean
|
||||
|
||||
data CountType
|
||||
= CTStar
|
||||
| CTSimple ![PGCol]
|
||||
@ -267,6 +276,7 @@ data CountType
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData CountType
|
||||
instance Cacheable CountType
|
||||
instance Hashable CountType
|
||||
|
||||
instance ToSQL CountType where
|
||||
toSQL CTStar = "*"
|
||||
@ -277,7 +287,7 @@ instance ToSQL CountType where
|
||||
|
||||
newtype TupleExp
|
||||
= TupleExp [SQLExp]
|
||||
deriving (Show, Eq, NFData, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL TupleExp where
|
||||
toSQL (TupleExp exps) =
|
||||
@ -302,6 +312,7 @@ data SQLExp
|
||||
| SEBool !BoolExp
|
||||
| SEExcluded !Iden
|
||||
| SEArray ![SQLExp]
|
||||
| SEArrayIndex !SQLExp !SQLExp
|
||||
| SETuple !TupleExp
|
||||
| SECount !CountType
|
||||
| SENamedArg !Iden !SQLExp
|
||||
@ -309,6 +320,7 @@ data SQLExp
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData SQLExp
|
||||
instance Cacheable SQLExp
|
||||
instance Hashable SQLExp
|
||||
|
||||
withTyAnn :: PGScalarType -> SQLExp -> SQLExp
|
||||
withTyAnn colTy v = SETyAnn v . mkTypeAnn $ PGTypeScalar colTy
|
||||
@ -318,7 +330,7 @@ instance J.ToJSON SQLExp where
|
||||
|
||||
newtype Alias
|
||||
= Alias { getAlias :: Iden }
|
||||
deriving (Show, Eq, NFData, Hashable, Data, Cacheable)
|
||||
deriving (Show, Eq, NFData, Data, Cacheable, Hashable)
|
||||
|
||||
instance IsIden Alias where
|
||||
toIden (Alias iden) = iden
|
||||
@ -370,6 +382,9 @@ instance ToSQL SQLExp where
|
||||
<> toSQL i
|
||||
toSQL (SEArray exps) = "ARRAY" <> TB.char '['
|
||||
<> (", " <+> exps) <> TB.char ']'
|
||||
toSQL (SEArrayIndex arrayExp indexExp) =
|
||||
paren (toSQL arrayExp)
|
||||
<> TB.char '[' <> toSQL indexExp <> TB.char ']'
|
||||
toSQL (SETuple tup) = toSQL tup
|
||||
toSQL (SECount ty) = "COUNT" <> paren (toSQL ty)
|
||||
-- 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)
|
||||
instance NFData Extractor
|
||||
instance Cacheable Extractor
|
||||
instance Hashable Extractor
|
||||
|
||||
mkSQLOpExp
|
||||
:: SQLOp
|
||||
@ -431,6 +447,7 @@ data DistinctExpr
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData DistinctExpr
|
||||
instance Cacheable DistinctExpr
|
||||
instance Hashable DistinctExpr
|
||||
|
||||
instance ToSQL DistinctExpr where
|
||||
toSQL DistinctSimple = "DISTINCT"
|
||||
@ -444,6 +461,7 @@ data FunctionArgs
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
instance NFData FunctionArgs
|
||||
instance Cacheable FunctionArgs
|
||||
instance Hashable FunctionArgs
|
||||
|
||||
instance ToSQL FunctionArgs where
|
||||
toSQL (FunctionArgs positionalArgs namedArgsMap) =
|
||||
@ -458,6 +476,7 @@ data DefinitionListItem
|
||||
} deriving (Show, Eq, Data, Generic)
|
||||
instance NFData DefinitionListItem
|
||||
instance Cacheable DefinitionListItem
|
||||
instance Hashable DefinitionListItem
|
||||
|
||||
instance ToSQL DefinitionListItem where
|
||||
toSQL (DefinitionListItem column columnType) =
|
||||
@ -470,6 +489,7 @@ data FunctionAlias
|
||||
} deriving (Show, Eq, Data, Generic)
|
||||
instance NFData FunctionAlias
|
||||
instance Cacheable FunctionAlias
|
||||
instance Hashable FunctionAlias
|
||||
|
||||
mkSimpleFunctionAlias :: Iden -> FunctionAlias
|
||||
mkSimpleFunctionAlias identifier =
|
||||
@ -494,6 +514,7 @@ data FunctionExp
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
instance NFData FunctionExp
|
||||
instance Cacheable FunctionExp
|
||||
instance Hashable FunctionExp
|
||||
|
||||
instance ToSQL FunctionExp where
|
||||
toSQL (FunctionExp qf args alsM) =
|
||||
@ -505,11 +526,13 @@ data FromItem
|
||||
| FIFunc !FunctionExp
|
||||
| FIUnnest ![SQLExp] !Alias ![SQLExp]
|
||||
| FISelect !Lateral !Select !Alias
|
||||
| FISelectWith !Lateral !(SelectWithG Select) !Alias
|
||||
| FIValues !ValuesExp !Alias !(Maybe [PGCol])
|
||||
| FIJoin !JoinExpr
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData FromItem
|
||||
instance Cacheable FromItem
|
||||
instance Hashable FromItem
|
||||
|
||||
mkSelFromItem :: Select -> Alias -> FromItem
|
||||
mkSelFromItem = FISelect (Lateral False)
|
||||
@ -532,6 +555,8 @@ instance ToSQL FromItem where
|
||||
"UNNEST" <> paren (", " <+> args) <-> toSQL als <> paren (", " <+> cols)
|
||||
toSQL (FISelect mla sel 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) =
|
||||
paren (toSQL valsExp) <-> toSQL al
|
||||
<-> toSQL (toColTupExp <$> mCols)
|
||||
@ -539,7 +564,7 @@ instance ToSQL FromItem where
|
||||
toSQL je
|
||||
|
||||
newtype Lateral = Lateral Bool
|
||||
deriving (Show, Eq, Data, NFData, Cacheable)
|
||||
deriving (Show, Eq, Data, NFData, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL Lateral where
|
||||
toSQL (Lateral True) = "LATERAL"
|
||||
@ -554,6 +579,7 @@ data JoinExpr
|
||||
} deriving (Show, Eq, Generic, Data)
|
||||
instance NFData JoinExpr
|
||||
instance Cacheable JoinExpr
|
||||
instance Hashable JoinExpr
|
||||
|
||||
instance ToSQL JoinExpr where
|
||||
toSQL je =
|
||||
@ -570,6 +596,7 @@ data JoinType
|
||||
deriving (Eq, Show, Generic, Data)
|
||||
instance NFData JoinType
|
||||
instance Cacheable JoinType
|
||||
instance Hashable JoinType
|
||||
|
||||
instance ToSQL JoinType where
|
||||
toSQL Inner = "INNER JOIN"
|
||||
@ -583,6 +610,7 @@ data JoinCond
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData JoinCond
|
||||
instance Cacheable JoinCond
|
||||
instance Hashable JoinCond
|
||||
|
||||
instance ToSQL JoinCond where
|
||||
toSQL (JoinOn be) =
|
||||
@ -606,6 +634,7 @@ data BoolExp
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData BoolExp
|
||||
instance Cacheable BoolExp
|
||||
instance Hashable BoolExp
|
||||
|
||||
-- removes extraneous 'AND true's
|
||||
simplifyBoolExp :: BoolExp -> BoolExp
|
||||
@ -661,6 +690,7 @@ data BinOp = AndOp | OrOp
|
||||
deriving (Show, Eq, Generic, Data)
|
||||
instance NFData BinOp
|
||||
instance Cacheable BinOp
|
||||
instance Hashable BinOp
|
||||
|
||||
instance ToSQL BinOp where
|
||||
toSQL AndOp = "AND"
|
||||
@ -689,6 +719,7 @@ data CompareOp
|
||||
deriving (Eq, Generic, Data)
|
||||
instance NFData CompareOp
|
||||
instance Cacheable CompareOp
|
||||
instance Hashable CompareOp
|
||||
|
||||
instance Show CompareOp where
|
||||
show = \case
|
||||
@ -835,7 +866,7 @@ instance ToSQL SQLConflict where
|
||||
|
||||
newtype ValuesExp
|
||||
= ValuesExp [TupleExp]
|
||||
deriving (Show, Eq, Data, NFData, Cacheable)
|
||||
deriving (Show, Eq, Data, NFData, Cacheable, Hashable)
|
||||
|
||||
instance ToSQL ValuesExp where
|
||||
toSQL (ValuesExp tuples) =
|
||||
@ -874,14 +905,20 @@ instance ToSQL CTE where
|
||||
CTEUpdate q -> toSQL q
|
||||
CTEDelete q -> toSQL q
|
||||
|
||||
data SelectWith
|
||||
data SelectWithG v
|
||||
= SelectWith
|
||||
{ swCTEs :: [(Alias, CTE)]
|
||||
{ swCTEs :: ![(Alias, v)]
|
||||
, 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) =
|
||||
"WITH " <> (", " <+> map f ctes) <-> toSQL sel
|
||||
where
|
||||
f (Alias al, q) = toSQL al <-> "AS" <-> paren (toSQL q)
|
||||
|
||||
type SelectWith = SelectWithG CTE
|
||||
|
@ -1,5 +1,6 @@
|
||||
module Hasura.SQL.Rewrite
|
||||
( prefixNumToAliases
|
||||
, prefixNumToAliasesSelectWith
|
||||
) where
|
||||
|
||||
import qualified Data.HashMap.Strict as Map
|
||||
@ -20,6 +21,11 @@ prefixNumToAliases :: S.Select -> S.Select
|
||||
prefixNumToAliases s =
|
||||
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
|
||||
|
||||
data UniqSt
|
||||
@ -56,6 +62,12 @@ restoringIdens action = do
|
||||
modify' $ \s -> s { _uqIdens = idens }
|
||||
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 sel = do
|
||||
-- this has to be the first thing to process
|
||||
@ -113,6 +125,10 @@ uFromItem fromItem = case fromItem of
|
||||
newSel <- restoringIdens $ uSelect sel
|
||||
newAls <- addAlias al
|
||||
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
|
||||
newValExp <- fmap S.ValuesExp $
|
||||
forM tups $ \(S.TupleExp ts) ->
|
||||
@ -196,8 +212,10 @@ uSqlExp = restoringIdens . \case
|
||||
S.SEExcluded <$> return t
|
||||
S.SEArray l ->
|
||||
S.SEArray <$> mapM uSqlExp l
|
||||
S.SEArrayIndex arrayExp indexExp ->
|
||||
S.SEArrayIndex <$> uSqlExp arrayExp <*> uSqlExp indexExp
|
||||
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.SENamedArg arg val -> S.SENamedArg arg <$> uSqlExp val
|
||||
S.SEFunction funcExp -> S.SEFunction <$> uFunctionExp funcExp
|
||||
|
@ -3,68 +3,68 @@
|
||||
module Hasura.Server.App where
|
||||
|
||||
import Control.Concurrent.MVar.Lifted
|
||||
import Control.Exception (IOException, try)
|
||||
import Control.Lens (view, _2)
|
||||
import Control.Exception (IOException, try)
|
||||
import Control.Lens (view, _2)
|
||||
import Control.Monad.Stateless
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
import Data.Aeson hiding (json)
|
||||
import Data.Either (isRight)
|
||||
import Data.Int (Int64)
|
||||
import Control.Monad.Trans.Control (MonadBaseControl)
|
||||
import Data.Aeson hiding (json)
|
||||
import Data.Either (isRight)
|
||||
import Data.Int (Int64)
|
||||
import Data.IORef
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||
import Network.Mime (defaultMimeLookup)
|
||||
import System.Exit (exitFailure)
|
||||
import System.FilePath (joinPath, takeFileName)
|
||||
import Web.Spock.Core ((<//>))
|
||||
import Data.Time.Clock (UTCTime)
|
||||
import Data.Time.Clock.POSIX (getPOSIXTime)
|
||||
import Network.Mime (defaultMimeLookup)
|
||||
import System.Exit (exitFailure)
|
||||
import System.FilePath (joinPath, takeFileName)
|
||||
import Web.Spock.Core ((<//>))
|
||||
|
||||
import qualified Control.Concurrent.Async.Lifted.Safe as LA
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.HashSet as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Handler.WebSockets as WS
|
||||
import qualified Network.WebSockets as WS
|
||||
import qualified System.Metrics as EKG
|
||||
import qualified System.Metrics.Json as EKG
|
||||
import qualified Text.Mustache as M
|
||||
import qualified Web.Spock.Core as Spock
|
||||
import qualified Control.Concurrent.Async.Lifted.Safe as LA
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import qualified Data.CaseInsensitive as CI
|
||||
import qualified Data.HashMap.Strict as M
|
||||
import qualified Data.HashSet as S
|
||||
import qualified Data.Text as T
|
||||
import qualified Database.PG.Query as Q
|
||||
import qualified Network.HTTP.Client as HTTP
|
||||
import qualified Network.HTTP.Types as HTTP
|
||||
import qualified Network.Wai as Wai
|
||||
import qualified Network.Wai.Handler.WebSockets as WS
|
||||
import qualified Network.WebSockets as WS
|
||||
import qualified System.Metrics as EKG
|
||||
import qualified System.Metrics.Json as EKG
|
||||
import qualified Text.Mustache as M
|
||||
import qualified Web.Spock.Core as Spock
|
||||
|
||||
import Hasura.EncJSON
|
||||
-- import Hasura.GraphQL.Resolve.Action
|
||||
import Hasura.GraphQL.Logging (MonadQueryLog (..))
|
||||
import Hasura.HTTP
|
||||
import Hasura.Prelude hiding (get, put)
|
||||
import Hasura.Prelude hiding (get, put)
|
||||
import Hasura.RQL.DDL.Schema
|
||||
import Hasura.RQL.Types
|
||||
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.Auth (AuthMode (..), UserAuthentication (..))
|
||||
import Hasura.Server.Auth (AuthMode (..), UserAuthentication (..))
|
||||
import Hasura.Server.Compression
|
||||
import Hasura.Server.Cors
|
||||
import Hasura.Server.Init
|
||||
import Hasura.Server.Logging
|
||||
import Hasura.Server.Middleware (corsMiddleware)
|
||||
import Hasura.Server.Middleware (corsMiddleware)
|
||||
import Hasura.Server.Utils
|
||||
import Hasura.Server.Version
|
||||
import Hasura.SQL.Types
|
||||
import Hasura.Session
|
||||
import Hasura.SQL.Types
|
||||
|
||||
import qualified Hasura.GraphQL.Execute as E
|
||||
import qualified Hasura.GraphQL.Execute.LiveQuery as EL
|
||||
import qualified Hasura.GraphQL.Execute as E
|
||||
import qualified Hasura.GraphQL.Execute.LiveQuery as EL
|
||||
-- import qualified Hasura.GraphQL.Explain as GE
|
||||
import qualified Hasura.GraphQL.Transport.HTTP as GH
|
||||
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
|
||||
import qualified Hasura.GraphQL.Transport.WebSocket as WS
|
||||
import qualified Hasura.GraphQL.Transport.HTTP 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.Server as WS
|
||||
import qualified Hasura.Logging as L
|
||||
import qualified Hasura.Server.API.PGDump as PGD
|
||||
import qualified Hasura.Logging as L
|
||||
import qualified Hasura.Server.API.PGDump as PGD
|
||||
import qualified Network.Wai.Handler.WebSockets.Custom as WSC
|
||||
|
||||
|
||||
@ -350,7 +350,8 @@ v1Alpha1GQHandler queryType query = do
|
||||
|
||||
v1GQHandler
|
||||
:: (HasVersion, MonadIO m)
|
||||
=> GH.GQLBatchedReqs GH.GQLQueryText -> Handler m (HttpResponse EncJSON)
|
||||
=> GH.GQLBatchedReqs GH.GQLQueryText
|
||||
-> Handler m (HttpResponse EncJSON)
|
||||
v1GQHandler = v1Alpha1GQHandler E.QueryHasura
|
||||
|
||||
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