miscellaneous small changes

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

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

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

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

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

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

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
 -- -------------------------------------------------------------------------- --

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

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
+signed = fromIntegral

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.

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)

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"