refactor: share code between verifier and signature scoping

docs/en/pact-functions.md

@@ -5,14 +5,14 @@
 
 Constant denoting the ASCII charset
 
-Constant:
+Constant: 
   `CHARSET_ASCII:integer = 0`
 
 ### CHARSET_LATIN1 {#CHARSET_LATIN1}
 
 Constant denoting the Latin-1 charset ISO-8859-1
 
-Constant:
+Constant: 
   `CHARSET_LATIN1:integer = 1`
 
 ### at {#at}
@@ -765,7 +765,7 @@ Top level only: this function will fail if used in module code.
 
 Select rows from TABLE using QRY as a predicate with both key and value, and then accumulate results of the query in CONSUMER. Output is sorted by the ordering of keys.
 ```lisp
-(let*
+(let* 
  ((qry (lambda (k obj) true)) ;; select all rows
   (f (lambda (k obj) [(at 'firstName obj), (at 'b obj)]))
  )
@@ -924,7 +924,7 @@ pact> (add-time (time "2016-07-22T12:00:00Z") 15)
 *n* `integer` *→* `decimal`
 
 
-N days, for use with 'add-time'
+N days, for use with 'add-time' 
 ```lisp
 pact> (add-time (time "2016-07-22T12:00:00Z") (days 1))
 "2016-07-23T12:00:00Z"
@@ -962,7 +962,7 @@ pact> (format-time "%F" (time "2016-07-22T12:00:00Z"))
 *n* `integer` *→* `decimal`
 
 
-N hours, for use with 'add-time'
+N hours, for use with 'add-time' 
 ```lisp
 pact> (add-time (time "2016-07-22T12:00:00Z") (hours 1))
 "2016-07-22T13:00:00Z"
@@ -976,7 +976,7 @@ pact> (add-time (time "2016-07-22T12:00:00Z") (hours 1))
 *n* `integer` *→* `decimal`
 
 
-N minutes, for use with 'add-time'.
+N minutes, for use with 'add-time'. 
 ```lisp
 pact> (add-time (time "2016-07-22T12:00:00Z") (minutes 1))
 "2016-07-22T12:01:00Z"
@@ -1000,7 +1000,7 @@ pact> (parse-time "%F" "2016-09-12")
 *utcval* `string` *→* `time`
 
 
-Construct time from UTCVAL using ISO8601 format (%Y-%m-%dT%H:%M:%SZ).
+Construct time from UTCVAL using ISO8601 format (%Y-%m-%dT%H:%M:%SZ). 
 ```lisp
 pact> (time "2016-07-22T11:26:35Z")
 "2016-07-22T11:26:35Z"

src/Pact/Native/Capabilities.hs

@@ -74,12 +74,13 @@ withCapability =
       enforceNotWithinDefcap i "with-capability"
 
       (cap,d,prep) <- appToCap (_tApp c)
-      evalUserCapabilitiesBeingEvaluated %= S.insert cap
+      oldCapsBeingEvaluated <- use evalUserCapabilitiesBeingEvaluated
+      evalUserCapabilitiesBeingEvaluated .= S.singleton cap
 
       -- evaluate in-module cap
       acquireResult <- evalCap (getInfo i) CapCallStack True (cap,d,prep,getInfo c)
 
-      evalUserCapabilitiesBeingEvaluated %= S.delete cap
+      evalUserCapabilitiesBeingEvaluated .= oldCapsBeingEvaluated
 
       -- execute scoped code
       r <- reduceBody body
@@ -169,9 +170,14 @@ capFuns :: (ApplyMgrFun e,InstallMgd e)
 capFuns = (applyMgrFun,installSigCap)
 
 installSigCap :: InstallMgd e
-installSigCap cap@SigCapability{..} cdef = do
-  ty <- traverse reduce (_dFunType cdef)
-  r <- evalCap (getInfo cdef) CapManaged True (cap,cdef,(fromPactValue <$> _scArgs,ty),getInfo cdef)
+installSigCap SigCapability{..} cdef = do
+  (cap,d,prep) <- appToCap $
+    App (TVar (Ref (TDef cdef (getInfo cdef))) (getInfo cdef))
+        (map (liftTerm . fromPactValue) _scArgs) (getInfo cdef)
+  oldCapsBeingEvaluated <- use evalUserCapabilitiesBeingEvaluated
+  evalUserCapabilitiesBeingEvaluated %= S.insert cap
+  r <- evalCap (getInfo cdef) CapManaged True (cap,d,prep,getInfo cdef)
+  evalUserCapabilitiesBeingEvaluated .= oldCapsBeingEvaluated
   case r of
     NewlyInstalled mc -> return mc
     _ -> evalError' cdef "Unexpected result from managed sig cap install"
@@ -217,9 +223,10 @@ composeCapability =
       defcapInStack (Just 1) >>= \p -> unless p $ evalError' i "compose-capability valid only within defcap body"
       -- evalCap as composed, which will install onto head of pending cap
       (cap,d,prep) <- appToCap app
+      oldUserCapabilitiesBeingEvaluated <- use evalUserCapabilitiesBeingEvaluated
       evalUserCapabilitiesBeingEvaluated %= S.insert cap
       void $ evalCap (getInfo i) CapComposed True (cap,d,prep,getInfo app)
-      evalUserCapabilitiesBeingEvaluated %= S.delete cap
+      evalUserCapabilitiesBeingEvaluated .= oldUserCapabilitiesBeingEvaluated
       return $ toTerm True
     composeCapability' i as = argsError' i as
 

src/Pact/Repl/Lib.hs

@@ -764,7 +764,10 @@ testCapability :: ZNativeFun ReplState
 testCapability i [ (TApp app _) ] = do
   (cap,d,prep) <- appToCap app
   let scope = maybe CapCallStack (const CapManaged) (_dDefMeta d)
+  oldUserCapabilitiesBeingEvaluated <- use evalUserCapabilitiesBeingEvaluated
+  evalUserCapabilitiesBeingEvaluated .= S.singleton cap
   r <- evalCap (getInfo i) scope False (cap,d,prep,getInfo app)
+  evalUserCapabilitiesBeingEvaluated .= oldUserCapabilitiesBeingEvaluated
   return . tStr $ case r of
     AlreadyAcquired -> "Capability already acquired"
     NewlyAcquired -> "Capability acquired"

src/Pact/Runtime/Capabilities.hs

@@ -277,7 +277,14 @@ checkSigCaps
 checkSigCaps sigs = go
   where
     go = do
-      granted <- getAllStackCaps
+      capsBeingEvaluated <- use evalUserCapabilitiesBeingEvaluated
+      let
+        eligibleCaps
+          | null capsBeingEvaluated = getAllStackCaps
+          | otherwise = return capsBeingEvaluated
+      granted <- ifExecutionFlagSet FlagDisablePact410
+        getAllStackCaps
+        eligibleCaps
       autos <- use $ evalCapabilities . capAutonomous
       return $ M.filter (match (S.null autos) granted) sigs