From 1e02b0351e5db0ca9379ed5dd4b2db55fd80c743 Mon Sep 17 00:00:00 2001 From: Edmund Noble Date: Tue, 20 Feb 2024 09:23:25 -0500 Subject: [PATCH] refactor: share code between verifier and signature scoping --- docs/en/pact-functions.md | 14 +++++++------- src/Pact/Native/Capabilities.hs | 19 +++++++++++++------ src/Pact/Repl/Lib.hs | 3 +++ src/Pact/Runtime/Capabilities.hs | 9 ++++++++- 4 files changed, 31 insertions(+), 14 deletions(-) diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index f66236e7d..14533f779 100644 --- a/docs/en/pact-functions.md +++ b/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" diff --git a/src/Pact/Native/Capabilities.hs b/src/Pact/Native/Capabilities.hs index f9e9373af..dbeed5562 100644 --- a/src/Pact/Native/Capabilities.hs +++ b/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 diff --git a/src/Pact/Repl/Lib.hs b/src/Pact/Repl/Lib.hs index e09b5e893..8567f4883 100644 --- a/src/Pact/Repl/Lib.hs +++ b/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" diff --git a/src/Pact/Runtime/Capabilities.hs b/src/Pact/Runtime/Capabilities.hs index 81325b490..bb986848f 100644 --- a/src/Pact/Runtime/Capabilities.hs +++ b/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