hasura · lexi-lambda · Apr 1, 2020 · Mar 31, 2020 · Apr 1, 2020
@@ -131,8 +131,10 @@ constraints: any.Cabal ==2.4.0.1,
              any.free ==5.1.1,
              any.generic-arbitrary ==0.1.0,
              any.ghc-boot-th ==8.6.5,
+             any.ghc-heap ==8.6.5,
+             any.ghc-heap-view ==0.6.0,
+             ghc-heap-view -prim-supports-any,
              any.ghc-prim ==0.5.3,
-             any.ghc-heap-view ==0.6.0, 
              any.happy ==1.19.12,
              happy +small_base,
              any.hashable ==1.2.7.0,
@@ -162,6 +164,7 @@ constraints: any.Cabal ==2.4.0.1,
              any.http2 ==1.6.5,
              http2 -devel,
              any.hvect ==0.4.0.0,
+             any.immortal ==0.2.2.1,
              any.insert-ordered-containers ==0.2.1.0,
              any.integer-gmp ==1.0.2.0,
              any.integer-logarithms ==1.0.3,
@@ -239,10 +242,9 @@ constraints: any.Cabal ==2.4.0.1,
              any.random ==1.1,
              any.reflection ==2.1.4,
              reflection -slow +template-haskell,
-             any.regex-base ==0.93.2,
-             regex-base +newbase +splitbase,
-             any.regex-tdfa ==1.2.3.1,
-             regex-tdfa -devel,
+             any.regex-base ==0.94.0.0,
+             any.regex-tdfa ==1.3.1.0,
+             regex-tdfa -force-o2,
              any.reroute ==0.5.0.0,
              any.resource-pool ==0.2.3.2,
              resource-pool -developer,

@@ -165,7 +165,7 @@ library
                      , auto-update
 
                      -- regex related
-                     , regex-tdfa >= 1.2
+                     , regex-tdfa >=1.3.1 && <1.4
 
                      -- pretty printer
                      , ansi-wl-pprint
@@ -192,10 +192,10 @@ library
                      -- testing
                      , QuickCheck
                      , generic-arbitrary
-                     -- 0.6.1 is supposedly not okay for ghc 8.6: 
-                     --   https://github.com/nomeata/ghc-heap-view/issues/27 
+                     -- 0.6.1 is supposedly not okay for ghc 8.6:
+                     --   https://github.com/nomeata/ghc-heap-view/issues/27
                      , ghc-heap-view == 0.6.0
-                     
+
                      , directory
 
   exposed-modules:     Control.Arrow.Extended

@@ -40,6 +40,7 @@ import qualified Data.Text                      as T
 import qualified Data.Text.Encoding             as TE
 import qualified Database.PG.Query              as Q
 import qualified Database.PostgreSQL.LibPQ      as PQ
+import qualified Text.Regex.TDFA                as TDFA
 
 import           Data.Aeson
 import           Data.Aeson.Casing
@@ -54,7 +55,7 @@ import           Hasura.RQL.DDL.Schema.Rename
 import           Hasura.RQL.DDL.Schema.Table
 import           Hasura.RQL.Instances           ()
 import           Hasura.RQL.Types
-import           Hasura.Server.Utils            (matchRegex)
+import           Hasura.Server.Utils            (quoteRegex)
 
 data RunSQL
   = RunSQL
@@ -87,22 +88,51 @@ instance ToJSON RunSQL where
 
 runRunSQL :: (MonadTx m, CacheRWM m, HasSQLGenCtx m) => RunSQL -> m EncJSON
 runRunSQL RunSQL {..} = do
-  metadataCheckNeeded <- onNothing rCheckMetadataConsistency $ isAltrDropReplace rSql
-  bool (execRawSQL rSql) (withMetadataCheck rCascade $ execRawSQL rSql) metadataCheckNeeded
+  -- see Note [Checking metadata consistency in run_sql]
+  let metadataCheckNeeded = case rTxAccessMode of
+        Q.ReadOnly  -> False
+        Q.ReadWrite -> fromMaybe (containsDDLKeyword rSql) rCheckMetadataConsistency
+  if metadataCheckNeeded
+    then withMetadataCheck rCascade $ execRawSQL rSql
+    else execRawSQL rSql
   where
     execRawSQL :: (MonadTx m) => Text -> m EncJSON
     execRawSQL =
       fmap (encJFromJValue @RunSQLRes) . liftTx . Q.multiQE rawSqlErrHandler . Q.fromText
       where
         rawSqlErrHandler txe =
