miner rewards

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

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 <[email protected]>
+-- 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
+-- twelf 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"
+

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