Skip to content

Commit dff2461

Browse files
kdafriendkdafriend
committed
Merge branch 'master' into post_quantum
2 parents be1817e + 4d51b78 commit dff2461

24 files changed

Lines changed: 182 additions & 80 deletions

File tree

‎README.md‎

Lines changed: 1 addition & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,6 @@
11
<p align="center">
2-
<img src="https://i.imgur.com/bAZFAGF.png" width="450" height="243" alt="Kadena" title="Kadena">
2+
<img src="https://raw.githubusercontent.com/kda-community/graphic-assets/refs/heads/main/logos/kda_community_edition_original/kdace_extended_lightbg_dark_4000_1000.png" alt="Kadena" title="Kadena">
33
</p>
4-
54
<p>&nbsp;</p>
65

76
# Kadena Public Blockchain

‎src/Chainweb/BlockHeaderDB/HeaderOracle.hs‎

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -29,14 +29,14 @@ module Chainweb.BlockHeaderDB.HeaderOracle
2929
where
3030

3131
import Chainweb.BlockHash (BlockHash)
32-
import Chainweb.BlockHeader (BlockHeader, blockHash, blockHeight, genesisBlockHeader)
32+
import Chainweb.BlockHeader (BlockHeader, blockHash, blockHeight, blockForkNumber, genesisBlockHeader)
3333
import Chainweb.BlockHeaderDB (BlockHeaderDb)
3434
import Chainweb.TreeDB (seekAncestor)
3535
import Chainweb.TreeDB qualified as TreeDB
3636
import Chainweb.Version (_chainwebVersion)
3737
import Chainweb.Version.Guards (minimumBlockHeaderHistory)
3838
import Control.Exception (Exception(..), throwIO)
39-
import Control.Lens (view)
39+
import Control.Lens
4040
import Numeric.Natural (Natural)
4141

4242
-- | A 'HeaderOracle' is a 'BlockHeaderDb' with a lower and upper bound, and the only
@@ -52,7 +52,7 @@ data HeaderOracle = HeaderOracle
5252
-- The lower bound of the oracle is determined by the 'spvProofExpirationWindow'.
5353
createSpv :: BlockHeaderDb -> BlockHeader -> IO HeaderOracle
5454
createSpv db upperBound = do
55-
let mWindow = minimumBlockHeaderHistory (_chainwebVersion upperBound) (view blockHeight upperBound)
55+
let mWindow = minimumBlockHeaderHistory (_chainwebVersion upperBound) (upperBound ^. blockForkNumber) (upperBound ^. blockHeight)
5656
let gh = genesisBlockHeader (_chainwebVersion upperBound) upperBound
5757
let defaultOracle = create db gh upperBound
5858