-          let e = err400 PostgresError "query execution failed"
-           in e {qeInternal = Just $ toJSON txe}
-
-    isAltrDropReplace :: QErrM m => T.Text -> m Bool
-    isAltrDropReplace = either throwErr return . matchRegex regex False
-      where
-        throwErr s = throw500 $ "compiling regex failed: " <> T.pack s
-        regex = "alter|drop|replace|create function|comment on"
+          (err400 PostgresError "query execution failed") { qeInternal = Just $ toJSON txe }
+
+    -- see Note [Checking metadata consistency in run_sql]
+    containsDDLKeyword :: Text -> Bool
+    containsDDLKeyword = TDFA.match $$(quoteRegex
+      TDFA.defaultCompOpt
+        { TDFA.caseSensitive = False
+        , TDFA.multiline = True
+        , TDFA.lastStarGreedy = True }
+      TDFA.defaultExecOpt
+        { TDFA.captureGroups = False }
+      "\\balter\\b|\\bdrop\\b|\\breplace\\b|\\bcreate function\\b|\\bcomment on\\b")
+
+{- Note [Checking metadata consistency in run_sql]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+SQL queries executed by run_sql may change the Postgres schema in arbitrary
+ways. We attempt to automatically update the metadata to reflect those changes
+as much as possible---for example, if a table is renamed, we want to update the
+metadata to track the table under its new name instead of its old one. This
+schema diffing (plus some integrity checking) is handled by withMetadataCheck.
+
+But this process has overhead---it involves reloading the metadata, diffing it,
+and rebuilding the schema cache---so we don’t want to do it if it isn’t
+necessary. The user can explicitly disable the check via the
+check_metadata_consistency option, and we also skip it if the current
+transaction is in READ ONLY mode, since the schema can’t be modified in that
+case, anyway.
+
+However, even if neither read_only or check_metadata_consistency is passed, lots
+of queries may not modify the schema at all. As a (fairly stupid) heuristic, we
+check if the query contains any keywords for DDL operations, and if not, we skip
+the metadata check as well. -}
 
 data RunSQLRes
   = RunSQLRes

@@ -9,6 +9,8 @@ import qualified Data.HashSet                  as S
 import qualified Data.URL.Template             as UT
 import qualified Language.GraphQL.Draft.Syntax as G
 import qualified Language.Haskell.TH.Syntax    as TH
+import qualified Text.Regex.TDFA               as TDFA
+import qualified Text.Regex.TDFA.Pattern       as TDFA
 
 import           Data.Functor.Product
 import           Data.GADT.Compare
@@ -53,6 +55,15 @@ instance (TH.Lift k, TH.Lift v) => TH.Lift (M.HashMap k v) where
 instance TH.Lift a => TH.Lift (S.HashSet a) where
   lift s = [| S.fromList $(TH.lift $ S.toList s) |]
 
+deriving instance TH.Lift TDFA.CompOption
+deriving instance TH.Lift TDFA.DoPa
+deriving instance TH.Lift TDFA.ExecOption
+deriving instance TH.Lift TDFA.Pattern
+deriving instance TH.Lift TDFA.PatternSet
+deriving instance TH.Lift TDFA.PatternSetCharacterClass
+deriving instance TH.Lift TDFA.PatternSetCollatingElement
+deriving instance TH.Lift TDFA.PatternSetEquivalenceClass
+
 instance (GEq f, GEq g) => GEq (Product f g) where
   Pair a1 a2 `geq` Pair b1 b2
     | Just Refl <- a1 `geq` b1

