[skip ci] implement header checking

Probably closes hasura#14 and hasura#3659.

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

@@ -23,24 +23,16 @@ module Hasura.GraphQL.Execute
 
 import           Hasura.Prelude
 
-import           Data.Text.Conversions
-
 import qualified Data.Aeson                             as J
-import qualified Data.CaseInsensitive                   as CI
 import qualified Data.Environment                       as Env
 import qualified Data.HashMap.Strict                    as Map
 
 import qualified Data.HashSet                           as HS
 import qualified Data.List.NonEmpty                     as NE
-import qualified Data.Text                              as T
 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.Wai.Extended                   as Wai
-import qualified Network.Wreq                           as Wreq
-
-import           Control.Exception                      (try)
-import           Control.Lens
 
 import qualified Hasura.GraphQL.Context                 as C
 import qualified Hasura.GraphQL.Execute.Inline          as EI
@@ -58,10 +50,8 @@ import           Hasura.GraphQL.Logging
 import           Hasura.GraphQL.RemoteServer            (execRemoteGQ')
 import           Hasura.GraphQL.Transport.HTTP.Protocol
 import           Hasura.HTTP
-import           Hasura.RQL.DDL.Headers
 import           Hasura.RQL.Types
-import           Hasura.Server.Utils                    (RequestId, mkClientHeadersForward,
-                                                         mkSetCookieHeaders)
+import           Hasura.Server.Utils                    (RequestId)
 import           Hasura.Server.Version                  (HasVersion)
 import           Hasura.Session
 
@@ -230,7 +220,6 @@ getResolvedExecPlan env pgExecCtx planCache userInfo sqlGenCtx
 
   planM <- liftIO $ EP.getPlan scVer (_uiRole userInfo) opNameM queryStr
            queryType planCache
-  let usrVars = _uiSession userInfo
   case planM of
     -- plans are only for queries and subscriptions
     Just plan -> (Telem.Hit,) <$> case plan of

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

@@ -7,13 +7,13 @@ module Hasura.GraphQL.Execute.Action
 
 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.ByteString.Lazy                 as BL
 import qualified Data.CaseInsensitive                 as CI
 import qualified Data.HashMap.Strict                  as Map
+import qualified Data.HashSet                         as Set
 import qualified Data.Text                            as T
 import qualified Data.UUID                            as UUID
 import qualified Database.PG.Query                    as Q
@@ -37,19 +37,19 @@ import qualified Data.Environment                     as Env
 
 import           Hasura.EncJSON
 import           Hasura.GraphQL.Execute.Prepare
-import           Hasura.GraphQL.Parser          hiding (column)
-import           Hasura.GraphQL.Utils           (showNames)
+import           Hasura.GraphQL.Parser                hiding (column)
+import           Hasura.GraphQL.Utils                 (showNames)
 import           Hasura.HTTP
 import           Hasura.RQL.DDL.Headers
 import           Hasura.RQL.DDL.Schema.Cache
-import           Hasura.RQL.DML.Select          (asSingleRowJsonResp)
+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.Server.Utils                  (mkClientHeadersForward, mkSetCookieHeaders)
+import           Hasura.Server.Version                (HasVersion)
 import           Hasura.Session
 import           Hasura.SQL.Types
-import           Hasura.SQL.Value               (PGScalarValue (..), toTxtValue)
+import           Hasura.SQL.Value                     (PGScalarValue (..), toTxtValue)
 
 newtype ActionContext
   = ActionContext {_acName :: ActionName}
@@ -150,7 +150,8 @@ resolveActionExecution env userInfo annAction execContext = do
         toTxtValue $ WithScalarType PGJSONB $ PGValJSONB $ Q.JSONB $ J.toJSON webhookRes
       selectAstUnresolved = processOutputSelectionSet webhookResponseExpression
                             outputType definitionList annFields stringifyNum
-  astResolved <- RS.traverseAnnSimpleSelect (pure . unpreparedToTextSQL) selectAstUnresolved
+  (astResolved, _expectedVariables) <- flip runStateT Set.empty $ RS.traverseAnnSimpleSelect prepareWithoutPlan selectAstUnresolved
+  -- TODO: verify variables here?
   let (astResolvedWithoutRemoteJoins,maybeRemoteJoins) = RJ.getRemoteJoins astResolved
       jsonAggType = mkJsonAggSelect outputType
   return $ (,respHeaders) $

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

@@ -1,5 +1,5 @@
 module Hasura.GraphQL.Execute.Insert
-  ( fmapAnnInsert
+  ( traverseAnnInsert
   , convertToSQLTransaction
   ) where
 
@@ -43,34 +43,40 @@ import           Hasura.SQL.Value
 -- - is some of this code dead or unused? are there paths never taken?
 --   can it be simplified?
 
-fmapAnnInsert :: (a -> b) -> AnnMultiInsert a -> AnnMultiInsert b
-fmapAnnInsert f (annIns, mutationOutput) =
-  ( fmapMulti annIns
-  , runIdentity $ RQL.traverseMutationOutput (pure . f) mutationOutput
-  )
+traverseAnnInsert
+  :: (Applicative f)
+  => (a -> f b)
+  -> AnnMultiInsert a
+  -> f (AnnMultiInsert b)
+traverseAnnInsert f (annIns, mutationOutput) = (,)
+  <$> traverseMulti annIns
+  <*> RQL.traverseMutationOutput f mutationOutput
   where
-    fmapMulti (AnnIns objs table conflictClause (insertCheck, updateCheck) columns defaultValues) =
-      AnnIns
-        (fmap fmapObject objs)
-        table
-        (fmap (fmap f) conflictClause)
-        (fmapAnnBoolExp f insertCheck, fmap (fmapAnnBoolExp f) updateCheck)
-        columns
-        (fmap f defaultValues)
-    fmapSingle (AnnIns obj table conflictClause (insertCheck, updateCheck) columns defaultValues) =
-      AnnIns
-        (fmapObject obj)
-        table
-        (fmap (fmap f) conflictClause)
-        (fmapAnnBoolExp f insertCheck, fmap (fmapAnnBoolExp f) updateCheck)
-        columns
-        (fmap f defaultValues)
-    fmapObject (AnnInsObj columns objRels arrRels) =
-      AnnInsObj
-        (fmap (fmap f) columns)
-        (fmap (fmapRel fmapSingle) objRels)
-        (fmap (fmapRel fmapMulti)  arrRels)
-    fmapRel t (RelIns object relInfo) = RelIns (t object) relInfo
+    traverseMulti (AnnIns objs tableName conflictClause checkCond columns defaultValues) = AnnIns
+      <$> traverse traverseObject objs
+      <*> pure tableName
+      <*> traverse (traverse f) conflictClause
+      <*> ( (,)
+            <$> traverseAnnBoolExp f (fst checkCond)
+            <*> traverse (traverseAnnBoolExp f) (snd checkCond)
+          )
+      <*> pure columns
+      <*> traverse f defaultValues
+    traverseSingle (AnnIns obj tableName conflictClause checkCond columns defaultValues) = AnnIns
+      <$> traverseObject obj
+      <*> pure tableName
+      <*> traverse (traverse f) conflictClause
+      <*> ( (,)
+            <$> traverseAnnBoolExp f (fst checkCond)
+            <*> traverse (traverseAnnBoolExp f) (snd checkCond)
+          )
+      <*> pure columns
+      <*> traverse f defaultValues
+    traverseObject (AnnInsObj columns objRels arrRels) = AnnInsObj
+      <$> traverse (traverse f) columns
+      <*> traverse (traverseRel traverseSingle) objRels
+      <*> traverse (traverseRel traverseMulti)  arrRels
+    traverseRel z (RelIns object relInfo) = RelIns <$> z object <*> pure relInfo
 
 
 convertToSQLTransaction

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

@@ -30,7 +30,6 @@ import qualified Data.Aeson.Casing                      as J
 import qualified Data.Aeson.Extended                    as J
 import qualified Data.Aeson.TH                          as J
 import qualified Data.ByteString                        as B
-import qualified Data.Environment                       as E
 import qualified Data.HashMap.Strict                    as Map
 import qualified Data.HashMap.Strict.InsOrd             as OMap
 import qualified Data.Sequence                          as Seq
@@ -57,11 +56,7 @@ import           Hasura.GraphQL.Execute.Action
 import           Hasura.GraphQL.Execute.Query
 import           Hasura.GraphQL.Parser.Column
 import           Hasura.RQL.Types
-import           Hasura.Server.Version                  (HasVersion)
 import           Hasura.Session
-
-import           Hasura.GraphQL.Utils
-
 import           Hasura.SQL.Error
 import           Hasura.SQL.Types
 import           Hasura.SQL.Value

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

@@ -6,6 +6,7 @@ import qualified Data.Aeson                             as J
 import qualified Data.Environment                       as Env
 import qualified Data.HashMap.Strict                    as Map
 import qualified Data.HashMap.Strict.InsOrd             as OMap
+import qualified Data.HashSet                           as Set
 import qualified Data.IntMap                            as IntMap
 import qualified Data.Sequence                          as Seq
 import qualified Data.Sequence.NonEmpty                 as NE
@@ -24,7 +25,7 @@ import           Hasura.Db
 import           Hasura.EncJSON
 import           Hasura.GraphQL.Context
 import           Hasura.GraphQL.Execute.Action
-import           Hasura.GraphQL.Execute.Insert          (convertToSQLTransaction, fmapAnnInsert)
+import           Hasura.GraphQL.Execute.Insert
 import           Hasura.GraphQL.Execute.Prepare
 import           Hasura.GraphQL.Execute.Resolve
 import           Hasura.GraphQL.Parser
@@ -34,42 +35,46 @@ import           Hasura.Server.Version                  (HasVersion)
 import           Hasura.Session
 
 convertDelete
-  :: (HasVersion, MonadIO m)
+  :: (HasVersion, MonadError QErr m)
   => Env.Environment
   -> SessionVariables
   -> RQL.MutationRemoteJoinCtx
   -> RQL.AnnDelG UnpreparedValue
   -> Bool
   -> m RespTx
 convertDelete env usrVars rjCtx deleteOperation stringifyNum = do
-  pure $ RQL.execDeleteQuery env stringifyNum (Just rjCtx) (preparedDelete, planVariablesSequence usrVars planningState)
-  where (preparedDelete, planningState) = runIdentity $ runPlan $ RQL.traverseAnnDel prepareWithPlan deleteOperation
+  let (preparedDelete, expectedVariables) = flip runState Set.empty $ RQL.traverseAnnDel prepareWithoutPlan deleteOperation
+  validateSessionVariables expectedVariables usrVars
+  pure $ RQL.execDeleteQuery env stringifyNum (Just rjCtx) (preparedDelete, Seq.empty)
 
 convertUpdate
-  :: (HasVersion, MonadIO m)
+  :: (HasVersion, MonadError QErr m)
   => Env.Environment
   -> SessionVariables
   -> RQL.MutationRemoteJoinCtx
   -> RQL.AnnUpdG UnpreparedValue
   -> Bool
   -> m RespTx
 convertUpdate env usrVars rjCtx updateOperation stringifyNum = do
-  pure $ if null $ RQL.uqp1OpExps updateOperation
-    then pure $ RQL.buildEmptyMutResp $ RQL.uqp1Output preparedUpdate
-    else RQL.execUpdateQuery env stringifyNum (Just rjCtx) (preparedUpdate, Seq.empty)
-  where preparedUpdate = runIdentity $ RQL.traverseAnnUpd (pure . unpreparedToTextSQL) updateOperation
+  let (preparedUpdate, expectedVariables) = flip runState Set.empty $ RQL.traverseAnnUpd prepareWithoutPlan updateOperation
+  if null $ RQL.uqp1OpExps updateOperation
+  then pure $ pure $ RQL.buildEmptyMutResp $ RQL.uqp1Output preparedUpdate
+  else do
+    validateSessionVariables expectedVariables usrVars
+    pure $ RQL.execUpdateQuery env stringifyNum (Just rjCtx) (preparedUpdate, Seq.empty)
 
 convertInsert
-  :: (HasVersion, MonadIO m)
+  :: (HasVersion, MonadError QErr m)
   => Env.Environment
   -> SessionVariables
   -> RQL.MutationRemoteJoinCtx
   -> AnnMultiInsert UnpreparedValue
   -> Bool
   -> m RespTx
 convertInsert env usrVars rjCtx insertOperation stringifyNum = do
+  let (preparedInsert, expectedVariables) = flip runState Set.empty $ traverseAnnInsert prepareWithoutPlan insertOperation
+  validateSessionVariables expectedVariables usrVars
   pure $ convertToSQLTransaction env preparedInsert rjCtx Seq.empty stringifyNum
-  where preparedInsert = fmapAnnInsert unpreparedToTextSQL insertOperation
 
 planVariablesSequence :: SessionVariables -> PlanningSt -> Seq.Seq Q.PrepArg
 planVariablesSequence usrVars = Seq.fromList . map fst . withUserVars usrVars . IntMap.elems . _psPrepped