server: implement transaction workaround

GitOrigin-RevId: 404f8bb

Author: Antoine Leblanc

CHANGELOG.md

@@ -3,6 +3,31 @@
 ## Next release
 (Add entries here in the order of: server, console, cli, docs, others)
 
+### Transactions for Postgres mutations
+
+With v2 came the introduction of heterogeneous execution: in one query or mutation, you can target different sources: it is possible, for instance, in one mutation, to both insert a row in a table in a table on Postgres and another row in another table on MSSQL:
+
+```
+mutation {
+  // goes to Postgres
+  insert_author_one(object: {name: "Simon Peyton Jones"}) {
+    name
+  }
+
+  // goes to MSSQL
+  insert_publication_one(object: {name: "Template meta-programming for Haskell"}) {
+    name
+  }
+}
+```
+
+However, heterogeneous execution has a cost: we can no longer run mutations as a transaction, given that each part may target a different database. This is a regression compared to v1.
+
+While we want to fix this by offering, in the future, an explicit API that allows our users to *choose* when a series of mutations are executed as a transaction, for now we are introducing the following optimisation: when all the fields in a mutation target the same Postgres source, we will run them as a transaction like we would have in v1.
+
+
+### Bug fixes and improvements
+
 - server: add `--async-actions-fetch-interval` command-line flag and `HASURA_GRAPHQL_ASYNC_ACTIONS_FETCH_INTERVAL` environment variable for configuring
           async actions re-fetch interval from metadata storage (fix #6460)
 - server: add 'replace_configuration' option (default: false) in the add source API payload

server/src-lib/Hasura/Backends/MSSQL/Instances/Execute.hs

@@ -57,18 +57,19 @@ msDBQueryPlan
   -> [HTTP.Header]
   -> UserInfo
   -> [G.Directive G.Name]
+  -> SourceName
   -> SourceConfig 'MSSQL
   -> QueryDB 'MSSQL (UnpreparedValue 'MSSQL)
   -> m ExecutionStep
-msDBQueryPlan _env _manager _reqHeaders userInfo _directives sourceConfig qrf = do
+msDBQueryPlan _env _manager _reqHeaders userInfo _directives sourceName sourceConfig qrf = do
   select <- fromSelect <$> planNoPlan userInfo qrf
   let queryString = ODBC.renderQuery $ toQueryPretty select
       pool  = _mscConnectionPool sourceConfig
       odbcQuery = encJFromText <$> runJSONPathQuery pool (toQueryFlat select)
   pure
     $ ExecStepDB []
     . AB.mkAnyBackend
-    $ DBStepInfo sourceConfig (Just queryString) odbcQuery
+    $ DBStepInfo sourceName sourceConfig (Just queryString) odbcQuery
 
 -- mutation
 
@@ -81,10 +82,11 @@ msDBMutationPlan
   -> [HTTP.Header]
   -> UserInfo
   -> Bool
+  -> SourceName
   -> SourceConfig 'MSSQL
   -> MutationDB 'MSSQL (UnpreparedValue 'MSSQL)
   -> m ExecutionStep
-msDBMutationPlan _env _manager _reqHeaders _userInfo _stringifyNum _sourceConfig _mrf =
+msDBMutationPlan _env _manager _reqHeaders _userInfo _stringifyNum _sourceName _sourceConfig _mrf =
   throw500 "mutations are not supported in MSSQL; this should be unreachable"
 
 
@@ -95,10 +97,11 @@ msDBSubscriptionPlan
      ( MonadError QErr m
      )
   => UserInfo
+  -> SourceName
   -> SourceConfig 'MSSQL
   -> InsOrdHashMap G.Name (QueryDB 'MSSQL (UnpreparedValue 'MSSQL))
   -> m (LiveQueryPlan 'MSSQL (MultiplexedQuery 'MSSQL))
-msDBSubscriptionPlan userInfo sourceConfig rootFields = do
+msDBSubscriptionPlan userInfo _sourceName sourceConfig rootFields = do
   -- WARNING: only keeping the first root field for now!
   query <- traverse mkQuery $ head $ OMap.toList rootFields
   let roleName = _uiRole userInfo

server/src-lib/Hasura/Backends/Postgres/Instances/Execute.hs

@@ -58,17 +58,18 @@ pgDBQueryPlan
   -> [HTTP.Header]
   -> UserInfo
   -> [G.Directive G.Name]
+  -> SourceName
   -> SourceConfig 'Postgres
   -> QueryDB 'Postgres (UnpreparedValue 'Postgres)
   -> m ExecutionStep
-pgDBQueryPlan env manager reqHeaders userInfo _directives sourceConfig qrf = do
+pgDBQueryPlan env manager reqHeaders userInfo _directives sourceName sourceConfig qrf = do
   (preparedQuery, PlanningSt _ _ planVals expectedVariables) <- flip runStateT initPlanningSt $ traverseQueryDB prepareWithPlan qrf
   validateSessionVariables expectedVariables $ _uiSession userInfo
   let (action, preparedSQL) = mkCurPlanTx env manager reqHeaders userInfo $ irToRootFieldPlan planVals preparedQuery
   pure
     $ ExecStepDB []
     . AB.mkAnyBackend
