hasura · shahidhk · Sep 29, 2018 · Sep 28, 2018 · Sep 28, 2018
@@ -118,14 +118,15 @@ buildInsPermInfo tabInfo (PermDef rn (InsPerm chk upsrt) _) = do
     vn = buildViewName tn rn PTInsert
 
 buildInsInfra :: QualifiedTable -> InsPermInfo -> Q.TxE QErr ()
-buildInsInfra tn (InsPermInfo vn be _ _ _) =
+buildInsInfra tn (InsPermInfo vn be _ _ _) = do
+  trigFnQ <- buildInsTrigFn vn tn be
   Q.catchE defaultTxErrorHandler $ do
     -- Create the view
     Q.unitQ (buildView tn vn) () False
     -- Inject defaults on the view
     Q.discardQ (injectDefaults vn tn) () False
     -- Construct a trigger function
-    Q.unitQ (buildInsTrigFn vn tn be) () False
+    Q.unitQ trigFnQ () False
     -- Add trigger for check expression
     Q.unitQ (buildInsTrig vn) () False
 

@@ -1,14 +1,22 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleContexts      #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings     #-}
+{-# LANGUAGE TemplateHaskell       #-}
 
 module Hasura.RQL.DDL.Permission.Triggers where
 
 import           Hasura.Prelude
+import           Hasura.RQL.Types
+import           Hasura.Server.Utils
 import           Hasura.SQL.Types
 
 import qualified Database.PG.Query       as Q
 import qualified Hasura.SQL.DML          as S
 
+import qualified Data.Aeson              as J
 import qualified Data.ByteString.Builder as BB
+import qualified Data.FileEmbed          as FE
+import qualified Data.Text               as T
 
 buildInsTrig :: QualifiedTable -> Q.Query
 buildInsTrig qt@(QualifiedTable _ tn) =
@@ -23,42 +31,24 @@ dropInsTrigFn :: QualifiedTable -> Q.Query
 dropInsTrigFn fn =
   Q.fromBuilder $ BB.string7 "DROP FUNCTION " <> toSQL fn <> "()"
 
-buildInsTrigFn :: QualifiedTable -> QualifiedTable -> S.BoolExp -> Q.Query
-buildInsTrigFn fn tn be =
-  Q.fromBuilder $ mconcat
-  [ BB.string7 "CREATE OR REPLACE FUNCTION " <> toSQL fn
-  , BB.string7 "() RETURNS trigger LANGUAGE plpgsql AS $$ "
-  , BB.string7 "DECLARE r " <> toSQL tn <> "%ROWTYPE; "
-  , BB.string7 "DECLARE conflict_clause jsonb; DECLARE action text; "
-  , BB.string7 "DECLARE constraint_name text; "
-  , BB.string7 "DECLARE set_expression text; "
-  , BB.string7 "BEGIN "
-  , BB.string7 "conflict_clause = current_setting('hasura.conflict_clause')::jsonb; "
-  , BB.string7 "IF (" <> toSQL be <> BB.string7 ") THEN "
-  , BB.string7 "CASE "
-  , BB.string7 "WHEN conflict_clause = 'null'::jsonb THEN INSERT INTO " <> toSQL tn
-  , BB.string7 " VALUES (NEW.*) RETURNING * INTO r; RETURN r; "
-  , BB.string7 "ELSE "
-  , BB.string7 "action = conflict_clause ->> 'action'; "
-  , BB.string7 "constraint_name = conflict_clause ->> 'constraint'; "
-  , BB.string7 "set_expression = conflict_clause ->> 'set_expression'; "
-  , BB.string7 "IF action is NOT NULL THEN "
-  , BB.string7 "CASE "
-  , BB.string7 "WHEN action = 'ignore'::text AND constraint_name IS NULL THEN "
-  , BB.string7 "INSERT INTO " <> toSQL tn
-  , BB.string7 " VALUES (NEW.*) ON CONFLICT DO NOTHING RETURNING * INTO r; RETURN r; "
-  , BB.string7 "WHEN action = 'ignore'::text AND constraint_name is NOT NULL THEN "
-  , BB.string7 "EXECUTE 'INSERT INTO " <> toSQL tn
-  , BB.string7 " VALUES ($1.*) ON CONFLICT ON CONSTRAINT ' || quote_ident(constraint_name) || ' DO NOTHING RETURNING *'"
-  , BB.string7 " INTO r USING NEW; RETURN r; "
-  , BB.string7 "ELSE EXECUTE 'INSERT INTO " <> toSQL tn
-  , BB.string7 " VALUES ($1.*) ON CONFLICT ON CONSTRAINT ' || quote_ident(constraint_name) || ' DO UPDATE ' || set_expression || "
-  , BB.string7 "' RETURNING *' INTO r USING NEW; RETURN r; "
-  , BB.string7 "END CASE; "
-  , BB.string7 "ELSE RAISE internal_error using message = 'action is not found'; RETURN NULL; "
-  , BB.string7 "END IF; "
-  , BB.string7 "END CASE; "
-  , BB.string7 "ELSE RAISE check_violation using message = 'insert check constraint failed'; RETURN NULL; "
-  , BB.string7 "END IF; "
-  , BB.string7 "END $$;"
-  ]
+getInsTrigTmplt :: (MonadError QErr m) => m GingerTmplt
+getInsTrigTmplt =
+  either throwErr return $ parseGingerTmplt trigFnSrc
+  where
+    trigFnSrc = $(FE.embedStringFile "src-rsr/insert_trigger.sql.j2")
+
+    throwErr e = throw500 $ "cannot render insert trigger function template: "
+                 <> T.pack e
+
+buildInsTrigFn
+  :: (MonadError QErr m)
+  => QualifiedTable -> QualifiedTable -> S.BoolExp -> m Q.Query
+buildInsTrigFn fn tn be = do
+  insTmplt <- getInsTrigTmplt
+  return $ Q.fromBuilder $ BB.string7 $ T.unpack $
+    renderGingerTmplt tmpltVals insTmplt
+  where
+    tmpltVals = J.object [ "function_name" J..= toSQLTxt fn
+                         , "table_name" J..= toSQLTxt tn
+                         , "check_expression" J..= toSQLTxt be
+                         ]
@@ -11,6 +11,7 @@ import           Data.Aeson
 import           Data.Int            (Int64)
 import           Hasura.Prelude
 import           Hasura.RQL.Types
+import           Hasura.Server.Utils
 import           Hasura.SQL.Types
 import           System.Environment  (lookupEnv)
 
@@ -19,28 +20,17 @@ import qualified Data.HashMap.Strict as HashMap
 import qualified Data.Text           as T
 import qualified Data.Text.Encoding  as TE
 import qualified Database.PG.Query   as Q
-import qualified Text.Ginger         as TG
 
 data Ops = INSERT | UPDATE | DELETE deriving (Show)
 
 data OpVar = OLD | NEW deriving (Show)
 
-type GingerTmplt = TG.Template TG.SourcePos
-
 defaultNumRetries :: Int
 defaultNumRetries = 0
 
 defaultRetryInterval :: Int
 defaultRetryInterval = 10
 
-parseGingerTmplt :: TG.Source -> Either String GingerTmplt
-parseGingerTmplt src = either parseE Right res
-  where
-    res = runIdentity $ TG.parseGinger' parserOptions src
-    parserOptions = TG.mkParserOptions resolver
-    resolver = const $ return Nothing
-    parseE e = Left $ TG.formatParserError (Just "") e
-
 triggerTmplt :: Maybe GingerTmplt
 triggerTmplt = case parseGingerTmplt $(FE.embedStringFile "src-rsr/trigger.sql.j2") of
   Left _      -> Nothing
@@ -89,7 +79,7 @@ getTriggerSql op trid trn sn tn spec =
                                      mkQualified v col = v <> "." <> col
 
     renderSql :: HashMap.HashMap T.Text T.Text -> GingerTmplt -> T.Text
-    renderSql = TG.easyRender
+    renderSql = renderGingerTmplt
 
 mkTriggerQ
   :: TriggerId

@@ -251,7 +251,7 @@ setConflictCtx conflictCtxM = do
         encToText $ InsertTxConflictCtx CAIgnore constrM Nothing
     conflictCtxToJSON (CCUpdate constr updCols) =
         encToText $ InsertTxConflictCtx CAUpdate (Just constr) $
-        Just $ sqlBuilderToTxt $ toSQL $ S.buildSEWithExcluded updCols
+        Just $ toSQLTxt $ S.buildSEWithExcluded updCols
 
 instance HDBQuery InsertQuery where
 

@@ -22,9 +22,6 @@ import qualified Data.Text.Encoding         as TE
 import qualified Data.Text.Extended         as T
 import qualified Database.PostgreSQL.LibPQ  as PQ
 
-sqlBuilderToTxt :: BB.Builder -> T.Text
-sqlBuilderToTxt = bsToTxt . BL.toStrict . BB.toLazyByteString
-
 class ToSQL a where
   toSQL :: a -> BB.Builder
 
@@ -34,6 +31,9 @@ instance ToSQL BB.Builder where
 -- instance ToSQL T.Text where
 --   toSQL x = TE.encodeUtf8Builder x
 
+toSQLTxt :: (ToSQL a) => a -> T.Text
+toSQLTxt = bsToTxt . BL.toStrict . BB.toLazyByteString . toSQL
+
 infixr 6 <+>
 (<+>) :: (ToSQL a) => T.Text -> [a] -> BB.Builder
 (<+>) _ [] = mempty

@@ -1,9 +1,11 @@
+
 {-# LANGUAGE OverloadedStrings #-}
 
 module Hasura.Server.Utils where
 
 import qualified Database.PG.Query.Connection as Q
 
+import           Data.Aeson
 import           Data.List.Split
 import           Network.URI
 import           System.Exit
@@ -15,6 +17,7 @@ import qualified Data.Text.Encoding           as TE
 import qualified Data.Text.Encoding.Error     as TE
 import qualified Data.Text.IO                 as TI
 import qualified Language.Haskell.TH.Syntax   as TH
+import qualified Text.Ginger                  as TG
 
 import           Hasura.Prelude
 
@@ -95,3 +98,17 @@ runScript fp = do
     "Running shell script " ++ fp ++ " failed with exit code : "
     ++ show exitCode ++ " and with error : " ++ stdErr
   TH.lift stdOut
+
+-- Ginger Templating
+type GingerTmplt = TG.Template TG.SourcePos
+
+parseGingerTmplt :: TG.Source -> Either String GingerTmplt
+parseGingerTmplt src = either parseE Right res
+  where
+    res = runIdentity $ TG.parseGinger' parserOptions src
+    parserOptions = TG.mkParserOptions resolver
+    resolver = const $ return Nothing
+    parseE e = Left $ TG.formatParserError (Just "") e
+
+renderGingerTmplt :: (ToJSON a) => a -> GingerTmplt -> T.Text
+renderGingerTmplt v = TG.easyRender (toJSON v)
@@ -0,0 +1,34 @@
+CREATE OR REPLACE FUNCTION {{function_name}}() RETURNS trigger LANGUAGE plpgsql AS $$
+  DECLARE r {{table_name}}%ROWTYPE;
+  DECLARE conflict_clause jsonb;
+  DECLARE action text;
+  DECLARE constraint_name text;
+  DECLARE set_expression text;
+  BEGIN
+    conflict_clause = current_setting('hasura.conflict_clause')::jsonb;
+    IF ({{check_expression}}) THEN
+      CASE
+        WHEN conflict_clause = 'null'::jsonb THEN INSERT INTO {{table_name}} VALUES (NEW.*) RETURNING * INTO r;
+        ELSE
+          action = conflict_clause ->> 'action';
+          constraint_name = quote_ident(conflict_clause ->> 'constraint');
+          set_expression = conflict_clause ->> 'set_expression';
+          IF action is NOT NULL THEN
+            CASE
+              WHEN action = 'ignore'::text AND constraint_name IS NULL THEN
+                INSERT INTO {{table_name}} VALUES (NEW.*) ON CONFLICT DO NOTHING RETURNING * INTO r;
+              WHEN action = 'ignore'::text AND constraint_name is NOT NULL THEN
+                EXECUTE 'INSERT INTO {{table_name}} VALUES ($1.*) ON CONFLICT ON CONSTRAINT ' || constraint_name ||
+                           ' DO NOTHING RETURNING *' INTO r USING NEW;
+              ELSE
+                EXECUTE 'INSERT INTO {{table_name}} VALUES ($1.*) ON CONFLICT ON CONSTRAINT ' || constraint_name ||
+                           ' DO UPDATE ' || set_expression || ' RETURNING *' INTO r USING NEW;
+            END CASE;
+            ELSE
+              RAISE internal_error using message = 'action is not found'; RETURN NULL;
+          END IF;
+      END CASE;
+      IF r IS NULL THEN RETURN null; ELSE RETURN r; END IF;
+     ELSE RAISE check_violation using message = 'insert check constraint failed'; RETURN NULL;
+     END IF;
+  END $$;
@@ -1,31 +1,31 @@
-description: Upserts author with id 1 as a user (Error)
+description: Upserts author with id 1 as a user
 url: /v1alpha1/graphql
 status: 200
 response:
   data:
     insert_author:
       affected_rows: 1
       returning:
-      - id: 5
+      - id: 1
+        name: Author 1
         is_registered: false
-        name: Author 5
 headers:
   X-Hasura-Role: user
-  X-Hasura-User-Id: '5'
+  X-Hasura-User-Id: '1'
 query:
   query: |
     mutation insert_author {
       insert_author (
         objects: [
           {
-            id: 5
-            name: "Author 5"
+            id: 1
+            name: "Author 1"
             is_registered: false
           }
           ],
         on_conflict: {
           constraint: author_pkey,
-          action: ignore
+          action: update
         }
       ) {
         affected_rows

@@ -2,7 +2,7 @@ description: Upsert Company name as user role
 url: /v1alpha1/graphql
 status: 200
 header:
-  X-Hasura-Company-Id: 1
+  X-Hasura-Company-Id: '1'
   X-Hasura-Role: user
 response:
   data: