diff --git a/CHANGELOG.md b/CHANGELOG.md index 36096dc5a..9cb2362ee 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,17 @@ +4.12.0 +--- +### Features +- Support for keccak256 native (#1354) +- Add poseidon hash alias as `hash-poseidon` (#1356) + +### Bugfixes +- Fixed parsing of difftime as a property (#1349) + +### Misc +- Added pact version command to verify linking (#1350) + + + 4.11.0 --- ### Features diff --git a/pact.cabal b/pact.cabal index 841c44308..84b61c365 100644 --- a/pact.cabal +++ b/pact.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: pact -version: 4.11 +version: 4.12 -- ^ 4 digit is prerelease, 3- or 2-digit for prod release synopsis: Smart contract language library and REPL description: @@ -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/Interpreter.hs b/src/Pact/Interpreter.hs index 5bd57a31f..61cce1724 100644 --- a/src/Pact/Interpreter.hs +++ b/src/Pact/Interpreter.hs @@ -212,6 +212,7 @@ setupEvalEnv dbEnv ent mode msgData refStore gasEnv np spv pd ec = do , _eeAdvice = def , _eeInRepl = False , _eeWarnings = warnRef + , _eeSigCapBypass = mempty } where mkMsgSigs ss = M.fromList $ map toPair ss diff --git a/src/Pact/Native/Capabilities.hs b/src/Pact/Native/Capabilities.hs index 690fdbcc5..f45b31c0c 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 @@ -173,7 +174,10 @@ 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" @@ -220,9 +224,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.hs b/src/Pact/Repl.hs index bc9f2ed18..977de1c3e 100644 --- a/src/Pact/Repl.hs +++ b/src/Pact/Repl.hs @@ -155,6 +155,7 @@ initEvalEnv ls = do , _eeAdvice = def , _eeInRepl = True , _eeWarnings = warnRef + , _eeSigCapBypass = mempty } where spvs mv = set spvSupport (spv mv) noSPVSupport diff --git a/src/Pact/Repl/Lib.hs b/src/Pact/Repl/Lib.hs index e09b5e893..3d59ea09c 100644 --- a/src/Pact/Repl/Lib.hs +++ b/src/Pact/Repl/Lib.hs @@ -365,6 +365,7 @@ setsigs' _ [TList ts _ _] = do return $ tStr "Setting transaction signatures/caps" setsigs' i as = argsError' i as + envVerifiers :: ZNativeFun LibState envVerifiers _ [TList ts _ _] = do vers <- forM ts $ \t -> case t of @@ -764,7 +765,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..aa462bba5 100644 --- a/src/Pact/Runtime/Capabilities.hs +++ b/src/Pact/Runtime/Capabilities.hs @@ -34,10 +34,12 @@ module Pact.Runtime.Capabilities import Control.Monad import Control.Lens hiding (DefName) +import Control.Monad.Trans.Maybe import Data.Default import Data.Foldable import Data.List import Data.Text (Text) +import Data.Maybe(fromMaybe) import qualified Data.Map.Strict as M import qualified Data.Set as S @@ -47,6 +49,7 @@ import Pact.Types.Pretty import Pact.Types.Runtime import Pact.Runtime.Utils + -- | Tie the knot with Pact.Eval by having caller supply `apply` etc type ApplyMgrFun e = Def Ref -> PactValue -> PactValue -> Eval e PactValue -- | More knot tying to on-demand install a managed cap @@ -276,11 +279,44 @@ checkSigCaps -> Eval e (M.Map PublicKeyText (S.Set UserCapability)) checkSigCaps sigs = go where - go = do - granted <- getAllStackCaps + go = ifExecutionFlagSet FlagDisablePact412 legacyCheck pact412Check + legacyCheck = getAllStackCaps >>= checkSigs + pact412Check = do + capsBeingEvaluated <- use evalUserCapabilitiesBeingEvaluated + let + eligibleCaps + | null capsBeingEvaluated = getAllStackCaps + | otherwise = return capsBeingEvaluated + eligibleCaps >>= checkSigs + -- Check whether the cap bypass list is enabled for this callsite + checkBypassEnabled = fmap (fromMaybe $ \_ _ -> False) $ runMaybeT $ do + bp <- view eeSigCapBypass + qn <- MaybeT findFirstUserCall + (allowSet, wmh) <- hoistMaybe $ M.lookup qn bp + mh <- MaybeT $ lookupModuleHash def (_qnQual qn) + guard (mh == wmh) + pure allowSet + + checkSigs granted = do autos <- use $ evalCapabilities . capAutonomous - return $ M.filter (match (S.null autos) granted) sigs + wl <- checkBypassEnabled + return $ M.filter (match (S.null autos) granted wl) sigs - match allowEmpty granted sigCaps = + match allowEmpty granted handleBypass sigCaps = (S.null sigCaps && allowEmpty) || - not (S.null (S.intersection granted sigCaps)) + not (S.null (S.intersection granted sigCaps)) || + handleBypass granted sigCaps + +findFirstUserCall :: Eval e (Maybe QualifiedName) +findFirstUserCall = use evalCallStack >>= go + where + go (sf : rest) = case sf of + StackFrame _sfn _loc (Just (fa, _)) + | Just mn <- _faModule fa -> pure $ Just (QualifiedName mn (_faName fa) def) + _ -> go rest + go [] = pure Nothing + +lookupModuleHash :: Info -> ModuleName -> Eval e (Maybe ModuleHash) +lookupModuleHash i mn = lookupModule i mn >>= \case + Just (ModuleData (MDModule mdl) _ _) -> pure $ Just $ _mHash mdl + _ -> pure Nothing diff --git a/src/Pact/Types/Purity.hs b/src/Pact/Types/Purity.hs index bd6c206a7..764228487 100644 --- a/src/Pact/Types/Purity.hs +++ b/src/Pact/Types/Purity.hs @@ -101,6 +101,7 @@ mkPureEnv holder purity readRowImpl env@EvalEnv{..} = do _eeAdvice _eeInRepl _eeWarnings + _eeSigCapBypass -- | Operationally creates the sysread-only environment. -- Phantom type and typeclass assigned in "runXXX" functions. diff --git a/src/Pact/Types/Runtime.hs b/src/Pact/Types/Runtime.hs index b826cfba9..72525cba6 100644 --- a/src/Pact/Types/Runtime.hs +++ b/src/Pact/Types/Runtime.hs @@ -32,7 +32,7 @@ module Pact.Types.Runtime RefStore(..),rsNatives, EvalEnv(..),eeRefStore,eeMsgSigs,eeMsgVerifiers,eeMsgBody,eeMode,eeEntity,eePactStep,eePactDbVar,eeInRepl, eePactDb,eePurity,eeHash,eeGas, eeGasEnv,eeNamespacePolicy,eeSPVSupport,eePublicData,eeExecutionConfig, - eeAdvice, eeWarnings, + eeAdvice, eeWarnings, eeSigCapBypass, toPactId, Purity(..), RefState(..),rsLoaded,rsLoadedModules,rsNamespace,rsQualifiedDeps, @@ -254,6 +254,8 @@ instance J.Encode ExecutionConfig where mkExecutionConfig :: [ExecutionFlag] -> ExecutionConfig mkExecutionConfig = ExecutionConfig . S.fromList +type CapBypass = Set SigCapability -> Set SigCapability -> Bool + -- | Interpreter reader environment, parameterized over back-end MVar state type. data EvalEnv e = EvalEnv { -- | Environment references. @@ -296,6 +298,8 @@ data EvalEnv e = EvalEnv { , _eeInRepl :: !Bool -- | Warnings ref , _eeWarnings :: !(IORef (Set PactWarning)) + -- | Patch-related caps + , _eeSigCapBypass :: M.Map QualifiedName (CapBypass, ModuleHash) } makeLenses ''EvalEnv