From 528b0cd7020290594360d69b895a9155e681e511 Mon Sep 17 00:00:00 2001
From: Jose C <cardona.josem@gmail.com>
Date: Tue, 8 Aug 2023 20:53:27 -0400
Subject: [PATCH] fix principals + add test (#1273)

---
 src/Pact/Native/Guards.hs  |  4 +++-
 tests/pact/principals.repl | 47 ++++++++++++++++++++++++++++++++++++++
 2 files changed, 50 insertions(+), 1 deletion(-)

diff --git a/src/Pact/Native/Guards.hs b/src/Pact/Native/Guards.hs
index 5e946ec46..9270e2685 100644
--- a/src/Pact/Native/Guards.hs
+++ b/src/Pact/Native/Guards.hs
@@ -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
 
 
@@ -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 =
diff --git a/tests/pact/principals.repl b/tests/pact/principals.repl
index 553009be0..06d063919 100644
--- a/tests/pact/principals.repl
+++ b/tests/pact/principals.repl
@@ -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)