server: generalized LogQueryLog (fix #708)

GitOrigin-RevId: 0e18e0f5caaa6889804debf7111ef9aa99e080b5

server/src-lib/Hasura/App.hs

@@ -25,6 +25,7 @@ import qualified System.Log.FastLogger                     as FL
 import qualified System.Metrics                            as EKG
 import qualified System.Metrics.Gauge                      as EKG.Gauge
 import qualified Text.Mustache.Compile                     as M
+import qualified Web.Spock.Core                            as Spock
 
 import           Control.Concurrent.STM.TVar               (TVar, readTVarIO)
 import           Control.Exception                         (bracket_, throwIO)
@@ -57,7 +58,7 @@ import           Hasura.Eventing.ScheduledTrigger
 import           Hasura.GraphQL.Execute                    (MonadGQLExecutionCheck (..),
                                                             checkQueryInAllowlist)
 import           Hasura.GraphQL.Execute.Action
-import           Hasura.GraphQL.Logging                    (MonadQueryLog (..), QueryLog (..))
+import           Hasura.GraphQL.Logging                    (MonadQueryLog (..))
 import           Hasura.GraphQL.Transport.HTTP             (MonadExecuteQuery (..))
 import           Hasura.GraphQL.Transport.HTTP.Protocol    (toParsed)
 import           Hasura.Logging
@@ -80,7 +81,7 @@ import           Hasura.Server.Telemetry
 import           Hasura.Server.Types
 import           Hasura.Server.Version
 import           Hasura.Session
-import qualified Web.Spock.Core                            as Spock
+
 
 data ExitCode
 -- these are used during server initialization:
@@ -741,8 +742,7 @@ instance MonadConfigApiHandler PGMetadataStorageApp where
   runConfigApiHandler = configApiGetHandler
 
 instance MonadQueryLog PGMetadataStorageApp where
-  logQueryLog logger query genSqlM reqId =
-    unLogger logger $ QueryLog query genSqlM reqId
+  logQueryLog = unLogger
 
 instance WS.MonadWSLog PGMetadataStorageApp where
   logWSLog = unLogger

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

@@ -36,7 +36,6 @@ instance BackendExecute 'MSSQL where
   mkDBSubscriptionPlan = msDBSubscriptionPlan
 
 
-
 -- multiplexed query
 
 newtype NoMultiplex = NoMultiplex (G.Name, ODBC.Query)

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

@@ -4,6 +4,7 @@ module Hasura.Backends.MSSQL.Instances.Transport () where
 
 import           Hasura.Prelude
 
+import qualified Data.Aeson                              as J
 import qualified Data.ByteString                         as B
 import qualified Language.GraphQL.Draft.Syntax           as G
 
@@ -18,7 +19,7 @@ import           Hasura.Backends.MSSQL.Instances.Execute
 import           Hasura.EncJSON
 import           Hasura.GraphQL.Execute.Backend
 import           Hasura.GraphQL.Execute.LiveQuery.Plan
-import           Hasura.GraphQL.Logging                  (MonadQueryLog (..))
+import           Hasura.GraphQL.Logging
 import           Hasura.GraphQL.Transport.Backend
 import           Hasura.GraphQL.Transport.HTTP.Protocol
 import           Hasura.RQL.Types
@@ -48,10 +49,8 @@ runQuery
   -> Maybe Text
   -> m (DiffTime, EncJSON)
   -- ^ Also return the time spent in the PG query; for telemetry.
-runQuery reqId query fieldName _userInfo logger _sourceConfig tx _genSql =  do
-  -- log the generated SQL and the graphql query
-  -- FIXME: fix logging by making logQueryLog expect something backend agnostic!
-  logQueryLog logger query Nothing reqId
+runQuery reqId query fieldName _userInfo logger _sourceConfig tx genSql =  do
+  logQueryLog logger $ mkQueryLog query fieldName genSql reqId
   withElapsedTime
     $ trace ("MSSQL Query for root field " <>> fieldName)
     $ run tx
@@ -74,8 +73,7 @@ runMutation
   -- ^ Also return 'Mutation' when the operation was a mutation, and the time
   -- spent in the PG query; for telemetry.
 runMutation reqId query fieldName _userInfo logger _sourceConfig tx _genSql =  do
-  -- log the graphql query
-  logQueryLog logger query Nothing reqId
+  logQueryLog logger $ mkQueryLog query fieldName Nothing reqId
   withElapsedTime
     $ trace ("MSSQL Mutation for root field " <>> fieldName)
     $ run tx
@@ -100,7 +98,19 @@ runSubscription sourceConfig (NoMultiplex (name, query)) variables = do
     addFieldName result =
       "{\"" <> G.unName name <> "\":" <> result <> "}"
 
+
 run :: (MonadIO m, MonadError QErr m) => ExceptT QErr IO a -> m a
 run action = do
   result <- liftIO $ runExceptT action
   result `onLeft` throwError
+
+mkQueryLog
+  :: GQLReqUnparsed
+  -> G.Name
+  -> Maybe Text
+  -> RequestId
+  -> QueryLog
+mkQueryLog gqlQuery fieldName preparedSql requestId =
+  QueryLog gqlQuery ((fieldName,) <$> generatedQuery) requestId
+  where
+    generatedQuery = preparedSql <&> \qs -> GeneratedQuery qs J.Null

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

@@ -4,6 +4,7 @@ module Hasura.Backends.Postgres.Instances.Transport () where
 
 import           Hasura.Prelude
 
+import qualified Data.Aeson                                 as J
 import qualified Data.ByteString                            as B
 import qualified Database.PG.Query                          as Q
 import qualified Language.GraphQL.Draft.Syntax              as G
@@ -16,10 +17,11 @@ import qualified Hasura.GraphQL.Execute.Query               as EQ
 import qualified Hasura.Logging                             as L
 import qualified Hasura.Tracing                             as Tracing
 
+import           Hasura.Backends.Postgres.SQL.Value
 import           Hasura.EncJSON
 import           Hasura.GraphQL.Execute.Backend
 import           Hasura.GraphQL.Execute.LiveQuery.Plan
-import           Hasura.GraphQL.Logging                     (MonadQueryLog (..))
+import           Hasura.GraphQL.Logging
 import           Hasura.GraphQL.Transport.Backend
 import           Hasura.GraphQL.Transport.HTTP.Protocol
 import           Hasura.RQL.Types
@@ -51,7 +53,7 @@ runPGQuery
   -- ^ Also return the time spent in the PG query; for telemetry.
 runPGQuery reqId query fieldName _userInfo logger sourceConfig tx genSql =  do
   -- log the generated SQL and the graphql query
-  logQueryLog logger query ((fieldName,) <$> genSql) reqId
+  logQueryLog logger $ mkQueryLog query fieldName genSql reqId
   withElapsedTime $ trace ("Postgres Query for root field " <>> fieldName) $
     Tracing.interpTraceT id $ hoist (runQueryTx $ _pscExecCtx sourceConfig) tx
 
@@ -74,7 +76,7 @@ runPGMutation
   -- spent in the PG query; for telemetry.
 runPGMutation reqId query fieldName userInfo logger sourceConfig tx _genSql =  do
   -- log the graphql query
-  logQueryLog logger query Nothing reqId
+  logQueryLog logger $ mkQueryLog query fieldName Nothing reqId
   ctx <- Tracing.currentContext
   withElapsedTime $ trace ("Postgres Mutation for root field " <>> fieldName) $
     Tracing.interpTraceT (
@@ -95,3 +97,16 @@ runPGSubscription sourceConfig query variables = withElapsedTime
   $ runExceptT
   $ runQueryTx (_pscExecCtx sourceConfig)
   $ PGL.executeMultiplexedQuery query variables
+
+
+mkQueryLog
+  :: GQLReqUnparsed
+  -> G.Name
+  -> Maybe EQ.PreparedSql
+  -> RequestId
+  -> QueryLog
+mkQueryLog gqlQuery fieldName preparedSql requestId =
+  QueryLog gqlQuery ((fieldName,) <$> generatedQuery) requestId
+  where
+    generatedQuery = preparedSql <&> \(EQ.PreparedSql query args _) ->
+      GeneratedQuery (Q.getQueryText query) (J.toJSON $ pgScalarValueToJson . snd <$> args)

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

@@ -106,6 +106,7 @@ data ExecutionStep where
     -> ExecutionStep
   -- ^ Output a plain JSON object
 
+
 -- | The series of steps that need to be executed for a given query. For now, those steps are all
 -- independent. In the future, when we implement a client-side dataloader and generalized joins,
 -- this will need to be changed into an annotated tree.

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

@@ -5,7 +5,6 @@ module Hasura.GraphQL.Execute.Common
 
 import           Hasura.Prelude
 
-import qualified Data.Aeson                                  as J
 import qualified Data.Environment                            as Env
 import qualified Data.IntMap                                 as IntMap
 import qualified Database.PG.Query                           as Q
@@ -18,7 +17,6 @@ import qualified Hasura.Tracing                              as Tracing
 
 import           Hasura.Backends.Postgres.Connection
 import           Hasura.Backends.Postgres.Execute.RemoteJoin
-import           Hasura.Backends.Postgres.SQL.Value
 import           Hasura.Backends.Postgres.Translate.Select   (asSingleRowJsonResp)
 import           Hasura.EncJSON
 import           Hasura.GraphQL.Context
@@ -36,13 +34,6 @@ data PreparedSql
   , _psRemoteJoins :: !(Maybe (RemoteJoins 'Postgres))
   }
 
--- | Required to log in `query-log`
-instance J.ToJSON PreparedSql where
-  toJSON (PreparedSql q prepArgs _) =
-    J.object [ "query" J..= Q.getQueryText q
-             , "prepared_arguments" J..= fmap (pgScalarValueToJson . snd) prepArgs
-             ]
-
 
 -- turn the current plan into a transaction
 mkCurPlanTx

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

@@ -5,59 +5,68 @@ layer. In contrast with, logging at the HTTP server layer.
 
 module Hasura.GraphQL.Logging
   ( QueryLog(..)
+  , GeneratedQuery(..)
   , MonadQueryLog(..)
   ) where
 
+import           Hasura.Prelude
+
 import qualified Data.Aeson                             as J
 import qualified Language.GraphQL.Draft.Syntax          as G
 
+import qualified Hasura.Logging                         as L
+
 import           Hasura.GraphQL.Transport.HTTP.Protocol (GQLReqUnparsed)
 import           Hasura.Metadata.Class
-import           Hasura.Prelude
 import           Hasura.Server.Types                    (RequestId)
 import           Hasura.Tracing                         (TraceT)
 
-import qualified Hasura.GraphQL.Execute.Query           as EQ
-import qualified Hasura.Logging                         as L
-
 
 -- | A GraphQL query, optionally generated SQL, and the request id makes up the
 -- | 'QueryLog'
-data QueryLog
-  = QueryLog
+data QueryLog = QueryLog
   { _qlQuery        :: !GQLReqUnparsed
-  , _qlGeneratedSql :: !(Maybe (G.Name, EQ.PreparedSql))
+  , _qlGeneratedSql :: !(Maybe (G.Name, GeneratedQuery))
   , _qlRequestId    :: !RequestId
   }
 
+data GeneratedQuery = GeneratedQuery
+  { _gqQueryString  :: Text
+  , _gqPreparedArgs :: J.Value
+  }
+
 instance J.ToJSON QueryLog where
-  toJSON (QueryLog q sql reqId) =
-    J.object [ "query" J..= q
-             , "generated_sql" J..= sql
+  toJSON (QueryLog gqlQuery generatedQuery reqId) =
+    J.object [ "query" J..= gqlQuery
+             , "generated_sql" J..= generatedQuery
              , "request_id" J..= reqId
              ]
 
+instance J.ToJSON GeneratedQuery where
+  toJSON (GeneratedQuery queryString preparedArgs) =
+    J.object [ "query" J..= queryString
+             , "prepared_arguments" J..= preparedArgs
+             ]
+
 instance L.ToEngineLog QueryLog L.Hasura where
   toEngineLog ql = (L.LevelInfo, L.ELTQueryLog, J.toJSON ql)
 
+
 class Monad m => MonadQueryLog m where
   logQueryLog
     :: L.Logger L.Hasura
-    -> GQLReqUnparsed
-    -> Maybe (G.Name, EQ.PreparedSql)
-    -- ^ Generated SQL if any
-    -> RequestId
-    -- ^ unique identifier for a request. NOTE this can be spoofed!
+    -> QueryLog
     -> m ()
 
+
 instance MonadQueryLog m => MonadQueryLog (ExceptT e m) where
-  logQueryLog l req sqlMap reqId = lift $ logQueryLog l req sqlMap reqId
+  logQueryLog logger l = lift $ logQueryLog logger l
 
 instance MonadQueryLog m => MonadQueryLog (ReaderT r m) where
-  logQueryLog l req sqlMap reqId = lift $ logQueryLog l req sqlMap reqId
+  logQueryLog logger l = lift $ logQueryLog logger l
 
 instance MonadQueryLog m => MonadQueryLog (TraceT m) where
-  logQueryLog l req sqlMap reqId = lift $ logQueryLog l req sqlMap reqId
+  logQueryLog logger l = lift $ logQueryLog logger l
 
 instance MonadQueryLog m => MonadQueryLog (MetadataStorageT m) where
-  logQueryLog l req sqlMap reqId = lift $ logQueryLog l req sqlMap reqId
+  logQueryLog logger l = lift $ logQueryLog logger l

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

@@ -10,7 +10,7 @@ import qualified Hasura.Logging                         as L
 import           Hasura.EncJSON
 import           Hasura.GraphQL.Execute.Backend
 import           Hasura.GraphQL.Execute.LiveQuery.Plan
-import           Hasura.GraphQL.Logging                 (MonadQueryLog (..))
+import           Hasura.GraphQL.Logging                 (MonadQueryLog)
 import           Hasura.GraphQL.Transport.HTTP.Protocol
 import           Hasura.RQL.Types.Backend
 import           Hasura.RQL.Types.Error

server/src-lib/Hasura/GraphQL/Transport/HTTP.hs

@@ -47,7 +47,7 @@ import qualified Hasura.Tracing                               as Tracing
 
 import           Hasura.EncJSON
 import           Hasura.GraphQL.Context
-import           Hasura.GraphQL.Logging                       (MonadQueryLog (..))
+import           Hasura.GraphQL.Logging                       (MonadQueryLog)
 import           Hasura.GraphQL.Parser.Column                 (UnpreparedValue (..))
 import           Hasura.GraphQL.Transport.Backend
 import           Hasura.GraphQL.Transport.HTTP.Protocol

server/src-lib/Hasura/GraphQL/Transport/WebSocket.hs

@@ -60,7 +60,7 @@ import qualified Hasura.Server.Telemetry.Counters             as Telem
 import qualified Hasura.Tracing                               as Tracing
 
 import           Hasura.EncJSON
-import           Hasura.GraphQL.Logging                       (MonadQueryLog (..))
+import           Hasura.GraphQL.Logging
 import           Hasura.GraphQL.Transport.Backend
 import           Hasura.GraphQL.Transport.HTTP                (MonadExecuteQuery (..),
                                                                QueryCacheKey (..),
@@ -435,7 +435,7 @@ onStart env serverEnv wsConn (StartMsg opId q) = catchAndIgnore $ do
 
     E.SubscriptionExecutionPlan sourceName (E.LQP (liveQueryPlan :: LQ.LiveQueryPlan b (EB.MultiplexedQuery b))) -> do
       -- log the graphql query
-      logQueryLog logger q Nothing requestId
+      logQueryLog logger $ QueryLog q Nothing requestId
       let subscriberMetadata = LQ.mkSubscriberMetadata $ J.object
                                [ "websocket_id" J..= WS.getWSId wsConn
                                , "operation_id" J..= opId

server/src-lib/Hasura/Logging.hs

@@ -29,9 +29,6 @@ module Hasura.Logging
 
 import           Hasura.Prelude
 
-import           Control.Monad.Trans.Control
-import           Control.Monad.Trans.Managed (ManagedT (..), allocate)
-
 import qualified Control.AutoUpdate          as Auto
 import qualified Data.Aeson                  as J
 import qualified Data.Aeson.TH               as J
@@ -46,6 +43,9 @@ import qualified Data.Time.Format            as Format
 import qualified Data.Time.LocalTime         as Time
 import qualified System.Log.FastLogger       as FL
 
+import           Control.Monad.Trans.Control
+import           Control.Monad.Trans.Managed (ManagedT (..), allocate)
+
 
 newtype FormattedTime
   = FormattedTime { _unFormattedTime :: Text }

server/src-lib/Hasura/Prelude.hs

@@ -47,6 +47,7 @@ import           Control.Monad.Writer.Strict       as M (MonadWriter (..), Write
                                                          execWriterT, runWriterT)
 import           Data.Align                        as M (Semialign (align, alignWith))
 import           Data.Bool                         as M (bool)
+import           Data.Coerce
 import           Data.Data                         as M (Data (..))
 import           Data.Either                       as M (lefts, partitionEithers, rights)
 import           Data.Foldable                     as M (asum, fold, foldrM, for_, toList,
@@ -86,7 +87,6 @@ import qualified Data.Aeson.Casing                 as J
 import qualified Data.ByteString                   as B
 import qualified Data.ByteString.Base64.Lazy       as Base64
 import qualified Data.ByteString.Lazy              as BL
-import           Data.Coerce
 import qualified Data.HashMap.Strict               as Map
 import qualified Data.HashMap.Strict.InsOrd        as OMap
 import qualified Data.Text                         as T
@@ -95,6 +95,7 @@ import qualified Data.Text.Encoding.Error          as TE
 import qualified GHC.Clock                         as Clock
 import qualified Test.QuickCheck                   as QC
 
+
 alphabet :: String
 alphabet = ['a'..'z'] ++ ['A'..'Z']
 

server/src-lib/Hasura/Server/App.hs

@@ -55,7 +55,7 @@ import qualified Hasura.Tracing                            as Tracing
 
 import           Hasura.Backends.Postgres.Execute.Types
 import           Hasura.EncJSON
-import           Hasura.GraphQL.Logging                    (MonadQueryLog (..))
+import           Hasura.GraphQL.Logging                    (MonadQueryLog)
 import           Hasura.HTTP
 import           Hasura.Metadata.Class
 import           Hasura.RQL.DDL.Schema

server/src-lib/Hasura/Server/Rest.hs

@@ -24,7 +24,7 @@ import qualified Hasura.Tracing                         as Tracing
 import qualified Language.GraphQL.Draft.Syntax          as G
 
 import           Hasura.EncJSON
-import           Hasura.GraphQL.Logging                 (MonadQueryLog (..))
+import           Hasura.GraphQL.Logging                 (MonadQueryLog)
 import           Hasura.GraphQL.Transport.HTTP.Protocol
 import           Hasura.HTTP
 import           Hasura.Metadata.Class