Skip to content

Commit

Permalink
stop exporting BlockHeader constructor from Chainweb.BlockHeader
Browse files Browse the repository at this point in the history
Change-Id: Id6200af01359d9012ea532a485ac25d2ab36d0c5
  • Loading branch information
chessai committed Jul 2, 2024
1 parent f258a70 commit cb1b4c1
Show file tree
Hide file tree
Showing 66 changed files with 1,785 additions and 1,634 deletions.
16 changes: 10 additions & 6 deletions bench/Chainweb/Pact/Backend/Bench.hs
Original file line number Diff line number Diff line change
Expand Up @@ -14,9 +14,11 @@ module Chainweb.Pact.Backend.Bench


import Control.Concurrent
import Control.Lens (view, (.~))
import Control.Monad
import Control.Monad.Catch
import qualified Criterion.Main as C
import Data.Function ((&))

import qualified Data.Vector as V
import qualified Data.ByteString as B
Expand Down Expand Up @@ -46,7 +48,7 @@ import qualified Pact.Types.SQLite as PSQL
-- chainweb imports

import Chainweb.BlockHash
import Chainweb.BlockHeader
import Chainweb.BlockHeader.Internal
import Chainweb.Graph
import Chainweb.Logger
import Chainweb.MerkleLogHash
Expand Down Expand Up @@ -78,11 +80,13 @@ cpRestoreAndSave cp pc blks = snd <$> _cpRestoreAndSave cp (ParentHeader <$> pc)

-- | fabricate a `BlockHeader` for a block given its hash and its parent.
childOf :: Maybe BlockHeader -> BlockHash -> BlockHeader
childOf (Just bh) bhsh =
bh { _blockHash = bhsh, _blockParent = _blockHash bh, _blockHeight = _blockHeight bh + 1 }
childOf Nothing bhsh =
(genesisBlockHeader testVer testChainId) { _blockHash = bhsh }

childOf m bhsh = case m of
Just bh -> bh
& blockHash .~ bhsh
& blockParent .~ view blockHash bh
& blockHeight .~ view blockHeight bh + 1
Nothing -> genesisBlockHeader testVer testChainId
& blockHash .~ bhsh

bench :: C.Benchmark
bench = C.bgroup "pact-backend" $
Expand Down
8 changes: 4 additions & 4 deletions bench/Chainweb/Pact/Backend/ForkingBench.hs
Original file line number Diff line number Diff line change
Expand Up @@ -207,7 +207,7 @@ playLine pdb bhdb trunkLength startingBlock pactQueue counter = do
evalStateT (runReaderT (mapM (const go) [startHeight :: Word64 .. pred (startHeight + l)]) pactQueue) start
where
startHeight :: Num a => a
startHeight = fromIntegral $ _blockHeight start
startHeight = fromIntegral $ view blockHeight start
go = do
r <- ask
pblock <- gets ParentHeader
Expand All @@ -226,7 +226,7 @@ mineBlock
-> IO (T3 ParentHeader BlockHeader PayloadWithOutputs)
mineBlock parent nonce pdb bhdb pact = do
r@(T3 _ newHeader payload) <- createBlock DoValidate parent nonce pact
addNewPayload pdb (succ (_blockHeight (_parentHeader parent))) payload
addNewPayload pdb (succ (view blockHeight (_parentHeader parent))) payload
-- NOTE: this doesn't validate the block header, which is fine in this test case
unsafeInsertBlockHeaderDb bhdb newHeader
return r
Expand All @@ -244,7 +244,7 @@ createBlock validate parent nonce pact = do
bip <- throwIfNoHistory =<< newBlock noMiner NewBlockFill parent pact
let payload = blockInProgressToPayloadWithOutputs bip

let creationTime = add second $ _blockCreationTime $ _parentHeader parent
let creationTime = add second $ view blockCreationTime $ _parentHeader parent
let bh = newBlockHeader
mempty
(_payloadWithOutputsPayloadHash payload)
Expand Down Expand Up @@ -368,7 +368,7 @@ testMemPoolAccess txsPerBlock accounts = do
return $ mempty
{ mpaGetBlock = \bf validate bh hash header -> do
if _bfCount bf /= 0 then pure mempty else do
testBlock <- getTestBlock accounts (_bct $ _blockCreationTime header) validate bh hash
testBlock <- getTestBlock accounts (_bct $ view blockCreationTime header) validate bh hash
pure testBlock
}
where
Expand Down
1 change: 1 addition & 0 deletions chainweb.cabal
Original file line number Diff line number Diff line change
Expand Up @@ -136,6 +136,7 @@ library
, Chainweb.BlockCreationTime
, Chainweb.BlockHash
, Chainweb.BlockHeader
, Chainweb.BlockHeader.Internal
, Chainweb.BlockHeader.Genesis.RecapDevelopment0Payload
, Chainweb.BlockHeader.Genesis.RecapDevelopment1to9Payload
, Chainweb.BlockHeader.Genesis.RecapDevelopment10to19Payload
Expand Down
2 changes: 1 addition & 1 deletion node/ChainwebNode.hs
Original file line number Diff line number Diff line change
Expand Up @@ -251,7 +251,7 @@ runBlockUpdateMonitor logger db = L.withLoggerLabel ("component", "block-update-

txCount :: BlockHeader -> IO Int
txCount bh = do
bp <- lookupPayloadDataWithHeight payloadDb (Just $ _blockHeight bh) (_blockPayloadHash bh) >>= \case
bp <- lookupPayloadDataWithHeight payloadDb (Just $ view blockHeight bh) (view blockPayloadHash bh) >>= \case
Nothing -> error "block payload not found"
Just x -> return x
return $ length $ _payloadDataTransactions bp
Expand Down
Loading

0 comments on commit cb1b4c1

Please sign in to comment.