-    $ DBStepInfo sourceConfig preparedSQL action
+    $ DBStepInfo sourceName sourceConfig preparedSQL action
 
 
 -- mutation
@@ -164,10 +165,11 @@ pgDBMutationPlan
   -> [HTTP.Header]
   -> UserInfo
   -> Bool
+  -> SourceName
   -> SourceConfig 'Postgres
   -> MutationDB 'Postgres (UnpreparedValue 'Postgres)
   -> m ExecutionStep
-pgDBMutationPlan env manager reqHeaders userInfo stringifyNum sourceConfig mrf =
+pgDBMutationPlan env manager reqHeaders userInfo stringifyNum sourceName sourceConfig mrf =
     go <$> case mrf of
     MDBInsert s              -> convertInsert env userSession remoteJoinCtx s stringifyNum
     MDBUpdate s              -> convertUpdate env userSession remoteJoinCtx s stringifyNum
@@ -176,7 +178,8 @@ pgDBMutationPlan env manager reqHeaders userInfo stringifyNum sourceConfig mrf =
   where
     userSession = _uiSession userInfo
     remoteJoinCtx = (manager, reqHeaders, userInfo)
-    go = ExecStepDB [] . AB.mkAnyBackend . DBStepInfo sourceConfig Nothing
+    go = ExecStepDB [] . AB.mkAnyBackend . DBStepInfo sourceName sourceConfig Nothing
+
 
 -- subscription
 
@@ -186,10 +189,11 @@ pgDBSubscriptionPlan
      , MonadIO m
      )
   => UserInfo
+  -> SourceName
   -> SourceConfig 'Postgres
   -> InsOrdHashMap G.Name (QueryDB 'Postgres (UnpreparedValue 'Postgres))
   -> m (LiveQueryPlan 'Postgres (MultiplexedQuery 'Postgres))
-pgDBSubscriptionPlan userInfo sourceConfig unpreparedAST = do
+pgDBSubscriptionPlan userInfo _sourceName sourceConfig unpreparedAST = do
   (preparedAST, PGL.QueryParametersInfo{..}) <- flip runStateT mempty $
     for unpreparedAST $ traverseQueryDB PGL.resolveMultiplexedValue
   let multiplexedQuery = PGL.mkMultiplexedQuery preparedAST

server/src-lib/Hasura/Backends/Postgres/Instances/Transport.hs

@@ -1,11 +1,14 @@
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 
-module Hasura.Backends.Postgres.Instances.Transport () where
+module Hasura.Backends.Postgres.Instances.Transport
+  ( runPGMutationTransaction
+  ) where
 
 import           Hasura.Prelude
 
 import qualified Data.Aeson                                 as J
 import qualified Data.ByteString                            as B
+import qualified Data.HashMap.Strict.InsOrd                 as OMap
 import qualified Database.PG.Query                          as Q
 import qualified Language.GraphQL.Draft.Syntax              as G
 
@@ -84,7 +87,7 @@ runPGMutation reqId query fieldName userInfo logger sourceConfig tx _genSql =  d
       . runLazyTx (_pscExecCtx sourceConfig) Q.ReadWrite
       . withTraceContext ctx
       . withUserInfo userInfo
-      )  tx
+      ) tx
 
 runPGSubscription
   :: ( MonadIO m
@@ -110,3 +113,32 @@ mkQueryLog gqlQuery fieldName preparedSql requestId =
   where
     generatedQuery = preparedSql <&> \(EQ.PreparedSql query args _) ->
       GeneratedQuery (Q.getQueryText query) (J.toJSON $ pgScalarValueToJson . snd <$> args)
+
+
+-- ad-hoc transaction optimisation
+-- see Note [Backwards-compatible transaction optimisation]
+
+runPGMutationTransaction
+  :: ( MonadIO m
+     , MonadError QErr m
+     , MonadQueryLog m
+     , MonadTrace m
+     )
+  => RequestId
+  -> GQLReqUnparsed
+  -> UserInfo
+  -> L.Logger L.Hasura
+  -> SourceConfig 'Postgres
+  -> InsOrdHashMap G.Name (DBStepInfo 'Postgres)
+  -> m (DiffTime, InsOrdHashMap G.Name EncJSON)
+runPGMutationTransaction reqId query userInfo logger sourceConfig mutations = do
+  logQueryLog logger $ mkQueryLog query $$(G.litName "transaction") Nothing reqId
+  ctx <- Tracing.currentContext
+  withElapsedTime $ do
+    Tracing.interpTraceT (
+      liftEitherM . liftIO . runExceptT
+      . runLazyTx (_pscExecCtx sourceConfig) Q.ReadWrite
+      . withTraceContext ctx
+      . withUserInfo userInfo
+      ) $ flip OMap.traverseWithKey mutations \fieldName dbsi ->
+            trace ("Postgres Mutation for root field " <>> fieldName) $ dbsiAction dbsi

server/src-lib/Hasura/GraphQL/Execute.hs

@@ -239,7 +239,7 @@ buildSubscriptionPlan userInfo rootFields = do
         \(C.SourceConfigWith (sourceConfig :: SourceConfig b) _) -> do
            qdbs <- traverse (checkField @b sourceName) allFields
            LQP . AB.mkAnyBackend . MultiplexedLiveQueryPlan
-             <$> EB.mkDBSubscriptionPlan userInfo sourceConfig qdbs
+             <$> EB.mkDBSubscriptionPlan userInfo sourceName sourceConfig qdbs
       pure (sourceName, lqp)
 
     checkField

server/src-lib/Hasura/GraphQL/Execute/Backend.hs

@@ -24,6 +24,7 @@ import           Hasura.GraphQL.Execute.LiveQuery.Plan
 import           Hasura.GraphQL.Parser                  hiding (Type)
 import           Hasura.RQL.IR.RemoteJoin
 import           Hasura.RQL.Types.Backend
+import           Hasura.RQL.Types.Common
 import           Hasura.RQL.Types.Error
 import           Hasura.RQL.Types.RemoteSchema
 import           Hasura.SQL.Backend
@@ -55,6 +56,7 @@ class ( Backend b
     -> [HTTP.Header]
     -> UserInfo
     -> [G.Directive G.Name]
+    -> SourceName
     -> SourceConfig b
     -> QueryDB b (UnpreparedValue b)
     -> m ExecutionStep
@@ -68,6 +70,7 @@ class ( Backend b
     -> [HTTP.Header]
     -> UserInfo
     -> Bool
+    -> SourceName
     -> SourceConfig b
     -> MutationDB b (UnpreparedValue b)
     -> m ExecutionStep
@@ -77,15 +80,17 @@ class ( Backend b
        , MonadIO m
        )
     => UserInfo
+    -> SourceName
     -> SourceConfig b
     -> InsOrdHashMap G.Name (QueryDB b (UnpreparedValue b))
     -> m (LiveQueryPlan b (MultiplexedQuery b))
 
-data DBStepInfo b =
-  DBStepInfo
-    (SourceConfig b)
-    (Maybe (PreparedQuery b))
-    (ExecutionMonad b EncJSON)
+data DBStepInfo b = DBStepInfo
+  { dbsiSourceName    :: SourceName
+  , dbsiSourceConfig  :: SourceConfig b
+  , dbsiPreparedQuery :: Maybe (PreparedQuery b)
+  , dbsiAction        :: ExecutionMonad b EncJSON
+  }
 
 -- | One execution step to processing a GraphQL query (e.g. one root field).
 data ExecutionStep where
@@ -119,5 +124,5 @@ getRemoteSchemaInfo
      . BackendExecute b
     => DBStepInfo b
     -> [RemoteSchemaInfo]
-getRemoteSchemaInfo (DBStepInfo _ genSql _) =
+getRemoteSchemaInfo (DBStepInfo _ _ genSql _) =
     IR._rjRemoteSchema <$> maybe [] (getRemoteJoins @b) genSql

server/src-lib/Hasura/GraphQL/Execute/Mutation.hs

@@ -81,10 +81,10 @@ convertMutationSelectionSet env logger gqlContext SQLGenCtx{stringifyNum} userIn
 
   -- Transform the RQL AST into a prepared SQL query
   txs <- for unpreparedQueries \case
-    RFDB _ exists ->
+    RFDB sourceName exists ->
       AB.dispatchAnyBackend @BackendExecute exists
         \(SourceConfigWith sourceConfig (MDBR db)) ->
-           mkDBMutationPlan env manager reqHeaders userInfo stringifyNum sourceConfig db
+           mkDBMutationPlan env manager reqHeaders userInfo stringifyNum sourceName sourceConfig db
     RFRemote remoteField -> do
       RemoteFieldG remoteSchemaInfo resolvedRemoteField <- resolveRemoteField userInfo remoteField
       pure $ buildExecStepRemote remoteSchemaInfo G.OperationTypeMutation $ [G.SelectionField resolvedRemoteField]

server/src-lib/Hasura/GraphQL/Execute/Query.hs

@@ -79,10 +79,10 @@ convertQuerySelSet env logger gqlContext userInfo manager reqHeaders directives
   -- Transform the query plans into an execution plan
   let usrVars = _uiSession userInfo
   executionPlan <- for unpreparedQueries \case
-    RFDB _ exists ->
+    RFDB sourceName exists ->
       AB.dispatchAnyBackend @BackendExecute exists
         \(SourceConfigWith sourceConfig (QDBR db)) ->
-           mkDBQueryPlan env manager reqHeaders userInfo directives sourceConfig db
+           mkDBQueryPlan env manager reqHeaders userInfo directives sourceName sourceConfig db
     RFRemote rf -> do
       RemoteFieldG remoteSchemaInfo remoteField <- for rf $ resolveRemoteVariable userInfo
       pure $ buildExecStepRemote remoteSchemaInfo G.OperationTypeQuery [G.SelectionField remoteField]