Enforce and user guards as read-only

pact-repl/Pact/Core/IR/Eval/Direct/Evaluator.hs

@@ -275,7 +275,8 @@ evaluate env = \case
       if b then evaluate env ifExpr
       else evaluate env elseExpr
     CEnforce cond str -> do
-      let env' = sysOnlyEnv env
+      pact52Disabled <- isExecutionFlagSet FlagDisablePact52
+      let env' = if not pact52Disabled then readOnlyEnv env else sysOnlyEnv env
       b <- enforceBool info =<< evaluate env' cond
       -- chargeGasArgs info (GAConstant constantWorkNodeGas)
       if b then return (VBool True)
@@ -888,7 +889,8 @@ runUserGuard info env (UserGuard qn args) =
   getModuleMemberWithHash info qn >>= \case
     (Dfun d, mh) -> do
       when (length (_dfunArgs d) /= length args) $ throwExecutionError info CannotApplyPartialClosure
-      let env' = sysOnlyEnv env
+      pact52Disabled <- isExecutionFlagSet FlagDisablePact52
+      let env' = if not pact52Disabled then readOnlyEnv env else sysOnlyEnv env
       clo <- mkDefunClosure d (qualNameToFqn qn mh) env'
       -- Todo: sys only here
       True <$ (applyLam info (C clo) (VPactValue <$> args) >>= enforcePactValue info)

pact-tests/pact-tests/caps.repl

@@ -46,6 +46,18 @@
   (defun enforce-msg-keyset (key:string)
     (enforce-keyset (read-keyset key)))
 
+  (defun create-read-only-db-user-guard ()
+    @doc "Creates a user guard which tries to read from the DB, which is not allowed. This will fail when the guard is enforced."
+    ; this insert succeeds:
+    (insert ints 'y {'i: 0})
+    (create-user-guard (read-only-user-guard-fun 'y)))
+
+  (defun read-only-user-guard-fun (x:string)
+    (let ((row (read ints x)))
+      (enforce (= 0 (at 'i row)) "int wasn't zero")
+      ))
+
+
   (defun create-bad-db-user-guard ()
     @doc "Creates a user guard which tries to read from the DB, which is not allowed. This will fail when the guard is enforced."
     ; this insert succeeds:
@@ -54,7 +66,9 @@
 
   (defun bad-user-guard-fun (x:string)
     (let ((row (read ints x)))
-      (enforce (= 0 (at 'i row)) "int wasn't zero")))
+      (enforce (= 0 (at 'i row)) "int wasn't zero")
+      (write ints x {"i":(+ (at "i" row) 1)})
+      ))
 
   (defpact test-pact-guards (id:string)
     (step (step1 id))
@@ -196,7 +210,14 @@
                 (enforce-guard (keyset-ref-guard "k2")))
 
 (let ((bad-db-user-guard (create-bad-db-user-guard)))
-  (expect-failure "reading db from within user guard" (enforce-guard bad-db-user-guard)))
+  (expect-failure "writing to db from within user guard" (enforce-guard bad-db-user-guard)))
+
+(let ((read-only-user-guard (create-read-only-db-user-guard)))
+  (expect "User guard works successfully in read-only mode" true (enforce-guard read-only-user-guard)))
+
+; The previous test wrote to 'y, so we can just reuse that
+(let ((read-only-user-guard (create-user-guard (read-only-user-guard-fun "y"))))
+  (expect "Read-only works successfully in enforce" true (enforce (enforce-guard read-only-user-guard) "enforce works")))
 
 (env-hash (hash "pact-guards-a-id")) ;; equivalent of pact-id
 (test-pact-guards "a")
@@ -1064,4 +1085,34 @@
 (namespace "ns")
 
 
+(commit-tx)
+
+(begin-tx)
+(module read-only-user-guards g
+  (defcap g () true)
+
+  (defschema test-schema a:integer)
+  (deftable tbl:{test-schema})
+
+  (defun read-only-user-guard ()
+    (read tbl "foo")
+  )
+
+  (defun test-user-guard (x:integer)
+    (enforce-guard (create-user-guard (read-only-user-guard)))
+    true)
+  )
+
+(create-table tbl)
+(insert tbl "foo" { 'a: 1 })
+
+(env-exec-config ["DisablePact52"])
+(expect-failure "Pact 5.2 disabled read only user guard fails"
+  (test-user-guard 1))
+
+(env-exec-config [])
+(expect "Pact 5.2 enabled read only user guard succeeds"
+  true
+  (test-user-guard 1))
+
 (commit-tx)

pact/Pact/Core/IR/Eval/CEK/Evaluator.hs

@@ -227,7 +227,8 @@ evaluateTerm cont handler env (BuiltinForm c info) = case c of
     -- chargeGasArgs info (GAConstant constantWorkNodeGas)
     evalCEK (CondC env info (IfC e1 e2) cont) handler env cond
   CEnforce cond str -> do
-    let env' = sysOnlyEnv env
+    pact52Disabled <- isExecutionFlagSet FlagDisablePact52
+    let env' = if not pact52Disabled then readOnlyEnv env else sysOnlyEnv env
     -- chargeGasArgs info (GAConstant constantWorkNodeGas)
     evalCEK (CondC env' info (EnforceC str) cont) handler env' cond
   -- | ------ From --------------- | ------ To ------------------------ |
@@ -1582,7 +1583,8 @@ runUserGuard info cont handler env (UserGuard qn args) =
   getModuleMemberWithHash info qn >>= \case
     (Dfun d, mh) -> do
       when (length (_dfunArgs d) /= length args) $ throwExecutionError info CannotApplyPartialClosure
-      let env' = sysOnlyEnv env
+      pact52Disabled <- isExecutionFlagSet FlagDisablePact52
+      let env' = if not pact52Disabled then readOnlyEnv env else sysOnlyEnv env
       clo <- mkDefunClosure d (qualNameToFqn qn mh) env'
       -- Todo: sys only here
       applyLam (C clo) (VPactValue <$> args) (IgnoreValueC (PBool True) cont) handler