From b642b07ae1d1bc3043a3b2bc3ec1c3bc6b20542e Mon Sep 17 00:00:00 2001 From: chessai Date: Tue, 2 Jul 2024 01:12:30 -0500 Subject: [PATCH] stop exporting PayloadData constructor from Chainweb.Payload Co-authored-by: Emmanuel Denloye-Ito Change-Id: I5d50e6a283dfebb630e4cea84bcb8598117e4c89 --- node/ChainwebNode.hs | 2 +- src/Chainweb/BlockHeader.hs | 8 +++++++ src/Chainweb/BlockHeader/Internal.hs | 10 +++++++- src/Chainweb/Mempool/Consensus.hs | 2 +- src/Chainweb/Pact/PactService.hs | 2 +- src/Chainweb/Pact/PactService/ExecBlock.hs | 12 +++++----- src/Chainweb/Payload.hs | 28 +++++++++++++++++++--- src/Chainweb/Payload/PayloadStore.hs | 2 +- src/Chainweb/SPV/CreateProof.hs | 6 ++--- src/Chainweb/Sync/WebBlockHeaderStore.hs | 2 +- test/Chainweb/Test/CutDB.hs | 8 +++---- tools/txstream/TxStream.hs | 2 +- 12 files changed, 61 insertions(+), 23 deletions(-) diff --git a/node/ChainwebNode.hs b/node/ChainwebNode.hs index f67ea568cc..a0c375ee3c 100644 --- a/node/ChainwebNode.hs +++ b/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 diff --git a/src/Chainweb/BlockHeader.hs b/src/Chainweb/BlockHeader.hs index c675850411..c844e834fd 100644 --- a/src/Chainweb/BlockHeader.hs +++ b/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 diff --git a/src/Chainweb/BlockHeader/Internal.hs b/src/Chainweb/BlockHeader/Internal.hs index 00e8add02e..7e176f610e 100644 --- a/src/Chainweb/BlockHeader/Internal.hs +++ b/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 -- 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 diff --git a/src/Chainweb/Mempool/Consensus.hs b/src/Chainweb/Mempool/Consensus.hs index 1eb78973e7..bd306099cf 100644 --- a/src/Chainweb/Mempool/Consensus.hs +++ b/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 diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs index 2ea2d39d54..ffaa95c719 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/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) diff --git a/src/Chainweb/Pact/PactService/ExecBlock.hs b/src/Chainweb/Pact/PactService/ExecBlock.hs index dc967ae431..5fbe9f81d7 100644 --- a/src/Chainweb/Pact/PactService/ExecBlock.hs +++ b/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,16 +595,16 @@ 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 @@ -612,7 +612,7 @@ validateHashes bHeader payload miner transactions = , "txs" J..= J.array (addTxOuts <$> _transactionPairs transactions) ] ] - (_payloadDataOutputsHash pData) + (view payloadDataOutputsHash pData) (_payloadWithOutputsOutputsHash pwo) ] diff --git a/src/Chainweb/Payload.hs b/src/Chainweb/Payload.hs index e2303fac45..8831b74a57 100644 --- a/src/Chainweb/Payload.hs +++ b/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 diff --git a/src/Chainweb/Payload/PayloadStore.hs b/src/Chainweb/Payload/PayloadStore.hs index 6391409d25..5bc9b62875 100644 --- a/src/Chainweb/Payload/PayloadStore.hs +++ b/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 diff --git a/src/Chainweb/SPV/CreateProof.hs b/src/Chainweb/SPV/CreateProof.hs index 538a54cf0d..b954fdf633 100644 --- a/src/Chainweb/SPV/CreateProof.hs +++ b/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 } -- ----------------------------- -- diff --git a/src/Chainweb/Sync/WebBlockHeaderStore.hs b/src/Chainweb/Sync/WebBlockHeaderStore.hs index c19c8a04ea..264237e2ae 100644 --- a/src/Chainweb/Sync/WebBlockHeaderStore.hs +++ b/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 diff --git a/test/Chainweb/Test/CutDB.hs b/test/Chainweb/Test/CutDB.hs index 03f6fc8c14..9b3d0d957f 100644 --- a/test/Chainweb/Test/CutDB.hs +++ b/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 diff --git a/tools/txstream/TxStream.hs b/tools/txstream/TxStream.hs index e3b2516e0c..d3aa620c62 100644 --- a/tools/txstream/TxStream.hs +++ b/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')