Put keyset namespaces requirement under a flag

kadena-io · Nov 29, 2023 · cfe4c7a · cfe4c7a
1 parent 405f213
commit cfe4c7a
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 14 deletions.
diff --git a/pact-core/Pact/Core/Environment/Types.hs b/pact-core/Pact/Core/Environment/Types.hs
@@ -86,6 +86,8 @@ data ExecutionFlag
   | FlagDisablePactEvents
   -- | Run the validity checks on keys
   | FlagEnforceKeyFormats
+  -- | Require keysets to be defined in namespaces
+  | FlagRequireKeysetNs
   deriving (Eq,Ord,Show,Enum,Bounded)
 
 -- | Flag string representation

diff --git a/pact-core/Pact/Core/IR/Eval/RawBuiltin.hs b/pact-core/Pact/Core/IR/Eval/RawBuiltin.hs
@@ -1038,24 +1038,26 @@ defineKeySet'
   -> m (EvalResult b i m)
 defineKeySet' info cont handler env ksname newKs  = do
   let pdb = view cePactDb env
+  laxNs <- not <$> isExecutionFlagSet FlagRequireKeysetNs
   case parseAnyKeysetName ksname of
     Left {} -> returnCEK cont handler (VError "incorrect keyset name format" info)
-    Right ksn -> liftDbFunction info (_pdbRead pdb DKeySets ksn) >>= \case
-      Just oldKs -> do
-        cond <- enforceKeyset oldKs
-        if cond then do
+    Right ksn -> do
+      let writeKs = do
             liftDbFunction info (_pdbWrite pdb Write DKeySets ksn newKs)
             returnCEKValue cont handler (VString "Keyset write success")
-        else returnCEK cont handler (VError "enforce keyset failure" info)
-      Nothing -> useEvalState (esLoaded . loNamespace) >>= \case
-        Nothing -> returnCEK cont handler (VError "Cannot define a keyset outside of a namespace" info)
-        Just (Namespace ns uGuard _adminGuard) -> do
-          enforceGuardCont info cont handler env uGuard $
-            if Just ns == _keysetNs ksn
-              then do
-                liftDbFunction info (_pdbWrite pdb Write DKeySets ksn newKs)
-                returnCEKValue cont handler (VString "Keyset write success")
-              else returnCEK cont handler (VError "Mismatching keyset namespace" info)
+      liftDbFunction info (_pdbRead pdb DKeySets ksn) >>= \case
+        Just oldKs -> do
+          cond <- enforceKeyset oldKs
+          if cond then writeKs
+          else returnCEK cont handler (VError "enforce keyset failure" info)
+        Nothing | laxNs -> writeKs
+        Nothing | otherwise -> useEvalState (esLoaded . loNamespace) >>= \case
+          Nothing -> returnCEK cont handler (VError "Cannot define a keyset outside of a namespace" info)
+          Just (Namespace ns uGuard _adminGuard) -> do
+            enforceGuardCont info cont handler env uGuard $
+              if Just ns == _keysetNs ksn
+                then writeKs
+                else returnCEK cont handler (VError "Mismatching keyset namespace" info)
 
 defineKeySet :: (IsBuiltin b, MonadEval b i m) => NativeFunction b i m
 defineKeySet = \info b cont handler env -> \case