Make verifier plugin list global

Now ChainwebVersion only holds a list of the names of enabled plugins, to keep it pure data

src/Chainweb/Pact/TransactionExec.hs

@@ -357,6 +357,7 @@ flagsFor v cid bh = S.fromList $ concat
   , disableReturnRTC v cid bh
   , enablePact49 v cid bh
   , enablePact410 v cid bh
+  , enablePactVerifiers v cid bh
   ]
 
 applyCoinbase
@@ -789,6 +790,9 @@ enablePact49 v cid bh = [FlagDisablePact49 | not (chainweb221Pact v cid bh)]
 enablePact410 :: ChainwebVersion -> V.ChainId -> BlockHeight -> [ExecutionFlag]
 enablePact410 v cid bh = [FlagDisablePact410 | not (chainweb222Pact v cid bh)]
 
+enablePactVerifiers :: ChainwebVersion -> V.ChainId -> BlockHeight -> [ExecutionFlag]
+enablePactVerifiers v cid bh = [FlagDisableVerifiers | not (enableVerifiers v cid bh)]
+
 -- | Even though this is not forking, abstracting for future shutoffs
 disableReturnRTC :: ChainwebVersion -> V.ChainId -> BlockHeight -> [ExecutionFlag]
 disableReturnRTC _v _cid _bh = [FlagDisableRuntimeReturnTypeChecking]

src/Chainweb/VerifierPlugin.hs

@@ -25,13 +25,13 @@ import Data.Set(Set)
 import qualified Data.Set as Set
 import Data.Text(Text)
 
-import Chainweb.Transaction
-
 import Pact.Types.Capability
 import Pact.Types.Command
 import Pact.Types.PactValue
 import Pact.Types.Verifier
 
+import Chainweb.Transaction
+
 data VerifierError = VerifierError Text
     deriving stock Show
 instance Exception VerifierError
@@ -40,7 +40,7 @@ data ShouldRunVerifierPlugins = RunVerifierPlugins | DoNotRunVerifierPlugins
 
 newtype VerifierPlugin
     = VerifierPlugin
-    { runVerifierPlugin :: ChainwebTransaction -> [PactValue] -> Set SigCapability -> IO ()
+    { runVerifierPlugin :: [PactValue] -> Set SigCapability -> Either VerifierError ()
     }
     deriving newtype NFData
 
@@ -51,7 +51,9 @@ runVerifierPlugins allVerifiers tx =
         Merge.dropMissing
         (Merge.zipWithAMatched $ \_vn argsAndCaps verifierPlugin ->
             for_ argsAndCaps $ \(args, caps) ->
-                runVerifierPlugin verifierPlugin tx args caps
+                case runVerifierPlugin verifierPlugin args caps of
+                    Left err -> throwIO err
+                    Right () -> return ()
             )
         usedVerifiers
         allVerifiers

src/Chainweb/VerifierPlugin/Trivial.hs

@@ -0,0 +1,39 @@
+{-# language BangPatterns #-}
+{-# language ScopedTypeVariables #-}
+{-# language OverloadedStrings #-}
+module Chainweb.VerifierPlugin.Trivial(plugin) where
+
+import Control.Lens
+import Control.Monad
+import Data.Aeson
+import qualified Data.Set as Set
+import qualified Data.Text as Text
+import qualified Data.Text.Encoding as Text
+
+import Pact.Types.Capability
+import Pact.Types.Exp
+import Pact.Types.PactValue
+
+import Chainweb.VerifierPlugin
+
+-- This trivial verifier plugin takes as arguments a list of JSON-encoded
+-- capabilities, and grants any subset of them.
+plugin :: VerifierPlugin
+plugin = VerifierPlugin $ \args caps -> over _Left VerifierError $ do
+    decodedArgs :: [UserCapability] <- traverse decodeArgToCap args
+    unless (noDuplicates decodedArgs) $
+        Left "duplicate capabilities exist in the arguments"
+    unless (caps `Set.isSubsetOf` Set.fromList decodedArgs) $
+        Left "granted capabilities are not a subset of those in the arguments"
+    where
+    noDuplicates :: Ord a => [a] -> Bool
+    noDuplicates = go Set.empty
+        where
+        go _ [] = True
+        go seen (x:xs) =
+            not (Set.member x seen) &&
+            (let !seen' = Set.insert x seen in go seen' xs)
+    decodeArgToCap (PLiteral (LString arg)) =
+        over _Left Text.pack $ eitherDecodeStrict' (Text.encodeUtf8 arg)
+    decodeArgToCap _ =
+        Left "expected string literal in verifier arguments"

src/Chainweb/Version.hs

@@ -63,7 +63,7 @@ module Chainweb.Version
     , versionName
     , versionWindow
     , versionGenesis
-    , versionVerifierPlugins
+    , versionVerifierPluginNames
     , genesisBlockPayload
     , genesisBlockPayloadHash
     , genesisBlockTarget
@@ -134,7 +134,7 @@ import Data.Hashable
 import Data.HashMap.Strict (HashMap)
 import qualified Data.HashMap.Strict as HM
 import qualified Data.HashSet as HS
-import Data.Map.Strict(Map)
+import Data.Set(Set)
 import Data.Proxy
 import qualified Data.Text as T
 import Data.Word
@@ -157,7 +157,6 @@ import Chainweb.Transaction
 import Chainweb.Utils
 import Chainweb.Utils.Rule
 import Chainweb.Utils.Serialization
-import Chainweb.VerifierPlugin
 
 import Data.Singletons
 
@@ -370,7 +369,7 @@ data ChainwebVersion
         -- ^ Whether to disable any core functionality.
     , _versionDefaults :: VersionDefaults
         -- ^ Version-specific defaults that can be overridden elsewhere.
-    , _versionVerifierPlugins :: ChainMap (Rule BlockHeight (Map T.Text VerifierPlugin))
+    , _versionVerifierPluginNames :: ChainMap (Rule BlockHeight (Set T.Text))
         -- ^ Verifier plugins that can be run to verify transaction contents.
     }
     deriving stock (Generic)
@@ -395,6 +394,7 @@ instance Ord ChainwebVersion where
         -- genesis cannot be ordered because Payload in Pact cannot be ordered
         -- , _versionGenesis v `compare` _versionGenesis v'
         , _versionCheats v `compare` _versionCheats v'
+        , _versionVerifierPluginNames v `compare` _versionVerifierPluginNames v'
         ]
 
 instance Eq ChainwebVersion where

src/Chainweb/Version/Development.hs

@@ -112,5 +112,5 @@ devnet = ChainwebVersion
         { _disablePeerValidation = True
         , _disableMempoolSync = False
         }
-    , _versionVerifierPlugins = AllChains $ End $ mempty
+    , _versionVerifierPluginNames = AllChains $ End $ mempty
     }

src/Chainweb/Version/FastDevelopment.hs

@@ -55,5 +55,5 @@ fastDevnet = ChainwebVersion
         { _disablePeerValidation = True
         , _disableMempoolSync = False
         }
-    , _versionVerifierPlugins = AllChains $ End $ mempty
+    , _versionVerifierPluginNames = AllChains $ End $ mempty
     }

