Repository: hasura/graphql-engine
File: server/src-lib/Hasura/GraphQL/Resolve/Action.hs (Haskell)

Code before:
  -> m (RespTx, HTTP.ResponseHeaders)
resolveActionMutationSync field executionContext userInfo = do
  let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field
      actionContext = ActionContext actionName
      sessionVariables = _uiSession userInfo
      handlerPayload = ActionWebhookPayload actionContext sessionVariables inputArgs
  manager <- asks getter
  reqHeaders <- asks getter
  (webhookRes, respHeaders) <- callWebhook manager outputType outputFields reqHeaders confHeaders
                               forwardClientHeaders resolvedWebhook handlerPayload
  let webhookResponseExpression = RS.AEInput $ UVSQL $
        toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes
  selectAstUnresolved <-
    processOutputSelectionSet webhookResponseExpression outputType definitionList
    (_fType field) $ _fSelSet field
  astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved
  let (astResolved',remoteJoins) = RJ.getRemoteJoins astResolved
  let jsonAggType = mkJsonAggSelect outputType
  return $ (,respHeaders) $
    case remoteJoins of
      Just remoteJoins' ->
        let query = Q.fromBuilder $ toSQL $ RS.mkSQLSelect jsonAggType astResolved'
        in RJ.executeQueryWithRemoteJoins manager reqHeaders userInfo query [] remoteJoins'
      Nothing ->
        asSingleRowJsonResp (Q.fromBuilder $ toSQL $ RS.mkSQLSelect jsonAggType astResolved) []

  where
    ActionExecutionContext actionName outputType outputFields definitionList resolvedWebhook confHeaders
      forwardClientHeaders = executionContext

-- QueryActionExecuter is a type for a higher function, this is being used
-- to allow or disallow where a query action can be executed. We would like
-- to explicitly control where a query action can be run.
-- Example: We do not explain a query action, so we use the `restrictActionExecuter`
-- to prevent resolving the action query.
type QueryActionExecuter =
  forall m a. (MonadError QErr m)
  => (HTTP.Manager -> [HTTP.Header] -> m a)
  -> m a

allowQueryActionExecuter :: HTTP.Manager -> [HTTP.Header] -> QueryActionExecuter
allowQueryActionExecuter manager reqHeaders actionResolver =
  actionResolver manager reqHeaders

restrictActionExecuter :: Text -> QueryActionExecuter
restrictActionExecuter errMsg _ =
  throw400 NotSupported errMsg

resolveActionQuery
  :: ( HasVersion
     , MonadReusability m

Review comment (suggestion):
Minor naming suggestions.
`astResolved'` -> `astResolvedWithoutRemoteJoins`
`remoteJoins` -> `maybeRemoteJoins`
`remoteJoins'` -> `remoteJoins`. 

Code after:
  -> m (RespTx, HTTP.ResponseHeaders)
resolveActionMutationSync field executionContext userInfo = do
  let inputArgs = J.toJSON $ fmap annInpValueToJson $ _fArguments field
      actionContext = ActionContext actionName
      sessionVariables = _uiSession userInfo
      handlerPayload = ActionWebhookPayload actionContext sessionVariables inputArgs
  manager <- asks getter
  reqHeaders <- asks getter
  (webhookRes, respHeaders) <- callWebhook manager outputType outputFields reqHeaders confHeaders
                               forwardClientHeaders resolvedWebhook handlerPayload
  let webhookResponseExpression = RS.AEInput $ UVSQL $
        toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes
  selectAstUnresolved <-
    processOutputSelectionSet webhookResponseExpression outputType definitionList
    (_fType field) $ _fSelSet field
  astResolved <- RS.traverseAnnSimpleSel resolveValTxt selectAstUnresolved
  let (astResolvedWithoutRemoteJoins,maybeRemoteJoins) = RJ.getRemoteJoins astResolved
  let 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
    ActionExecutionContext actionName outputType outputFields definitionList resolvedWebhook confHeaders
      forwardClientHeaders = executionContext

-- QueryActionExecuter is a type for a higher function, this is being used
-- to allow or disallow where a query action can be executed. We would like
-- to explicitly control where a query action can be run.
-- Example: We do not explain a query action, so we use the `restrictActionExecuter`
-- to prevent resolving the action query.
type QueryActionExecuter =
  forall m a. (MonadError QErr m)
  => (HTTP.Manager -> [HTTP.Header] -> m a)
  -> m a

allowQueryActionExecuter :: HTTP.Manager -> [HTTP.Header] -> QueryActionExecuter
allowQueryActionExecuter manager reqHeaders actionResolver =
  actionResolver manager reqHeaders

restrictActionExecuter :: Text -> QueryActionExecuter
restrictActionExecuter errMsg _ =
  throw400 NotSupported errMsg

resolveActionQuery
  :: ( HasVersion
     , MonadReusability m