diff --git a/chainweb.cabal b/chainweb.cabal index 571f490462..e239f48578 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -217,6 +217,7 @@ library , Chainweb.Miner.RestAPI , Chainweb.Miner.RestAPI.Client , Chainweb.Miner.RestAPI.Server + , Chainweb.MinerReward , Chainweb.NodeVersion , Chainweb.OpenAPIValidation , Chainweb.Payload @@ -637,6 +638,7 @@ test-suite chainweb-tests Chainweb.Test.Mempool.InMem Chainweb.Test.Mempool.RestAPI Chainweb.Test.Mempool.Sync + Chainweb.Test.MinerReward Chainweb.Test.Mining Chainweb.Test.Misc Chainweb.Test.Pact4.Checkpointer @@ -696,6 +698,7 @@ test-suite chainweb-tests , byteslice >= 0.2.12 , bytesmith >= 0.3.10 , bytestring >= 0.10.12 + , cassava >= 0.5.1 , chainweb-storage >= 0.1 , containers >= 0.5 , crypton >= 0.31 diff --git a/src/Chainweb/MinerReward.hs b/src/Chainweb/MinerReward.hs new file mode 100644 index 0000000000..ec867a08d1 --- /dev/null +++ b/src/Chainweb/MinerReward.hs @@ -0,0 +1,250 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE MultiWayIf #-} +{-# LANGUAGE NumDecimals #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TemplateHaskell #-} + +-- | +-- Module: Chainweb.MinerReward +-- Copyright: Copyright © 2024 Kadena LLC. +-- License: MIT +-- Maintainer: Lars Kuhtz +-- Stability: experimental +-- +-- Chainweb Miner reward. +-- +-- Morally this is a property of the Chainweb version, however there is no need +-- to use value different from what is used on Mainnet on any network. +-- +module Chainweb.MinerReward +( +-- * STU + Stu(..) +, divideStu + +-- * KDA +, Kda +, pattern Kda +, _kda +, stuToKda +, kdaToStu + +-- * Miner Reward +, MinerReward(..) +, minerRewardKda +, blockMinerReward + +-- * Internal +-- ** Miner Rewards Table +, minerRewards +, mkMinerRewards + +-- ** Miner Rewards File +, rawMinerRewards + +-- ** Consistency Checks +, rawMinerRewardsHash +, minerRewardsHash +, expectedMinerRewardsHash +, expectedRawMinerRewardsHash +) where + +import Chainweb.BlockHeight (BlockHeight(..), encodeBlockHeight) +import Chainweb.Utils +import Chainweb.Utils.Serialization +import Chainweb.Version +import Control.DeepSeq (NFData) +import Crypto.Hash (hash, Digest) +import Crypto.Hash.Algorithms (SHA512) +import Data.Aeson +import Data.ByteString qualified as B +import Data.ByteString.Lazy qualified as BL +import Data.Csv qualified as CSV +import Data.Decimal +import Data.FileEmbed (embedFile) +import Data.Foldable +import Data.Map.Strict qualified as M +import Data.Ratio +import Data.Vector qualified as V +import Data.Word +import GHC.Generics (Generic) +import GHC.Stack +import Numeric.Natural + +-- -------------------------------------------------------------------------- -- +-- STU + +-- | Smallest Unit of KDA: 1 KDA == 1e12 STU. +-- +-- Values are non-negative and substraction can result in an arithmetic +-- underflow. +-- +newtype Stu = Stu { _stu :: Natural } + deriving stock (Show, Eq, Ord, Generic) + deriving newtype (Enum, Num, Real, Integral, NFData) + +instance HasTextRepresentation Stu where + toText = toText . _stu + fromText = fmap Stu . fromText + {-# INLINEABLE toText #-} + {-# INLINEABLE fromText #-} + +instance ToJSON Stu where + toJSON = toJSON . toText + toEncoding = toEncoding . toText + {-# INLINEABLE toJSON #-} + {-# INLINEABLE toEncoding #-} + +instance FromJSON Stu where + parseJSON = parseJsonFromText "Stu" + {-# INLINABLE parseJSON #-} + +-- | Divide a Stu by a Natural number. +-- +-- The result is rounded using bankers rounding. +-- +divideStu :: Stu -> Natural -> Stu +divideStu s n = round $ s % fromIntegral n + +-- -------------------------------------------------------------------------- -- +-- KDA + +-- | KDA encoded as Decimal. +-- +-- No arithmetic conversions or operations are provided. +-- +-- The precision of KDA values is 1e12 decimal digits. The value is stored in +-- a normalized format with the smallest possible mantissa. +-- +newtype Kda = Kda_ Decimal + deriving stock (Show, Eq, Ord, Generic) + +-- | Smart constructor for KDA. It is an error if the Decimal has more than +-- twelve decimal digits. +-- +pattern Kda :: HasCallStack => Decimal -> Kda +pattern Kda { _kda } <- Kda_ _kda where + Kda k + | roundTo 12 k /= k = error "KDA value with a precision of more than 12 decimal digits" + | otherwise = Kda_ $ normalizeDecimal k +{-# COMPLETE Kda #-} + +stuToKda :: HasCallStack => Stu -> Kda +stuToKda (Stu k) = Kda $ normalizeDecimal $ Decimal 12 (fromIntegral k) + +kdaToStu :: Kda -> Stu +kdaToStu (Kda { _kda = s }) = Stu $ round (s * 1e12) + +-- -------------------------------------------------------------------------- -- +-- Miner Reward + +-- | Miner Reward in Stu +-- +newtype MinerReward = MinerReward { _minerReward :: Stu } + deriving (Show, Eq, Ord, Generic) + +minerRewardKda :: MinerReward -> Kda +minerRewardKda (MinerReward d) = stuToKda d + +-- | Calculate miner reward for a block at the given height. +-- +-- NOTE: +-- This used to compute the value as @roundTo 8 $ (_kda $ stuToKda m) / n@. +-- The new caclulcation based on Stu is equivalent for 10 and 20 chains, +-- except for the pre-last entry in the miner rewards table, namely +-- @(125538056,0.023999333). However, since this value hasen't yet been used +-- in any network, we can still change the algorithm. +-- +blockMinerReward + :: ChainwebVersion + -> BlockHeight + -> MinerReward +blockMinerReward v h = case M.lookupGE h minerRewards of + Nothing -> MinerReward $ Stu 0 + Just (_, s) -> MinerReward $ divideStu s n + where + !n = int . order $ chainGraphAt v h + +-- -------------------------------------------------------------------------- -- +-- Internal +-- -------------------------------------------------------------------------- -- + +-- -------------------------------------------------------------------------- -- +-- Miner Rewards Table + +type MinerRewardsTable = M.Map BlockHeight Stu + +-- | Rewards table mapping 3-month periods to their rewards according to the +-- calculated exponential decay over about a 120 year period (125538057 block +-- heights). +-- +-- It provides the total reward per block height accross all chains. Use the +-- 'blockMinerReward' function to obtain the reward for a single block at a +-- given block height. +-- +-- Morally this is a property of the Chainweb version, however there is no need +-- to use value different from what is used on Mainnet on any network. +-- +-- Mining rewards are between 0 and 24 KDA. Values decrease monotonically over +-- 125538057 block heights (about 120 years). +-- +minerRewards :: MinerRewardsTable +minerRewards = mkMinerRewards +{-# NOINLINE minerRewards #-} + +-- | Compute the miner rewards table. +-- +-- The indirection from 'minerReward' to 'mkMinerReward' is required because the +-- HasCallStack constraints prevents this value from being a CAF that gets +-- cached. +-- +mkMinerRewards :: HasCallStack => MinerRewardsTable +mkMinerRewards = + case CSV.decode CSV.NoHeader (BL.fromStrict rawMinerRewards) of + Left e -> error + $ "cannot construct miner rewards table: " <> sshow e + Right vs -> + let rewards = M.fromList . V.toList . V.map formatRow $ vs + in if minerRewardsHash rewards == expectedMinerRewardsHash + then rewards + else error $ "hash of miner rewards table does not match expected hash" + where + formatRow :: (Word64, CsvDecimal) -> (BlockHeight, Stu) + formatRow (a, b) = (BlockHeight $ int a, kdaToStu (Kda $ _csvDecimal b)) + +-- -------------------------------------------------------------------------- -- +-- Miner Rewards File + +-- | Read in the reward csv via TH for deployment purposes. +-- +-- Rewards are encoded in KDA with a precision of up to nine decimal digits. +-- +rawMinerRewards :: HasCallStack => B.ByteString +rawMinerRewards + | rawMinerRewardsHash rawBytes == expectedRawMinerRewardsHash = rawBytes + | otherwise = error "hash of raw miner rewards file does not match expected value." + where + rawBytes = $(embedFile "rewards/miner_rewards.csv") + +-- -------------------------------------------------------------------------- +-- Consistency Checks + +rawMinerRewardsHash :: B.ByteString -> Digest SHA512 +rawMinerRewardsHash = hash + +minerRewardsHash :: MinerRewardsTable -> Digest SHA512 +minerRewardsHash = hash + . runPutS + . traverse_ (\(k,v) -> encodeBlockHeight k >> putWord64le (fromIntegral v)) + . M.toAscList + +expectedMinerRewardsHash :: Digest SHA512 +expectedMinerRewardsHash = read "8e4fb006c5045b3baab638d16d62c952e4981a4ba473ec63620dfb54093d5104abd0be1a62ce52113575d598881fb57e84a41ec5c617e4348e270b9eacd300c9" + +expectedRawMinerRewardsHash :: Digest SHA512 +expectedRawMinerRewardsHash = read "903d10b06666c0d619c8a28c74c3bb0af47209002f005b12bbda7b7df1131b2072ce758c1a8148facb1506022215ea201629f38863feb285c7e66f5965498fe0" + diff --git a/src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs b/src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs index 38806cc8b2..5baec59759 100644 --- a/src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs +++ b/src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs @@ -26,7 +26,6 @@ module Chainweb.Pact.PactService.Pact4.ExecBlock ( execBlock , execTransactions , continueBlock - , minerReward , toPayloadWithOutputs , validateParsedChainwebTx , validateRawChainwebTx @@ -51,7 +50,6 @@ import Control.Monad.State.Strict import System.LogLevel (LogLevel(..)) import qualified Data.Aeson as A import qualified Data.ByteString.Short as SB -import Data.Decimal import Data.List qualified as List import Data.Either import Data.Foldable (toList) @@ -84,6 +82,7 @@ import Chainweb.BlockHeader import Chainweb.BlockHeight import Chainweb.Logger import Chainweb.Mempool.Mempool as Mempool +import Chainweb.MinerReward import Chainweb.Miner.Pact import Chainweb.Pact.Types @@ -408,13 +407,12 @@ runCoinbase miner enfCBFail usePrecomp mc = do then return noCoinbase else do logger <- view (psServiceEnv . psLogger) - rs <- view (psServiceEnv . psMinerRewards) v <- view chainwebVersion txCtx <- getTxContext miner Pact4.noPublicMeta let !bh = ctxCurrentBlockHeight txCtx - reward <- liftIO $! minerReward v rs bh + let reward = minerReward v bh dbEnv <- view psBlockDbEnv let pactDb = _cpPactDbEnv dbEnv @@ -591,31 +589,22 @@ debugResult msg result = limit = 5000 --- | Calculate miner reward. We want this to error hard in the case where --- block times have finally exceeded the 120-year range. Rewards are calculated --- at regular blockheight intervals. +-- | Calculate miner reward. -- -- See: 'rewards/miner_rewards.csv' -- minerReward :: ChainwebVersion - -> MinerRewards -> BlockHeight - -> IO Pact4.ParsedDecimal -minerReward v (MinerRewards rs) bh = - case Map.lookupGE bh rs of - Nothing -> err - Just (_, m) -> pure $! Pact4.ParsedDecimal (roundTo 8 (m / n)) - where - !n = int . order $ chainGraphAt v bh - err = internalError "block heights have been exhausted" + -> Pact4.ParsedDecimal +minerReward v = Pact4.ParsedDecimal + . _kda + . minerRewardKda + . blockMinerReward v {-# INLINE minerReward #-} - data CRLogPair = CRLogPair Pact4.Hash [Pact4.TxLogJson] - - instance J.Encode CRLogPair where build (CRLogPair h logs) = J.object [ "hash" J..= h diff --git a/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs b/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs index 93fe5a7224..7b9896addf 100644 --- a/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs +++ b/src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs @@ -26,6 +26,7 @@ import Chainweb.BlockHeader import Chainweb.BlockHeight import Chainweb.Logger import Chainweb.Mempool.Mempool(BlockFill (..), pact5RequestKeyToTransactionHash, InsertError (..)) +import Chainweb.MinerReward import Chainweb.Miner.Pact import Chainweb.Pact5.Backend.ChainwebPactDb (Pact5Db(doPact5DbTransaction)) import Chainweb.Pact5.SPV qualified as Pact5 @@ -53,13 +54,11 @@ import Data.Coerce import Data.Decimal import Data.Either (partitionEithers) import Data.Foldable -import Data.Map qualified as Map import Data.Maybe import Data.Text qualified as T import Data.Vector (Vector) import Data.Vector qualified as V import Data.Void -import Numeric.Natural import Pact.Core.ChainData hiding (ChainId) import Pact.Core.Command.Types qualified as Pact5 import Pact.Core.Persistence qualified as Pact5 @@ -97,16 +96,9 @@ import Chainweb.Pact.Backend.Types -- minerReward :: ChainwebVersion - -> MinerRewards -> BlockHeight - -> IO Decimal -minerReward v (MinerRewards rs) bh = - case Map.lookupGE bh rs of - Nothing -> err - Just (_, m) -> pure $! roundTo 8 (m / n) - where - !n = int @Natural @Decimal . order $ chainGraphAt v bh - err = internalError "block heights have been exhausted" + -> Decimal +minerReward v = _kda . minerRewardKda . blockMinerReward v {-# INLINE minerReward #-} runCoinbase @@ -119,13 +111,12 @@ runCoinbase miner = do then return $ Right noCoinbase else do logger <- view (psServiceEnv . psLogger) - rs <- view (psServiceEnv . psMinerRewards) v <- view chainwebVersion txCtx <- TxContext <$> view psParentHeader <*> pure miner let !bh = ctxCurrentBlockHeight txCtx + let reward = minerReward v bh - reward <- liftIO $ minerReward v rs bh -- the coinbase request key is not passed here because TransactionIndex -- does not contain coinbase transactions pactTransaction Nothing $ \db -> diff --git a/test/unit/Chainweb/Test/MinerReward.hs b/test/unit/Chainweb/Test/MinerReward.hs new file mode 100644 index 0000000000..b69d999637 --- /dev/null +++ b/test/unit/Chainweb/Test/MinerReward.hs @@ -0,0 +1,183 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE ImportQualifiedPost #-} +{-# LANGUAGE NumDecimals #-} +{-# LANGUAGE TypeApplications #-} + +{-# OPTIONS_GHC -Wno-orphans #-} + +-- | +-- Module: Chainweb.Test.MinerReward +-- Copyright: Copyright © 2024 Kadena LLC. +-- License: MIT +-- Maintainer: Lars Kuhtz +-- Stability: experimental +-- +module Chainweb.Test.MinerReward +( tests +) where + +import Chainweb.BlockHeight +import Chainweb.MinerReward +import Chainweb.Test.Orphans.Internal () +import Chainweb.Utils +import Chainweb.Version +import Chainweb.Version.Mainnet + +import Data.ByteString.Lazy qualified as BL +import Data.Csv qualified as CSV +import Data.Decimal +import Data.Map.Strict qualified as M +import Data.Vector qualified as V +import Data.Word + +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +instance Arbitrary Stu where + arbitrary = Stu <$> arbitrary + +instance Arbitrary Kda where + arbitrary = fmap Kda $ Decimal <$> choose (0,12) <*> arbitrary + +newtype PositiveKda = PositiveKda { _positive :: Kda } + deriving (Show, Eq, Ord) + +instance Arbitrary PositiveKda where + arbitrary = fmap (PositiveKda . Kda) $ Decimal + <$> choose (0,12) + <*> (getNonNegative <$> arbitrary) + +tests :: TestTree +tests = testGroup "MinerReward" + [ testProperty "kdaToStuToKda" prop_kdaToStuToKda + , testProperty "stuToKdaToStu" prop_stuToKdaToStu + , testCase "finalReward" test_finalMinerReward + , testCase "minerRewardsMax" test_minerRewardsMax + , testCase "minerRewardsFitWord64" test_minerRewardsFitWord64 + , testCase "expectedMinerRewardsHash" test_expectedMinerRewardsHash + , testCase "expectedRawMinerRewardsHash" test_expectedRawMinerRewardsHash + , testCase "assert blockMinerRewardLegacyCompact" test_blockMinerRewardLegacyCompat + , testProperty "blockMinerRewardLegacyCompat" prop_blockMinerRewardLegacyCompat + ] + +-- -------------------------------------------------------------------------- +-- Properties and Assertions + +maxRewardHeight :: BlockHeight +maxRewardHeight = 125538057 + +prop_kdaToStuToKda :: PositiveKda -> Property +prop_kdaToStuToKda (PositiveKda kda) = stuToKda (kdaToStu kda) === kda + +prop_stuToKdaToStu :: Stu -> Property +prop_stuToKdaToStu stu = kdaToStu (stuToKda stu) === stu + +prop_blockMinerRewardLegacyCompat :: BlockHeight -> Property +prop_blockMinerRewardLegacyCompat h + | h < maxRewardHeight - 2 = + legacyBlockMinerReward v h === minerRewardKda (blockMinerReward v h) + | h == maxRewardHeight - 1 = + legacyBlockMinerReward v h =/= minerRewardKda (blockMinerReward v h) + | h == maxRewardHeight = + legacyBlockMinerReward v h === minerRewardKda (blockMinerReward v h) + | otherwise = expectFailure + -- legacyMinerRewards is expected to throw an exception + $ legacyBlockMinerReward v h === minerRewardKda (blockMinerReward v h) + + where + v = Mainnet01 + +-- 2.304523 +-- +test_finalMinerReward :: Assertion +test_finalMinerReward = do + mapM_ rewardIsZero $ take 100 [maxRewardHeight..] + mapM_ rewardIsZero $ take 10 [maxRewardHeight, (maxRewardHeight + 1000)..] + where + rewardIsZero h = assertEqual + "The final miner reward is 0" + (Kda 0) + (minerRewardKda (blockMinerReward Mainnet01 h)) + +test_minerRewardsMax :: Assertion +test_minerRewardsMax = assertBool + "maximum miner reward is smaller than 1e12 * 24" + (_stu (maximum minerRewards) < 1e12 * 24) + +test_minerRewardsFitWord64 :: Assertion +test_minerRewardsFitWord64 = assertBool + "maximum miner reward fits into Word64" + (_stu (maximum minerRewards) <= fromIntegral (maxBound @Word64)) + +test_expectedMinerRewardsHash :: Assertion +test_expectedMinerRewardsHash = assertEqual + "expected miner rewards hash" + expectedMinerRewardsHash + (minerRewardsHash minerRewards) + +test_expectedRawMinerRewardsHash :: Assertion +test_expectedRawMinerRewardsHash = assertEqual + "expected raw miner rewards hash" + expectedRawMinerRewardsHash + (rawMinerRewardsHash rawMinerRewards) + +-- -------------------------------------------------------------------------- +-- Backward compatibility with legacy implementation + +-- | Miner rewards are expected to match the legacy values execpt for +-- +-- - block height 125538056 and +-- - block heights strictly larger than 125538057 +-- +test_blockMinerRewardLegacyCompat :: Assertion +test_blockMinerRewardLegacyCompat = do + mapM_ rewardsMatch [0..10000] + mapM_ rewardsMatch [0,1000..maxRewardHeight - 2] + mapM_ rewardsMatch [maxRewardHeight - 1000 .. maxRewardHeight - 2] + mapM_ rewardsMatch [maxRewardHeight] + assertEqual + "the only block height that is not compatible with the legacy reward computation is 125538056" + [maxRewardHeight - 1] + legacyCompatExceptions + where + v = Mainnet01 + rewardsMatch h = assertEqual + "miner reward value matches the legacy value" + (legacyBlockMinerReward v h) + (minerRewardKda (blockMinerReward v h)) + + legacyCompatExceptions = M.keys $ M.filterWithKey + (\k _ -> legacyBlockMinerReward v k /= minerRewardKda (blockMinerReward v k)) + minerRewards + +-- This should be a CAF and can thus not include the computation in +-- 'mkLegacyMinerRewards' which has a 'HasCallStack' constraint. +-- +legacyMinerRewards :: M.Map BlockHeight Kda +legacyMinerRewards = Kda <$> mkLegacyMinerRewards +{-# NOINLINE legacyMinerRewards #-} + +-- | The algorithm that was used to parse the rewards table until end of 2024. +-- +mkLegacyMinerRewards :: HasCallStack => M.Map BlockHeight Decimal +mkLegacyMinerRewards = + case CSV.decode CSV.NoHeader (BL.fromStrict rawMinerRewards) of + Left e -> error + $ "cannot construct miner reward map: " <> sshow e + Right vs -> M.fromList . V.toList . V.map formatRow $ vs + where + formatRow :: (Word64, CsvDecimal) -> (BlockHeight, Decimal) + formatRow (!a,!b) = (BlockHeight $ int a, (_csvDecimal b)) + +legacyBlockMinerReward + :: ChainwebVersion + -> BlockHeight + -> Kda +legacyBlockMinerReward v h = + case M.lookupGE h legacyMinerRewards of + Nothing -> error "The end of the chain has been reached" + Just (_, m) -> Kda $ roundTo 8 (_kda m / n) + where + !n = int . order $ chainGraphAt v h + diff --git a/test/unit/Chainweb/Test/Pact4/RewardsTest.hs b/test/unit/Chainweb/Test/Pact4/RewardsTest.hs index 04e9d74791..ad8037200e 100644 --- a/test/unit/Chainweb/Test/Pact4/RewardsTest.hs +++ b/test/unit/Chainweb/Test/Pact4/RewardsTest.hs @@ -1,4 +1,3 @@ -{-# LANGUAGE RankNTypes #-} module Chainweb.Test.Pact4.RewardsTest ( tests @@ -8,11 +7,8 @@ module Chainweb.Test.Pact4.RewardsTest import Test.Tasty import Test.Tasty.HUnit -import Pact.Parse - import Chainweb.Graph -import Chainweb.Miner.Pact -import Chainweb.Pact.PactService.Pact4.ExecBlock +import Chainweb.MinerReward import Chainweb.Test.TestVersions import Chainweb.Version @@ -26,21 +22,19 @@ tests = testGroup "Chainweb.Test.Pact4.RewardsTest" ] ] - rewardsTest :: HasCallStack => TestTree rewardsTest = testCaseSteps "rewards" $ \step -> do - let rs = readRewards - k = minerReward v rs + let k = _kda . minerRewardKda . blockMinerReward v step "block heights below initial threshold" - ParsedDecimal a <- k 0 + let a = k 0 assertEqual "initial miner reward is 2.304523" 2.304523 a step "block heights at threshold" - ParsedDecimal b <- k 87600 + let b = k 87600 assertEqual "max threshold miner reward is 2.304523" 2.304523 b step "block heights exceeding thresholds change" - ParsedDecimal c <- k 87601 + let c = k 87601 assertEqual "max threshold miner reward is 2.297878" 2.297878 c diff --git a/test/unit/ChainwebTests.hs b/test/unit/ChainwebTests.hs index 4eed5ccbf1..1a6bebb132 100644 --- a/test/unit/ChainwebTests.hs +++ b/test/unit/ChainwebTests.hs @@ -54,6 +54,7 @@ import qualified Chainweb.Test.Mempool.Consensus (tests) import qualified Chainweb.Test.Mempool.InMem (tests) import qualified Chainweb.Test.Mempool.RestAPI (tests) import qualified Chainweb.Test.Mempool.Sync (tests) +import qualified Chainweb.Test.MinerReward (tests) import qualified Chainweb.Test.Mining (tests) import qualified Chainweb.Test.Misc (tests) import qualified Chainweb.Test.Pact4.Checkpointer (tests) @@ -176,6 +177,7 @@ suite rdb = , Chainweb.Test.Mempool.Sync.tests , Chainweb.Test.Mempool.RestAPI.tests , Chainweb.Test.Mining.tests rdb + , Chainweb.Test.MinerReward.tests , Chainweb.Test.Misc.tests , Chainweb.Test.BlockHeader.Genesis.tests , Chainweb.Test.BlockHeader.Validation.tests