src/Chainweb/Version/Mainnet.hs

@@ -204,5 +204,5 @@ mainnet = ChainwebVersion
         { _disablePeerValidation = False
         , _disableMempoolSync = False
         }
-    , _versionVerifierPlugins = AllChains $ End $ mempty
+    , _versionVerifierPluginNames = AllChains $ End $ mempty
     }

src/Chainweb/Version/Testnet.hs

@@ -175,5 +175,5 @@ testnet = ChainwebVersion
         { _disablePeerValidation = False
         , _disableMempoolSync = False
         }
-    , _versionVerifierPlugins = AllChains $ End $ mempty
+    , _versionVerifierPluginNames = AllChains $ End $ mempty
     }

src/Chainweb/Version/Utils.hs

@@ -66,6 +66,7 @@ import Chainweb.ChainId
 import Chainweb.Difficulty
 import Chainweb.Time
 import Chainweb.VerifierPlugin
+import qualified Chainweb.VerifierPlugin.Trivial
 
 import Control.Lens
 import Data.Foldable
@@ -456,7 +457,19 @@ expectedCutHeightAfterSeconds v s = eh * int (chainCountAt v (round eh))
 -- | The verifier plugins enabled for a particular block.
 verifiersAt :: ChainwebVersion -> ChainId -> BlockHeight -> Map Text VerifierPlugin
 verifiersAt v cid bh =
-    case measureRule bh $ _versionVerifierPlugins v ^?! onChain cid of
-        Bottom vs -> vs
-        Top (_, vs) -> vs
-        Between (_, vs) _ -> vs
+    M.restrictKeys allVerifierPlugins activeVerifierNames
+    where
+    activeVerifierNames =
+        case measureRule bh $ _versionVerifierPluginNames v ^?! onChain cid of
+            Bottom vs -> vs
+            Top (_, vs) -> vs
+            Between (_, vs) _ -> vs
+
+-- the mappings from names to verifier plugins is global. the list of verifier
+-- plugins active in any particular block validation context is the only thing
+-- that varies. this pedantry is only so that ChainwebVersion is plain data
+-- with no functions inside.
+allVerifierPlugins :: Map Text VerifierPlugin
+allVerifierPlugins = M.fromList
+    [ ("trivial", Chainweb.VerifierPlugin.Trivial.plugin)
+    ]