stop exporting constructors for BlockHeader and PayloadData

bench/Chainweb/Pact/Backend/Bench.hs

@@ -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
@@ -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
@@ -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" $

bench/Chainweb/Pact/Backend/ForkingBench.hs

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

chainweb.cabal

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

node/ChainwebNode.hs

@@ -251,10 +251,10 @@ 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
+        return $ length $ view payloadDataTransactions bp
 
     toUpdate :: Either BlockHeader BlockHeader -> IO BlockUpdate
     toUpdate (Right bh) = BlockUpdate