stop exporting PayloadData constructor from Chainweb.Payload

Co-authored-by: Emmanuel Denloye-Ito <[email protected]>
Change-Id: I5d50e6a283dfebb630e4cea84bcb8598117e4c89

node/ChainwebNode.hs

@@ -254,7 +254,7 @@ runBlockUpdateMonitor logger db = L.withLoggerLabel ("component", "block-update-
         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

src/Chainweb/BlockHeader.hs

@@ -1,5 +1,13 @@
 {-# LANGUAGE ImportQualifiedPost #-}
 
+-- Use this module to get read-only access to a 'BlockHeader' via 'Getter's.
+--
+-- Editing or manually constructing 'BlockHeader's outside of tests is dangerous
+-- and likely to result in invalid headers, whether through invalid block hashes
+-- or invalid adjacent hash records.
+--
+-- If you need to manually construct or overwrite a BlockHeader record or
+-- 'Setter', again only in tests, use 'Chainweb.BlockHeader.Internal' instead.
 module Chainweb.BlockHeader
 (
 -- * Newtype wrappers for function parameters

src/Chainweb/BlockHeader/Internal.hs

@@ -26,11 +26,19 @@
 
 -- |
 -- Module: Chainweb.BlockHeader
--- Copyright: Copyright © 2018 Kadena LLC.
+-- Copyright: Copyright © 2024 Kadena LLC.
 -- License: MIT
 -- Maintainer: Lars Kuhtz <[email protected]>
 -- Stability: experimental
 --
+-- This module contains the implementation of a 'BlockHeader', and provides
+-- read (via record and 'Getter') and write (via record and 'Setter') access to
+-- them. Editing or manually constructing 'BlockHeader's outside of tests is dangerous
+-- and likely to result in invalid headers, whether through invalid block hashes
+-- or invalid adjacent hash records.
+
+-- You should prefer using 'Chainweb.BlockHeader' over this module, unless you
+-- are writing tests.
 module Chainweb.BlockHeader.Internal
 (
 -- * Newtype wrappers for function parameters

src/Chainweb/Mempool/Consensus.hs

@@ -187,7 +187,7 @@ chainwebTxsFromPd
     -> PayloadData
     -> IO (HashSet (HashableTrans PayloadWithText))
 chainwebTxsFromPd ppv pd = do
-    let transSeq = _payloadDataTransactions pd
+    let transSeq = view payloadDataTransactions pd
     let bytes = _transactionBytes <$> transSeq
     let eithers = toCWTransaction <$> bytes
     -- Note: if any transactions fail to convert, the final validation hash will fail to match

src/Chainweb/Pact/PactService.hs

@@ -824,7 +824,7 @@ execReadOnlyReplay lowerBound maybeUpperBound = pactLabel "execReadOnlyReplay" $
                     liftIO $ writeIORef heightRef (view blockHeight bh)
                     payload <- liftIO $ fromJuste <$>
                       lookupPayloadDataWithHeight pdb (Just $ view blockHeight bh) (view blockPayloadHash bh)
-                    let isPayloadEmpty = V.null (_payloadDataTransactions payload)
+                    let isPayloadEmpty = V.null (view payloadDataTransactions payload)
                     let isUpgradeBlock = isJust $ _chainwebVersion bhdb ^? versionUpgrades . onChain (_chainId bhdb) . ix (view blockHeight bh)
                     unless (isPayloadEmpty && not isUpgradeBlock) $
                       void $ execBlock bh (CheckablePayload payload)

src/Chainweb/Pact/PactService/ExecBlock.hs

@@ -108,7 +108,7 @@ execBlock
 execBlock currHeader payload = do
     let plData = checkablePayloadToPayloadData payload
     dbEnv <- view psBlockDbEnv
-    miner <- decodeStrictOrThrow' (_minerData $ _payloadDataMiner plData)
+    miner <- decodeStrictOrThrow' (_minerData $ view payloadDataMiner plData)
     trans <- liftIO $ transactionsFromPayload
       (pactParserVersion v (view blockChainId currHeader) (view blockHeight currHeader))
       plData
@@ -500,7 +500,7 @@ transactionsFromPayload
 transactionsFromPayload ppv plData = do
     vtrans <- fmap V.fromList $
               mapM toCWTransaction $
-              toList (_payloadDataTransactions plData)
+              toList (view payloadDataTransactions plData)
     let (theLefts, theRights) = partitionEithers $ V.toList vtrans
     unless (null theLefts) $ do
         let ls = map T.pack theLefts
@@ -595,24 +595,24 @@ validateHashes bHeader payload miner transactions =
         CheckablePayload pData -> J.Array $ catMaybes
             [ check "Miner"
                 []
-                (_payloadDataMiner pData)
+                (view payloadDataMiner pData)
                 (_payloadWithOutputsMiner pwo)
             , check "TransactionsHash"
                 [ "txs" J..?=
                     (J.Array <$> traverse (uncurry $ check "Tx" []) (zip
                       (toList $ fst <$> _payloadWithOutputsTransactions pwo)
-                      (toList $ _payloadDataTransactions pData)
+                      (toList $ view payloadDataTransactions pData)
                     ))
                 ]
-                (_payloadDataTransactionsHash pData)
+                (view payloadDataTransactionsHash pData)
                 (_payloadWithOutputsTransactionsHash pwo)
             , check "OutputsHash"
                 [ "outputs" J..= J.object
                     [ "coinbase" J..= toPairCR (_transactionCoinbase transactions)
                     , "txs" J..= J.array (addTxOuts <$> _transactionPairs transactions)
                     ]
                 ]
-                (_payloadDataOutputsHash pData)
+                (view payloadDataOutputsHash pData)
                 (_payloadWithOutputsOutputsHash pwo)
             ]
 

src/Chainweb/Payload.hs

@@ -115,12 +115,18 @@ module Chainweb.Payload
 
 -- * API Payload Data
 , PayloadData
-, PayloadData_(..)
+, PayloadData_
 , payloadData
 , newPayloadData
 , payloadDataToBlockPayload
 , PayloadDataCas
 , verifyPayloadData
+-- * Payload Data Lenses
+, payloadDataTransactions
+, payloadDataMiner
+, payloadDataPayloadHash
+, payloadDataTransactionsHash
+, payloadDataOutputsHash
 
 -- * All Payload Data in a Single Structure
 , PayloadWithOutputs
@@ -136,6 +142,7 @@ module Chainweb.Payload
 ) where
 
 import Control.DeepSeq
+import Control.Lens (Getter, to)
 import Control.Monad
 import Control.Monad.Catch
 
@@ -151,7 +158,7 @@ import qualified Data.Text as T
 import qualified Data.Vector as V
 import Data.Void
 
-import GHC.Generics
+import GHC.Generics (Generic)
 import GHC.Stack
 
 -- internal modules
@@ -737,7 +744,7 @@ decodePayloadDataList = runGetS $ do
 encodePayloadWithOutputsList :: PayloadWithOutputsList -> B.ByteString
 encodePayloadWithOutputsList (PayloadWithOutputsList xs) = runPutS $ do
     putWord64be (fromIntegral $ length xs)
-    forM_ xs putPayloadWithOutputs 
+    forM_ xs putPayloadWithOutputs
 
 decodePayloadWithOutputsList :: (MonadThrow m) => B.ByteString -> m PayloadWithOutputsList
 decodePayloadWithOutputsList = runGetS $ do
@@ -1199,6 +1206,21 @@ data PayloadData_ a = PayloadData
     deriving (Eq, Show, Generic)
     deriving anyclass (NFData)
 
+payloadDataTransactions :: Getter (PayloadData_ a) (V.Vector Transaction)
+payloadDataTransactions = to _payloadDataTransactions
+
+payloadDataMiner :: Getter (PayloadData_ a) MinerData
+payloadDataMiner = to _payloadDataMiner
+
+payloadDataPayloadHash :: Getter (PayloadData_ a) (BlockPayloadHash_ a)
+payloadDataPayloadHash = to _payloadDataPayloadHash
+
+payloadDataTransactionsHash :: Getter (PayloadData_ a) (BlockTransactionsHash_ a)
+payloadDataTransactionsHash = to _payloadDataTransactionsHash
+
+payloadDataOutputsHash :: Getter (PayloadData_ a) (BlockOutputsHash_ a)
+payloadDataOutputsHash = to _payloadDataOutputsHash
+
 payloadDataProperties
     :: MerkleHashAlgorithm a
     => A.KeyValue e kv

src/Chainweb/Payload/PayloadStore.hs

@@ -302,7 +302,7 @@ lookupPayloadWithHeight db mh k = runMaybeT $ do
     mh' <- liftIO $ runMaybeT $
         hoistMaybe mh <|> lookupHeight (_transactionDb db) k
     pd <- MaybeT (lookupPayloadDataWithHeight db mh' k)
-    let outsHash = _payloadDataOutputsHash pd
+    let outsHash = view payloadDataOutputsHash pd
     let lookupNew h = tableLookupMT (_newBlockOutputsTbl $ _payloadCacheBlockOutputs $ _payloadCache db) (h, outsHash)
     let lookupOld = tableLookupMT (_oldBlockOutputsTbl $ _payloadCacheBlockOutputs $ _payloadCache db) outsHash
 

src/Chainweb/SPV/CreateProof.hs

@@ -383,9 +383,9 @@ createPayloadProof_ getPrefix headerDb payloadDb tcid scid txHeight txIx trgHead
 
     Just pd <- lookupPayloadDataWithHeight payloadDb (Just $ view blockHeight txHeader) (view blockPayloadHash txHeader)
     let payload = BlockPayload
-          { _blockPayloadTransactionsHash = _payloadDataTransactionsHash pd
-          , _blockPayloadOutputsHash = _payloadDataOutputsHash pd
-          , _blockPayloadPayloadHash = _payloadDataPayloadHash pd
+          { _blockPayloadTransactionsHash = view payloadDataTransactionsHash pd
+          , _blockPayloadOutputsHash = view payloadDataOutputsHash pd
+          , _blockPayloadPayloadHash = view payloadDataPayloadHash pd
           }
 
     -- ----------------------------- --

src/Chainweb/Sync/WebBlockHeaderStore.hs

@@ -487,7 +487,7 @@ getBlockHeaderInternal headerStore payloadStore candidateHeaderCas candidatePayl
         outs <- trace logfun
             (traceLabel "pact")
             (view blockHash hdr)
-            (length (_payloadDataTransactions p))
+            (length (view payloadDataTransactions p))
             $ pact hdr payload
         addNewPayload (_webBlockPayloadStoreCas payloadStore) (view blockHeight hdr) outs
 

test/Chainweb/Test/CutDB.hs

@@ -453,9 +453,9 @@ randomTransaction cutDb = do
     bh <- randomBlockHeader cutDb
     Just pd <- lookupPayloadDataWithHeight payloadDb (Just $ view blockHeight bh) (view blockPayloadHash bh)
     let pay = BlockPayload
-          { _blockPayloadTransactionsHash = _payloadDataTransactionsHash pd
-          , _blockPayloadOutputsHash = _payloadDataOutputsHash pd
-          , _blockPayloadPayloadHash = _payloadDataPayloadHash pd
+          { _blockPayloadTransactionsHash = view payloadDataTransactionsHash pd
+          , _blockPayloadOutputsHash = view payloadDataOutputsHash pd
+          , _blockPayloadPayloadHash = view payloadDataPayloadHash pd
           }
 
     Just btxs <-
@@ -490,7 +490,7 @@ fakePact = WebPactExecutionService $ PactExecutionService
         let d = checkablePayloadToPayloadData p
         return
             $ payloadWithOutputs d coinbase
-            $ getFakeOutput <$> _payloadDataTransactions d
+            $ getFakeOutput <$> view payloadDataTransactions d
   , _pactNewBlock = \_ _ _ ph -> do
         payloadDat <- generate $ V.fromList . getNonEmpty <$> arbitrary
         return $ Historical

tools/txstream/TxStream.hs

@@ -261,7 +261,7 @@ txStream config mgr logg = do
                     logg @T.Text Info ("BlockHeight: " <> sshow (view blockHeight x))
                 )
             & S.mapM (\x -> (view blockHeight x,) <$> devNetPayload config mgr (view blockHeight x) (view blockPayloadHash x))
-            & flip S.for (S.each . traverse _payloadDataTransactions)
+            & flip S.for (S.each . traverse (view payloadDataTransactions))
             & S.map (fmap _transactionBytes)
             & S.mapM (traverse decodeStrictOrThrow')