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