From e7d474175f8a9a0a67253ab59fed1928d31974fa Mon Sep 17 00:00:00 2001
From: Stuart Popejoy <sirlensalot@users.noreply.github.com>
Date: Mon, 18 Sep 2023 21:03:54 -0400
Subject: [PATCH] properly acquire module governance caps at upgrade

---
 src/Pact/Eval.hs                        | 19 +++++++++++++++++--
 src/Pact/Runtime/Capabilities.hs        | 13 +++++++------
 src/Pact/Types/Runtime.hs               |  2 ++
 tests/PactTestsSpec.hs                  |  2 ++
 tests/pact/bad/bad-gov-cap-acquire.repl | 22 ++++++++++++++++++++++
 tests/pact/caps.repl                    | 24 ++++++++++++++++++++++++
 6 files changed, 74 insertions(+), 8 deletions(-)
 create mode 100644 tests/pact/bad/bad-gov-cap-acquire.repl

diff --git a/src/Pact/Eval.hs b/src/Pact/Eval.hs
index 8fff7216d..5443e2c73 100644
--- a/src/Pact/Eval.hs
+++ b/src/Pact/Eval.hs
@@ -233,9 +233,24 @@ enforceModuleAdmin i mn modGov =
       Right d@Def{..} -> case _dDefType of
         Defcap -> do
           af <- prepareUserAppArgs d [] _dInfo
-          computeUserAppGas d _dInfo
-          void $ evalUserAppBody d af _dInfo reduceBody
+          ifExecutionFlagSet FlagDisablePact49 (runCapBody d af _dInfo) $ do
+            -- Properly acquire gov cap to allow scoping.
+            -- Note that nerfed manager functions mean that a gov cap with
+            -- @managed will fail, which is a good thing as management of a gov
+            -- cap is meaningless. However we should probably enforce this in
+            -- module load.
+            let cap = SigCapability (QualifiedName _dModule (asString _dDefName) i) []
+            void $ evalUserCapability i nerfedFuns CapCallStack cap d $
+                runCapBody d af i
         _ -> evalError i "enforceModuleAdmin: module governance must be defcap"
+  where
+    runCapBody d af di = do
+      computeUserAppGas d di
+      void $ evalUserAppBody d af di reduceBody
+    nerfedFuns =
+      (\_ _ _ -> evalError i "Illegal managed function application in governance defcap"
+      ,\_ _ -> evalError i "Illegal managed function install in governance defcap"
+      )
 
 withModuleKeysetMagicCap :: HasInfo i => i -> ModuleName -> Eval e a -> Eval e a
 withModuleKeysetMagicCap i mn =
diff --git a/src/Pact/Runtime/Capabilities.hs b/src/Pact/Runtime/Capabilities.hs
index 2a6f02773..0da16ae12 100644
--- a/src/Pact/Runtime/Capabilities.hs
+++ b/src/Pact/Runtime/Capabilities.hs
@@ -83,12 +83,13 @@ popCapStack act = do
 -- Magic caps are not managed and do not allow nested acquisition.
 --
 withMagicCapability :: HasInfo i => i -> Text -> [PactValue] -> Eval e a -> Eval e a
-withMagicCapability i name args action = do
-  inscope <- capabilityAcquired cap
-  when inscope $ evalError' i "Internal error, magic capability already acquired"
-  evalCapabilities . capStack %= (slot:)
-  r <- action
-  popCapStack (const (return r))
+withMagicCapability i name args action =
+  ifExecutionFlagSet FlagDisablePact49 action $ do
+    inscope <- capabilityAcquired cap
+    when inscope $ evalError' i "Internal error, magic capability already acquired"
+    evalCapabilities . capStack %= (slot:)
+    r <- action
+    popCapStack (const (return r))
   where
     slot = CapSlot CapCallStack cap []
     cap = SigCapability (QualifiedName "pact" name def) args
diff --git a/src/Pact/Types/Runtime.hs b/src/Pact/Types/Runtime.hs
index a851102a4..9e6c3c25f 100644
--- a/src/Pact/Types/Runtime.hs
+++ b/src/Pact/Types/Runtime.hs
@@ -198,6 +198,8 @@ data ExecutionFlag
   | FlagDisableRuntimeReturnTypeChecking
   -- | Disable Pact 4.8 Features
   | FlagDisablePact48
+  -- | Disable Pact 4.9 Features
+  | FlagDisablePact49
   deriving (Eq,Ord,Show,Enum,Bounded)
 
 -- | Flag string representation
diff --git a/tests/PactTestsSpec.hs b/tests/PactTestsSpec.hs
index 25d468198..d3d77256f 100644
--- a/tests/PactTestsSpec.hs
+++ b/tests/PactTestsSpec.hs
@@ -151,6 +151,8 @@ badErrors = M.fromList
    ,"Keyset failure (keys-all): 'ns.magic")
   ,(pfx "bad-magic-module-keyset-upgrade.repl"
    ,"Keyset failure (keys-all): 'ns.magic")
+  ,(pfx "bad-gov-cap-acquire.repl"
+   ,"Keyset failure (keys-all): [gov]")
 
   ]
   where
diff --git a/tests/pact/bad/bad-gov-cap-acquire.repl b/tests/pact/bad/bad-gov-cap-acquire.repl
new file mode 100644
index 000000000..d8f8cd6b8
--- /dev/null
+++ b/tests/pact/bad/bad-gov-cap-acquire.repl
@@ -0,0 +1,22 @@
+;; ======== test governance cap acquire ========
+
+(begin-tx)
+(env-data { 'k: ['ns], 'gov: ['gov] })
+(define-namespace 'ns (read-keyset 'k) (read-keyset 'k))
+(namespace 'ns)
+(env-keys ['ns])
+(module govcap-acquire GOV
+  (defcap GOV ()
+    (enforce-guard (read-keyset 'gov)))
+  (defcap OTHER () true))
+(commit-tx)
+
+(begin-tx)
+(env-sigs
+ [ { 'key: 'gov
+   , 'caps: [ (ns.govcap-acquire.OTHER) ] } ])
+(namespace 'ns)
+;; failure because wrong cap scoped
+(module govcap-acquire GOV
+  (defcap GOV () true))
+(rollback-tx)
diff --git a/tests/pact/caps.repl b/tests/pact/caps.repl
index da7b88df7..e981be965 100644
--- a/tests/pact/caps.repl
+++ b/tests/pact/caps.repl
@@ -939,3 +939,27 @@
    (call-op2 "goodbye" false))
 
 (commit-tx)
+
+
+
+;; ======== test governance cap acquire ========
+
+(begin-tx)
+(env-data { 'k: ['ns], 'gov: ['gov] })
+(define-namespace 'ns (read-keyset 'k) (read-keyset 'k))
+(namespace 'ns)
+(env-keys ['ns])
+(module govcap-acquire GOV
+  (defcap GOV ()
+    (enforce-guard (read-keyset 'gov))))
+(commit-tx)
+
+(begin-tx)
+(env-sigs
+ [ { 'key: 'gov
+   , 'caps: [ (ns.govcap-acquire.GOV) ] } ])
+(namespace 'ns)
+;; upgrade succeeds, failure in bad tests
+(module govcap-acquire GOV
+  (defcap GOV () true))
+(rollback-tx)