From fdf19eec86f9c93d3fc10cf55b7e6dc9026a26b7 Mon Sep 17 00:00:00 2001 From: jmcardon Date: Fri, 3 May 2024 16:32:38 -0400 Subject: [PATCH] add whitelist --- docs/en/pact-functions.md | 8 -------- pact.cabal | 2 +- src/Pact/Repl/Lib.hs | 22 +--------------------- src/Pact/Runtime/Capabilities.hs | 8 ++++---- src/Pact/Types/Runtime.hs | 4 +++- 5 files changed, 9 insertions(+), 35 deletions(-) diff --git a/docs/en/pact-functions.md b/docs/en/pact-functions.md index 67f285387..7697d28f2 100644 --- a/docs/en/pact-functions.md +++ b/docs/en/pact-functions.md @@ -2146,14 +2146,6 @@ Set transaction verifier names and capabilities. VERIFIERS is a list of objects ``` -### env-whitelist {#env-whitelist} - -*blah* `` *→* `` - - -beepidy boop - - ### expect {#expect} *doc* `string` *expected* `` *actual* `` *→* `string` diff --git a/pact.cabal b/pact.cabal index 841c44308..c92ead5f3 100644 --- a/pact.cabal +++ b/pact.cabal @@ -253,6 +253,7 @@ library , statistics >=0.13.3 , text >=2 , time + , transformers >= 0.5.2.0 && < 0.7 , trifecta >=2.1.1.1 , unordered-containers >=0.2.19 , utf8-string >=1.0.1.1 @@ -327,7 +328,6 @@ library , sbv >=9.0 , semigroupoids >=5.0 , servant-server - , transformers >= 0.5.2.0 && < 0.7 , wai-cors , warp if !os(windows) diff --git a/src/Pact/Repl/Lib.hs b/src/Pact/Repl/Lib.hs index 17ac31a21..3d59ea09c 100644 --- a/src/Pact/Repl/Lib.hs +++ b/src/Pact/Repl/Lib.hs @@ -25,7 +25,7 @@ import Control.Arrow ((&&&)) import Control.Concurrent.MVar import Control.Lens import Control.Exception.Safe -import Control.Monad (foldM, forM, when, (>=>)) +import Control.Monad (foldM, forM, when) import Control.Monad.Reader import Control.Monad.State.Strict (get,put) @@ -268,7 +268,6 @@ replDefs = ("Repl", (funType tTyString [("on-chain", tTyBool)]) [LitExample "(env-simulate-onchain true)"] "Set a flag to simulate on-chain behavior that differs from the repl, in particular for observing things like errors and stack traces." - ,defZRNative "env-whitelist" envWhitelist (funType a [("blah", a)]) [] "beepidy boop" ]) where json = mkTyVar "a" [tTyInteger,tTyString,tTyTime,tTyDecimal,tTyBool, @@ -366,25 +365,6 @@ setsigs' _ [TList ts _ _] = do return $ tStr "Setting transaction signatures/caps" setsigs' i as = argsError' i as -envWhitelist :: RNativeFun LibState -envWhitelist i [TList v _ _] = do - l <- traverse enforcePactValue v - case traverse getFields l of - Just s -> do - setenv eeCapWhitelist $ M.fromList $ V.toList s - return $ tStr "Setting transaction cap whitelist" - Nothing -> evalError' i "invalid whitelist format" - where - getFields (PObject (ObjectMap o)) = do - qn <- M.lookup "callsite" o >>= preview (_PLiteral . _LString) >>= parseQual - capNames <- M.lookup "caps" o >>= preview _PList >>= traverse (preview (_PLiteral . _LString) >=> parseQual) - h <- M.lookup "pinnedHash" o >>= preview (_PLiteral . _LString) >>= either (const Nothing) Just . fromText' - let capSet = S.fromList (V.toList capNames) - mh = ModuleHash h - pure (qn, (capSet, mh)) - getFields _ = Nothing - parseQual = either (const Nothing) Just . parseQualifiedName def -envWhitelist i as = argsError i as envVerifiers :: ZNativeFun LibState envVerifiers _ [TList ts _ _] = do diff --git a/src/Pact/Runtime/Capabilities.hs b/src/Pact/Runtime/Capabilities.hs index 5ce41097c..a5f6110f6 100644 --- a/src/Pact/Runtime/Capabilities.hs +++ b/src/Pact/Runtime/Capabilities.hs @@ -42,6 +42,7 @@ import Data.Text (Text) import Data.Maybe(fromMaybe) import qualified Data.Map.Strict as M import qualified Data.Set as S +import qualified Data.Text as T import Pact.Types.Capability import Pact.Types.PactValue @@ -49,7 +50,6 @@ import Pact.Types.Pretty import Pact.Types.Runtime import Pact.Runtime.Utils -import Debug.Trace -- | Tie the knot with Pact.Eval by having caller supply `apply` etc type ApplyMgrFun e = Def Ref -> PactValue -> PactValue -> Eval e PactValue @@ -290,7 +290,7 @@ checkSigCaps sigs = go | otherwise = return capsBeingEvaluated eligibleCaps >>= checkSigs -- Handle cap whitelisting - checkWhiteListed = fmap (fromMaybe mempty) $ runMaybeT $ do + checkWhiteListed = fmap (fromMaybe $ \_ _ -> False) $ runMaybeT $ do whitelist <- view eeCapWhitelist qn <- MaybeT findFirstUserCall (allowSet, wmh) <- hoistMaybe $ M.lookup qn whitelist @@ -303,10 +303,10 @@ checkSigCaps sigs = go wl <- checkWhiteListed return $ M.filter (match (S.null autos) granted wl) sigs - match allowEmpty granted capsDonatingSigs sigCaps = + match allowEmpty granted handleWL sigCaps = (S.null sigCaps && allowEmpty) || not (S.null (S.intersection granted sigCaps)) || - (not (S.null (S.intersection capsDonatingSigs (S.map _scName sigCaps)))) + handleWL granted sigCaps findFirstUserCall :: Eval e (Maybe QualifiedName) findFirstUserCall = use evalCallStack >>= go diff --git a/src/Pact/Types/Runtime.hs b/src/Pact/Types/Runtime.hs index b38d7eacd..3972210f9 100644 --- a/src/Pact/Types/Runtime.hs +++ b/src/Pact/Types/Runtime.hs @@ -254,6 +254,8 @@ instance J.Encode ExecutionConfig where mkExecutionConfig :: [ExecutionFlag] -> ExecutionConfig mkExecutionConfig = ExecutionConfig . S.fromList +type CapWhitelist = Set SigCapability -> Set SigCapability -> Bool + -- | Interpreter reader environment, parameterized over back-end MVar state type. data EvalEnv e = EvalEnv { -- | Environment references. @@ -297,7 +299,7 @@ data EvalEnv e = EvalEnv { -- | Warnings ref , _eeWarnings :: !(IORef (Set PactWarning)) -- | Patch-related caps - , _eeCapWhitelist :: M.Map QualifiedName (Set QualifiedName, ModuleHash) + , _eeCapWhitelist :: M.Map QualifiedName (CapWhitelist, ModuleHash) } makeLenses ''EvalEnv