Skip to content

Commit

Permalink
fix principals + add test (#1273)
Browse files Browse the repository at this point in the history
  • Loading branch information
jmcardon authored Aug 9, 2023
1 parent b160c26 commit 528b0cd
Show file tree
Hide file tree
Showing 2 changed files with 50 additions and 1 deletion.
4 changes: 3 additions & 1 deletion src/Pact/Native/Guards.hs
Original file line number Diff line number Diff line change
Expand Up @@ -28,6 +28,7 @@ import Pact.Types.Capability
import Pact.Types.KeySet
import Pact.Types.Pretty
import Pact.Types.Principal
import Pact.Types.PactValue
import Pact.Types.Runtime


Expand Down Expand Up @@ -179,7 +180,8 @@ createPrincipalDef =

createPrincipal :: Info -> Guard (Term Name) -> Eval e Text
createPrincipal i g = do
g' <- traverse enforcePactValue g
f <- ifExecutionFlagSet' FlagDisablePact48 id elideModRefInfo
g' <- traverse (fmap f . enforcePactValue) g
mkPrincipalIdent <$> guardToPrincipal chargeGas g'
where
chargeGas amt =
Expand Down
47 changes: 47 additions & 0 deletions tests/pact/principals.repl
Original file line number Diff line number Diff line change
Expand Up @@ -595,3 +595,50 @@
"validating principal pact guards roundtrips with create-principal"
true
(continue-pact 1))

(commit-tx)

; Pact 4.8 principals test
(begin-tx)
(interface iface1
(defun f:integer (a:integer)))

(module m g
(defcap g () true)

(implements iface1)

(defschema ms g:string)

(deftable mstbl:{ms})

(defun f:integer (a:integer) 1)

(defcap test-cap (m:module{iface1}) 1)

(defun write-principal(key:string p:string)
(write mstbl key {"g":p}))

(defun get-principal (key:string)
(at "g" (read mstbl key)))
)

(create-table mstbl)

; Test principal caps created pre-info eliding
(env-exec-config ["DisablePact48"])
(write-principal 'a (create-principal (create-capability-guard (test-cap m))))

(write-principal 'b (create-principal (create-capability-guard (test-cap m))))

(expect "cap guard principals are different" false (= (get-principal "a") (get-principal "b")))

; Test Principals post-info eliding
(env-exec-config [])

(write-principal 'a (create-principal (create-capability-guard (test-cap m))))

(write-principal 'b (create-principal (create-capability-guard (test-cap m))))

(expect "cap guard principals are equal" (get-principal "a") (get-principal "b"))
(commit-tx)

0 comments on commit 528b0cd

Please sign in to comment.