Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Enforce and user guards as read-only #274

Open
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

Enforce and user guards as read-only #274

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
27 changes: 24 additions & 3 deletions pact-tests/pact-tests/caps.repl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand All @@ -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))
Expand Down Expand Up @@ -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")
Expand Down Expand Up @@ -993,7 +1014,7 @@
)

(defun emit-a(a:integer) (emit-event (A_EVENT a a))))


(use B)
(call-a)
Expand Down
4 changes: 2 additions & 2 deletions pact/Pact/Core/IR/Eval/CEK/Evaluator.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -225,7 +225,7 @@ 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
let env' = readOnlyEnv env
-- chargeGasArgs info (GAConstant constantWorkNodeGas)
evalCEK (CondC env' info (EnforceC str) cont) handler env' cond
-- | ------ From --------------- | ------ To ------------------------ |
Expand Down Expand Up @@ -1558,7 +1558,7 @@ 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
let env' = readOnlyEnv env
clo <- mkDefunClosure d (qualNameToFqn qn mh) env'
-- Todo: sys only here
applyLam (C clo) (VPactValue <$> args) (IgnoreValueC (PBool True) cont) handler
Expand Down
4 changes: 2 additions & 2 deletions pact/Pact/Core/IR/Eval/Direct/Evaluator.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -271,7 +271,7 @@ evaluate env = \case
if b then evaluate env ifExpr
else evaluate env elseExpr
CEnforce cond str -> do
let env' = sysOnlyEnv env
let env' = readOnlyEnv env
b <- enforceBool info =<< evaluate env' cond
-- chargeGasArgs info (GAConstant constantWorkNodeGas)
if b then return (VBool True)
Expand Down Expand Up @@ -882,7 +882,7 @@ 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
let env' = readOnlyEnv env
clo <- mkDefunClosure d (qualNameToFqn qn mh) env'
-- Todo: sys only here
True <$ (applyLam (C clo) (VPactValue <$> args) >>= enforcePactValue info)
Expand Down
Loading