@@ -1,11 +1,13 @@
 {-# LANGUAGE TypeApplications #-}
 module Hasura.Server.Utils where
 
+import           Hasura.Prelude
+
 import           Control.Lens               ((^..))
 import           Data.Aeson
 import           Data.Char
 import           Data.List                  (find)
-import           Language.Haskell.TH.Syntax (Lift)
+import           Language.Haskell.TH.Syntax (Lift, Q, TExp)
 import           System.Environment
 import           System.Exit
 import           System.Process
@@ -15,7 +17,6 @@ import qualified Data.CaseInsensitive       as CI
 import qualified Data.HashSet               as Set
 import qualified Data.List.NonEmpty         as NE
 import qualified Data.Text                  as T
-import qualified Data.Text.Encoding         as TE
 import qualified Data.Text.IO               as TI
 import qualified Data.UUID                  as UUID
 import qualified Data.UUID.V4               as UUID
@@ -24,9 +25,10 @@ import qualified Network.HTTP.Client        as HC
 import qualified Network.HTTP.Types         as HTTP
 import qualified Network.Wreq               as Wreq
 import qualified Text.Regex.TDFA            as TDFA
-import qualified Text.Regex.TDFA.ByteString as TDFA
+import qualified Text.Regex.TDFA.ReadRegex  as TDFA
+import qualified Text.Regex.TDFA.TDFA       as TDFA
 
-import           Hasura.Prelude
+import           Hasura.RQL.Instances       ()
 
 newtype RequestId
   = RequestId { unRequestId :: Text }
@@ -72,15 +74,15 @@ getRequestId headers =
     Just reqId -> return $ RequestId $ bsToTxt reqId
 
 -- Get an env var during compile time
-getValFromEnvOrScript :: String -> String -> TH.Q (TH.TExp String)
+getValFromEnvOrScript :: String -> String -> Q (TExp String)
 getValFromEnvOrScript n s = do
   maybeVal <- TH.runIO $ lookupEnv n
   case maybeVal of
     Just val -> [|| val ||]
     Nothing  -> runScript s
 
 -- Run a shell script during compile time
-runScript :: FilePath -> TH.Q (TH.TExp String)
+runScript :: FilePath -> Q (TExp String)
 runScript fp = do
   TH.addDependentFile fp
   fileContent <- TH.runIO $ TI.readFile fp
@@ -97,19 +99,11 @@ duplicates = mapMaybe greaterThanOne . group . sort
   where
     greaterThanOne l = bool Nothing (Just $ head l) $ length l > 1
 
--- regex related
-matchRegex :: B.ByteString -> Bool -> T.Text -> Either String Bool
-matchRegex regex caseSensitive src =
-  fmap (`TDFA.match` TE.encodeUtf8 src) compiledRegexE
-  where
-    compOpt = TDFA.defaultCompOpt
-      { TDFA.caseSensitive = caseSensitive
-      , TDFA.multiline = True
-      , TDFA.lastStarGreedy = True
-      }
-    execOption = TDFA.defaultExecOpt {TDFA.captureGroups = False}
-    compiledRegexE = TDFA.compile compOpt execOption regex
-
+-- | Quotes a regex using Template Haskell so syntax errors can be reported at compile-time.
+quoteRegex :: TDFA.CompOption -> TDFA.ExecOption -> String -> Q (TExp TDFA.Regex)
+quoteRegex compOption execOption regexText = do
+  regex <- TDFA.parseRegex regexText `onLeft` (fail . show)
+  [|| TDFA.patternToRegex regex compOption execOption ||]
 
 fmapL :: (a -> a') -> Either a b -> Either a' b
 fmapL fn (Left e) = Left (fn e)

@@ -26,6 +26,15 @@ args:
         bool_col boolean not null default false
       );
       insert into test (name) values ('name_1'), ('name_2');
+      create table malicious(
+          id serial primary key,
+          alterable boolean,
+          droppable boolean
+      );
+      insert into malicious (alterable, droppable) values
+        (true, false),
+        (false, true);
+      create view malicious_view as select * from malicious;
 
 - type: track_table
   args:

@@ -0,0 +1,72 @@
+- url: /v1/query
+  status: 200
+  response:
+    result_type: TuplesOk
+    result:
+    - - id
+      - name
+    - - '1'
+      - Author 1
+    - - '2'
+      - Author 2
+  query:
+    type: run_sql
+    args:
+      read_only: True
+      sql: |
+        SELECT * from author
+
+- url: /v1/query
+  status: 200
+  response:
+    result_type: TuplesOk
+    result:
+    - - alterable
+      - droppable
+    - - t
+      - f
+    - - f
+      - t
+  query:
+    type: run_sql
+    args:
+      read_only: True
+      sql: |
+        SELECT alterable, droppable FROM malicious
+
+- url: /v1/query
+  status: 200
+  response:
+    result_type: TuplesOk
+    result:
+    - - drop
+    - - ' alter '
+  query:
+    type: run_sql
+    args:
+      read_only: True
+      sql: |
+        SELECT ' alter ' as drop
+
+- url: /v1/query
+  status: 400
+  response:
+    internal:
+      statement: "DROP TABLE malicious\n"
+      prepared: false
+      error:
+        exec_status: FatalError
+        hint:
+        message: cannot execute DROP TABLE in a read-only transaction
+        status_code: '25006'
+        description:
+      arguments: []
+    path: $.args
+    error: query execution failed
+    code: postgres-error
+  query:
+    type: run_sql
+    args:
+      read_only: True
+      sql: |
+        DROP TABLE malicious
@@ -6,4 +6,6 @@ args:
       drop table article;
       drop table author;
       drop table test;
+      drop view malicious_view;
+      drop table malicious;
     cascade: true
@@ -543,6 +543,10 @@ def test_select_query(self, hge_ctx):
         check_query_f(hge_ctx, self.dir() + '/sql_select_query.yaml')
         hge_ctx.may_skip_test_teardown = True
 
+    def test_select_query_read_only(self, hge_ctx):
+        check_query_f(hge_ctx, self.dir() + '/sql_select_query_read_only.yaml')
+        hge_ctx.may_skip_test_teardown = True
+
     def test_set_timezone(self, hge_ctx):
         check_query_f(hge_ctx, self.dir() + '/sql_set_timezone.yaml')
         hge_ctx.may_skip_test_teardown = True