diff --git a/src/Chainweb/BlockHeader.hs b/src/Chainweb/BlockHeader.hs index 9b3821d7d2..81b56772ba 100644 --- a/src/Chainweb/BlockHeader.hs +++ b/src/Chainweb/BlockHeader.hs @@ -13,6 +13,9 @@ module Chainweb.BlockHeader -- * Newtype wrappers for function parameters I.ParentHeader(..) , I.parentHeader +, I.parentHeaderHash +, I._rankedParentHash +, I.rankedParentHash , I.ParentCreationTime(..) -- * Block Payload Hash diff --git a/src/Chainweb/BlockHeader/Internal.hs b/src/Chainweb/BlockHeader/Internal.hs index 30f5dbbb16..f1583b6bf5 100644 --- a/src/Chainweb/BlockHeader/Internal.hs +++ b/src/Chainweb/BlockHeader/Internal.hs @@ -44,6 +44,9 @@ module Chainweb.BlockHeader.Internal -- * Newtype wrappers for function parameters ParentHeader(..) , parentHeader +, parentHeaderHash +, _rankedParentHash +, rankedParentHash , ParentCreationTime(..) -- * Block Payload Hash @@ -578,7 +581,7 @@ epochStart ph@(ParentHeader p) adj (BlockCreationTime bt) -- = \frac{sum_{0 \leq i < n} (a_i - t)}{n} -- \) -- - -- this is numberically sound because we compute the differences on integral + -- this is numerically sound because we compute the differences on integral -- types without rounding. -- -- Properties of DA: @@ -623,6 +626,15 @@ newtype ParentHeader = ParentHeader parentHeader :: Lens' ParentHeader BlockHeader parentHeader = lens _parentHeader $ \_ hdr -> ParentHeader hdr +parentHeaderHash :: Getter ParentHeader BlockHash +parentHeaderHash = parentHeader . blockHash + +_rankedParentHash :: ParentHeader -> RankedBlockHash +_rankedParentHash = _rankedBlockHash . _parentHeader + +rankedParentHash :: Getter ParentHeader RankedBlockHash +rankedParentHash = parentHeader . rankedBlockHash + instance HasChainId ParentHeader where _chainId = _chainId . _parentHeader {-# INLINE _chainId #-} @@ -1072,7 +1084,8 @@ instance IsBlockHeader BlockHeader where -- newBlockHeader :: HM.HashMap ChainId ParentHeader - -- ^ Adjacent parent hashes. + -- ^ Adjacent parent hashes. The hash and the PoW target of these are + -- needed for construction the new header. -> BlockPayloadHash -- ^ payload hash -> Nonce diff --git a/src/Chainweb/ChainId.hs b/src/Chainweb/ChainId.hs index e42814bb44..4c63a3f76f 100644 --- a/src/Chainweb/ChainId.hs +++ b/src/Chainweb/ChainId.hs @@ -307,9 +307,9 @@ instance FromJSON a => FromJSON (ChainMap a) where makePrisms ''ChainMap -- | Provides access to the value at a `ChainId`, if it exists. -atChain :: ChainId -> Fold (ChainMap a) a +atChain :: HasChainId cid => cid -> Fold (ChainMap a) a atChain cid = folding $ \case - OnChains m -> m ^. at cid + OnChains m -> m ^. at (_chainId cid) AllChains a -> Just a type instance Index (ChainMap a) = ChainId diff --git a/src/Chainweb/Chainweb.hs b/src/Chainweb/Chainweb.hs index 0dc8cdc7ef..9eb897b07a 100644 --- a/src/Chainweb/Chainweb.hs +++ b/src/Chainweb/Chainweb.hs @@ -422,12 +422,12 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re x ) - -- initialize global resources after all chain resources are initialized - (\cs -> do - logg Debug "finished initializing chain resources" - global (HM.fromList $ zip cidsList cs) - ) - cidsList + -- initialize global resources after all chain resources are initialized + (\cs -> do + logg Debug "finished initializing chain resources" + global (HM.fromList $ zip cidsList cs) + ) + cidsList where pactConfig maxGasLimit = PactServiceConfig { _pactReorgLimit = _configReorgLimit conf diff --git a/src/Chainweb/Crypto/MerkleLog.hs b/src/Chainweb/Crypto/MerkleLog.hs index 64c18df8ba..ea160f0b80 100644 --- a/src/Chainweb/Crypto/MerkleLog.hs +++ b/src/Chainweb/Crypto/MerkleLog.hs @@ -491,7 +491,7 @@ toMerkleNodeTagged b = case toMerkleNode @a @u @b b of tag :: Word16 tag = tagVal @u @(Tag b) --- | /Internal:/ Decode Merkle nodes that are tagged with the respedtive type +-- | /Internal:/ Decode Merkle nodes that are tagged with the respective type -- from the Merkle universe. -- fromMerkleNodeTagged diff --git a/src/Chainweb/MerkleUniverse.hs b/src/Chainweb/MerkleUniverse.hs index 1800526b7d..7e39d84866 100644 --- a/src/Chainweb/MerkleUniverse.hs +++ b/src/Chainweb/MerkleUniverse.hs @@ -58,6 +58,18 @@ type ChainwebMerkleHashAlgorithm = SHA512t_256 -- -------------------------------------------------------------------------- -- -- Chainweb Merkle Universe +-- | Tags for Leaf Nodes in the Chainweb Merkle Tree +-- +-- IMPORTANT NOTE: +-- +-- A tag MUST uniquely identify the each particular use of a type in the Merkle +-- Tree. NEVER EVER reuse a tag at a different place in the tree. +-- +-- Merkle Proofs for the Chainweb Merkle tree witness the existence of a given +-- tagged value anywhere in the tree. If the same tagged value is used in +-- in different roles in multiple places in the tree, the proof will be +-- ambiguous. +-- data ChainwebHashTag = VoidTag | MerkleRootTag diff --git a/src/Chainweb/MinerReward.hs b/src/Chainweb/MinerReward.hs index ec867a08d1..1cc41a2df1 100644 --- a/src/Chainweb/MinerReward.hs +++ b/src/Chainweb/MinerReward.hs @@ -7,6 +7,9 @@ {-# LANGUAGE NumDecimals #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DerivingVia #-} +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE DataKinds #-} -- | -- Module: Chainweb.MinerReward @@ -37,6 +40,8 @@ module Chainweb.MinerReward , MinerReward(..) , minerRewardKda , blockMinerReward +, encodeMinerReward +, decodeMinerReward -- * Internal -- ** Miner Rewards Table @@ -144,8 +149,19 @@ kdaToStu (Kda { _kda = s }) = Stu $ round (s * 1e12) -- | Miner Reward in Stu -- +-- The maximum miner reward is 23045230000000, which is smaller than 2^51-1. +-- Miner rewards can thus be represented losslessly as JSON numbers. +-- newtype MinerReward = MinerReward { _minerReward :: Stu } deriving (Show, Eq, Ord, Generic) + deriving (ToJSON, FromJSON) via JsonTextRepresentation "MinerReward" MinerReward + +instance HasTextRepresentation MinerReward where + toText (MinerReward (Stu n)) = toText n + fromText t = MinerReward . Stu <$> fromText t + {-# INLINE toText #-} + {-# INLINE fromText #-} + minerRewardKda :: MinerReward -> Kda minerRewardKda (MinerReward d) = stuToKda d @@ -169,6 +185,20 @@ blockMinerReward v h = case M.lookupGE h minerRewards of where !n = int . order $ chainGraphAt v h +-- | Binary encoding of mining rewards as unsigned integral number in little +-- endian encoding. +-- +-- The maximum miner reward is 23045230000000. The miner reward can therefore be +-- encoded in as Word64 value. +-- +encodeMinerReward :: MinerReward -> Put +encodeMinerReward (MinerReward (Stu n)) = putWord64le (int n) +{-# INLINE encodeMinerReward #-} + +decodeMinerReward :: Get MinerReward +decodeMinerReward = MinerReward . int <$> getWord64le +{-# INLINE decodeMinerReward #-} + -- -------------------------------------------------------------------------- -- -- Internal -- -------------------------------------------------------------------------- -- diff --git a/src/Chainweb/Pact/Types.hs b/src/Chainweb/Pact/Types.hs index b3bacc5077..aba336b3e5 100644 --- a/src/Chainweb/Pact/Types.hs +++ b/src/Chainweb/Pact/Types.hs @@ -1051,6 +1051,7 @@ data BlockInProgress pv = BlockInProgress , _blockInProgressTransactions :: !(Transactions pv (CommandResultFor pv)) , _blockInProgressPactVersion :: !(PactVersionT pv) } + instance Eq (BlockInProgress pv) where bip == bip' = case (_blockInProgressPactVersion bip, _blockInProgressPactVersion bip') of @@ -1069,6 +1070,14 @@ instance Eq (BlockInProgress pv) where _blockInProgressMiner bip == _blockInProgressMiner bip' && _blockInProgressTransactions bip == _blockInProgressTransactions bip' +instance HasChainwebVersion (BlockInProgress pv) where + _chainwebVersion = _blockInProgressChainwebVersion + {-# INLINE _chainwebVersion #-} + +instance HasChainId (BlockInProgress pv) where + _chainId = _blockInProgressChainId + {-# INLINE _chainId #-} + blockInProgressParent :: BlockInProgress pv -> (BlockHash, BlockHeight, BlockCreationTime) blockInProgressParent bip = maybe diff --git a/src/Chainweb/Utils/Serialization.hs b/src/Chainweb/Utils/Serialization.hs index 583708fa8e..d43900ff1d 100644 --- a/src/Chainweb/Utils/Serialization.hs +++ b/src/Chainweb/Utils/Serialization.hs @@ -36,7 +36,9 @@ module Chainweb.Utils.Serialization , putWord256be , getWord256be , putByteString + , putShortByteString , getByteString + , getShortByteString , putRawByteString , getRemainingLazyByteString @@ -56,6 +58,7 @@ import Control.Monad import Control.Monad.Catch hiding (bracket) import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as BL +import qualified Data.ByteString.Short as BS import Data.Coerce import Data.DoubleWord (Word128(..), Word256(..)) import Data.Int @@ -152,8 +155,12 @@ getWord64be :: Get Word64 getWord64be = coerce Binary.getWord64be getByteString :: Int -> Get B.ByteString getByteString = coerce Binary.getByteString +getShortByteString :: Int -> Get BS.ShortByteString +getShortByteString = fmap BS.toShort . coerce Binary.getByteString putByteString :: B.ByteString -> Put putByteString = coerce Binary.putByteString +putShortByteString :: BS.ShortByteString -> Put +putShortByteString = coerce Binary.putShortByteString putWord128be :: Word128 -> Put putWord128be = encodeWordBe @@ -268,4 +275,4 @@ type instance Signed Word32 = Int32 type instance Signed Word64 = Int64 signed :: (Integral i, Num (Signed i)) => i -> Signed i -signed = fromIntegral \ No newline at end of file +signed = fromIntegral diff --git a/src/Chainweb/WebPactExecutionService.hs b/src/Chainweb/WebPactExecutionService.hs index 7fc3cc14f4..0e689c1775 100644 --- a/src/Chainweb/WebPactExecutionService.hs +++ b/src/Chainweb/WebPactExecutionService.hs @@ -72,6 +72,14 @@ newBlockParent (NewBlockInProgress (ForSomePactVersion _ bip)) = blockInProgress newBlockParent (NewBlockPayload (ParentHeader ph) _) = (view blockHash ph, view blockHeight ph, view blockCreationTime ph) +instance HasChainwebVersion NewBlock where + _chainwebVersion (NewBlockInProgress (ForSomePactVersion _ bip)) = _chainwebVersion bip + _chainwebVersion (NewBlockPayload ph _) = _chainwebVersion ph + +instance HasChainId NewBlock where + _chainId (NewBlockInProgress (ForSomePactVersion _ bip)) = _chainId bip + _chainId (NewBlockPayload ph _) = _chainId ph + -- | Service API for interacting with a single or multi-chain ("Web") pact service. -- Thread-safe to be called from multiple threads. Backend is queue-backed on a per-chain -- basis. diff --git a/src/Data/PQueue.hs b/src/Data/PQueue.hs index baa71d34af..43da59d2da 100644 --- a/src/Data/PQueue.hs +++ b/src/Data/PQueue.hs @@ -37,7 +37,7 @@ import Numeric.Natural -- -- The queue is fair for users of the queue. It does not guarantee progress for -- items in the queue. An item of low priority my starve in the queue if higher --- priority items are added a rate at least as high as items are removed. +-- priority items are added at a rate at least as high as items are removed. -- data PQueue a = PQueue !(MVar ()) !(MVar (H.Heap a)) deriving (Generic) diff --git a/src/P2P/TaskQueue.hs b/src/P2P/TaskQueue.hs index 0cb6392e4e..d7ad02dae4 100644 --- a/src/P2P/TaskQueue.hs +++ b/src/P2P/TaskQueue.hs @@ -23,7 +23,7 @@ -- logging facility, and an limit on the number of attempts in case of failure. -- The completion of a task can be awaited. -- --- This module alos provides a P2P session that listens on the queue and runs +-- This module also provides a P2P session that listens on the queue and runs -- tasks with peers from the P2P network. -- module P2P.TaskQueue @@ -167,7 +167,7 @@ session_ session_ limit q logFun env = E.mask $ \restore -> do task <- pQueueRemove q - -- check if the result variable as already been filled + -- check if the result variable has already been filled let go = tryReadIVar (_taskResult task) >>= \case Nothing -> do logg task Debug "run task"