‎src/Chainweb/Chainweb.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -401,7 +401,7 @@ withChainwebInternal conf logger peer serviceSock rocksDb pactDbDir backupDir re
401401
(\cid x -> do
402402
let mcfg = validatingMempoolConfig cid v (_configBlockGasLimit conf) (_configMinGasPrice conf)
403403
-- NOTE: the gas limit may be set based on block height in future, so this approach may not be valid.
404-
let maxGasLimit = fromIntegral <$> maxBlockGasLimit v maxBound
404+
let maxGasLimit = fromIntegral <$> maxBlockGasLimit v maxBound maxBound
405405
case maxGasLimit of
406406
Just maxGasLimit'
407407
| _configBlockGasLimit conf > maxGasLimit' ->

‎src/Chainweb/Chainweb/Configuration.hs‎

Lines changed: 4 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -605,10 +605,12 @@ parseVersion = constructVersion
605605
maybe (_versionUpgrades winningVersion) (\fub' ->
606606
OnChains $ HM.mapWithKey
607607
(\cid _ ->
608-
case winningVersion ^?! versionForks . at fub' . _Just . atChain cid of
608+
let currentUpgrades = winningVersion ^?! versionUpgrades . atChain cid
609+
in case winningVersion ^?! versionForks . at fub' . _Just . atChain cid of
609610
ForkNever -> error "Chainweb.Chainweb.Configuration.parseVersion: the fork upper bound never occurs in this version."
610-
ForkAtBlockHeight fubHeight -> HM.filterWithKey (\bh _ -> bh <= fubHeight) (winningVersion ^?! versionUpgrades . atChain cid)
611+
ForkAtBlockHeight fubHeight -> HM.filterWithKey (\bh _ -> bh <= fubHeight) currentUpgrades
611612
ForkAtGenesis -> winningVersion ^?! versionUpgrades . atChain cid
613+
ForkAtForkNumber _ -> currentUpgrades -- For now, version upgrades were only allowed at block heights
612614
)
613615
(HS.toMap (chainIds winningVersion))
614616
) fub

‎src/Chainweb/ForkState.hs‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -133,8 +133,9 @@ forkNumber = lens _forkNumber $ \(ForkState w) v -> ForkState
133133
$ (w .&. 0xFFFFFFFF00000000)
134134
.|. (fromIntegral v .&. 0xFFFFFFFF)
135135

136-
-- Pact4 -> Pact5 trnasition happened during ForkNumber=0 era.
137-
pact4ForkNumber:: ForkNumber
136+
137+
-- Pact4 -> Pact5 transition happened during ForkNumber=0 era.
138+
pact4ForkNumber :: ForkNumber
138139
pact4ForkNumber = 0
139140

140141
-- ---------------------------------------------------------------------------

‎src/Chainweb/Pact/Backend/Compaction.hs‎

Lines changed: 12 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -68,7 +68,7 @@ import "yet-another-logger" System.Logger hiding (Logger)
6868
import "yet-another-logger" System.Logger qualified as YAL
6969
import "yet-another-logger" System.Logger.Backend.ColorOption (useColor)
7070
import Chainweb.BlockHash
71-
import Chainweb.BlockHeader (blockHeight, blockHash, blockPayloadHash)
71+
import Chainweb.BlockHeader (blockHeight, blockForkNumber, blockHash, blockPayloadHash)
7272
import Chainweb.BlockHeaderDB.Internal (BlockHeaderDb(..), RankedBlockHeader(..))
7373
import Chainweb.BlockHeight (BlockHeight(..))
7474
import Chainweb.Cut.CutHashes (cutIdToText)
@@ -762,7 +762,7 @@ doCompactRocksDb logger cwVersion cids minBlockHeight srcDb targetDb = do
762762
iterLast it
763763
iterValue it >>= \case
764764
Nothing -> exitLog logger "Missing final payload. This is likely due to a corrupted database."
765-
Just rbh -> pure (_getRankedBlockHeader rbh ^. blockHeight)
765+
Just rbh -> pure $ _getRankedBlockHeader rbh
766766

767767
-- The header that we start at depends on whether or not
768768
-- we have a minimal block header history window.
@@ -772,7 +772,10 @@ doCompactRocksDb logger cwVersion cids minBlockHeight srcDb targetDb = do
772772
--
773773
-- On new enough chainweb versions, we want to only copy over
774774
-- the minimal number of block headers.
775-
case minimumBlockHeaderHistory cwVersion latestHeader of
775+
-- Note, this behaviour may be dangerous in case of changes on the minimum block history.
776+
--
777+
-- TODO = Option to prune headers history to the minimum should be enabled by flag.
778+
case minimumBlockHeaderHistory cwVersion (latestHeader ^. blockForkNumber) (latestHeader ^. blockHeight) of
776779
-- Go to the earliest possible entry. We migrate all BlockHeaders, for now.
777780
-- They are needed for SPV.
778781
--
@@ -791,16 +794,18 @@ doCompactRocksDb logger cwVersion cids minBlockHeight srcDb targetDb = do
791794
earliestHeader <- do
792795
iterValue it >>= \case
793796
Nothing -> exitLog logger "Missing first payload. This is likely due to a corrupted database."
794-
Just rbh -> pure (_getRankedBlockHeader rbh ^. blockHeight)
797+
Just rbh -> pure $ _getRankedBlockHeader rbh
795798

796799
-- Ensure that we log progress 100 times per chain
797800
-- I just made this number up as something that felt somewhat sensible
798-
let offset = (latestHeader - earliestHeader) `div` 100
799-
let headerProgressPoints = [earliestHeader + i * offset | i <- [1..100]]
801+
let latestHeight = latestHeader ^. blockHeight
802+
earliestHeight = earliestHeader ^. blockHeight
803+
offset = (latestHeight - earliestHeight) `div` 100
804+
let headerProgressPoints = [earliestHeight + i * offset | i <- [1..100]]
800805

801806
let logHeaderProgress bHeight = do
802807
when (bHeight `elem` headerProgressPoints) $ do
803-
let percentDone = sshow $ 100 * fromIntegral @_ @Double (bHeight - earliestHeader) / fromIntegral @_ @Double (latestHeader - earliestHeader)
808+
let percentDone = sshow $ 100 * fromIntegral @_ @Double (bHeight - earliestHeight) / fromIntegral @_ @Double (latestHeight - earliestHeight)
804809
log' LL.Info $ percentDone <> "% done."
805810

806811
let go = do

‎src/Chainweb/Pact/PactService.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -863,7 +863,7 @@ execLocal cwtx preflight sigVerify rdepth = pactLabel "execLocal" $ do
863863
ph <- view psParentHeader
864864
let txCtx = Pact5.TxContext ph noMiner
865865
bh = Pact5.ctxCurrentBlockHeight txCtx
866-
fn = Pact5.ctxCurrentForkNumber txCtx
866+
fn = Pact5.ctxParentForkNumber txCtx
867867
pact5RequestKey = Pact5.RequestKey (Pact5.Hash $ Pact4.unHash $ Pact4.toUntypedHash $ Pact4._cmdHash cwtx)
868868
spvSupport = Pact5.pactSPV bhdb (_parentHeader ph)
869869

‎src/Chainweb/Pact/PactService/Pact4/ExecBlock.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -164,7 +164,7 @@ execBlock currHeader payload = do
164164
return (totalGasUsed, pwo)
165165
where
166166
blockGasLimit =
167-
fromIntegral <$> maxBlockGasLimit v (view blockHeight currHeader)
167+
fromIntegral <$> maxBlockGasLimit v pact4ForkNumber (view blockHeight currHeader)
168168

169169
logInitCache = liftPactServiceM $ do
170170
mc <- fmap (fmap instr . _getModuleCache) <$> use psInitCache

‎src/Chainweb/Pact/PactService/Pact5/ExecBlock.hs‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -582,7 +582,7 @@ execExistingBlock
582582
-> CheckablePayload
583583
-> PactBlockM logger tbl (P.Gas, PayloadWithOutputs)
584584
execExistingBlock currHeader payload = do
585-
parentBlockHeader <- view psParentHeader
585+
parentBlockHeader <- _parentHeader <$> view psParentHeader
586586
let plData = checkablePayloadToPayloadData payload
587587
miner :: Miner <- decodeStrictOrThrow (_minerData $ view payloadDataMiner plData)
588588
txs <- liftIO $ pact5TransactionsFromPayload plData
@@ -595,13 +595,12 @@ execExistingBlock currHeader payload = do
595595
isGenesis <- view psIsGenesis
596596
blockHandlePreCoinbase <- use pbBlockHandle
597597
let
598-
txValidationTime = ParentCreationTime (view blockCreationTime $ _parentHeader parentBlockHeader)
599-
parentForkNumber = (view blockForkNumber $ _parentHeader parentBlockHeader)
598+
txValidationTime = ParentCreationTime (parentBlockHeader ^. blockCreationTime)
600599
errors <- liftIO $ flip foldMap txs $ \tx -> do
601600
errorOrSuccess <- runExceptT $
602601
validateParsedChainwebTx logger v cid db blockHandlePreCoinbase txValidationTime
603-
parentForkNumber
604-
(view blockHeight currHeader)
602+
(parentBlockHeader ^. blockForkNumber)
603+
(currHeader ^. blockHeight)
605604
isGenesis
606605
tx
607606
case errorOrSuccess of
@@ -619,7 +618,7 @@ execExistingBlock currHeader payload = do
619618
postCoinbaseBlockHandle <- use pbBlockHandle
620619

621620
let blockGasLimit =
622-
Pact5.GasLimit . Pact5.Gas . fromIntegral <$> maxBlockGasLimit v (view blockHeight currHeader)
621+
Pact5.GasLimit . Pact5.Gas . fromIntegral <$> maxBlockGasLimit v (parentBlockHeader ^. blockForkNumber) (currHeader ^. blockHeight)
623622

624623
env <- ask
625624
(V.fromList -> results, (finalHandle, _finalBlockGasLimit)) <-

‎src/Chainweb/Pact/RestAPI/Server.hs‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -728,8 +728,8 @@ validateCommand v cid (fmap encodeUtf8 -> cmdBs) = case parsedCmd of
728728
-- It's supposed to be a Pact4 command, so take the height just before the Pact5 fork
729729
bh = case getForkHeight Pact5Fork v cid of
730730
ForkAtGenesis -> minBound :: BlockHeight
731-
ForkNever -> maxBound :: BlockHeight
732731
ForkAtBlockHeight bh' -> bh' -1
732+
_ -> maxBound :: BlockHeight
733733

734734
decodeAndParse bs =
735735
traverse (Pact4.parsePact) =<< Aeson.eitherDecodeStrict' bs

0 commit comments

Comments
 (0)