-
Notifications
You must be signed in to change notification settings - Fork 95
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
- Loading branch information
Showing
7 changed files
with
455 additions
and
43 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -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 <lars@kadena.io> | ||
| -- 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" | ||
|
|
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Oops, something went wrong.