From d08f44acb1067d5b7a0ae4ccc55d3071bb95417a Mon Sep 17 00:00:00 2001 From: Lars Kuhtz Date: Tue, 28 Jan 2020 08:50:09 -0800 Subject: [PATCH] Infrastructure for chainging the hash function --- chainweb.cabal | 1 + src/Chainweb/BlockHeader.hs | 126 +++++++++------ src/Chainweb/BlockHeader/Genesis.hs | 5 +- src/Chainweb/BlockHeader/Validation.hs | 23 ++- src/Chainweb/BlockHeaderDB.hs | 1 + src/Chainweb/BlockHeaderDB/Types.hs | 1 + src/Chainweb/Chainweb.hs | 1 + src/Chainweb/Cut.hs | 1 + src/Chainweb/Cut/CutHashes.hs | 1 + src/Chainweb/Cut/Test.hs | 8 +- src/Chainweb/CutDB.hs | 1 + src/Chainweb/CutDB/Sync.hs | 2 +- src/Chainweb/Difficulty.hs | 4 +- src/Chainweb/Logging/Amberdata.hs | 1 + src/Chainweb/Mempool/InMem.hs | 2 +- src/Chainweb/Mempool/Mempool.hs | 2 +- src/Chainweb/Miner/Coordinator.hs | 10 +- src/Chainweb/Miner/Miners.hs | 2 - src/Chainweb/Miner/Pact.hs | 2 +- src/Chainweb/Pact/Backend/Bench.hs | 2 +- src/Chainweb/Pact/Backend/ChainwebPactDb.hs | 3 +- src/Chainweb/Pact/Backend/ForkingBench.hs | 70 ++++---- .../Pact/Backend/InMemoryCheckpointer.hs | 2 +- .../Pact/Backend/RelationalCheckpointer.hs | 2 +- src/Chainweb/Pact/Backend/Types.hs | 1 + src/Chainweb/Pact/PactService.hs | 1 + src/Chainweb/Pact/RestAPI/Server.hs | 1 + src/Chainweb/Pact/SPV.hs | 1 + src/Chainweb/Pact/Service/BlockValidation.hs | 1 + src/Chainweb/Pact/Service/PactInProcApi.hs | 1 + src/Chainweb/Pact/Service/Types.hs | 1 + src/Chainweb/Pact/Types.hs | 1 + src/Chainweb/PowHash.hs | 151 ++++++++++++++++-- src/Chainweb/RestAPI/Orphans.hs | 1 + src/Chainweb/SPV.hs | 1 + src/Chainweb/SPV/CreateProof.hs | 1 + src/Chainweb/SPV/RestAPI.hs | 2 +- src/Chainweb/SPV/RestAPI/Client.hs | 2 +- src/Chainweb/SPV/RestAPI/Server.hs | 2 +- src/Chainweb/WebPactExecutionService/Types.hs | 1 + test/Chainweb/Test/CutDB.hs | 1 + test/Chainweb/Test/Mempool/Consensus.hs | 3 +- test/Chainweb/Test/MultiNode.hs | 1 + test/Chainweb/Test/Orphans/Internal.hs | 6 +- test/Chainweb/Test/Pact/ChainData.hs | 3 + test/Chainweb/Test/Pact/Checkpointer.hs | 2 +- test/Chainweb/Test/Pact/PactReplay.hs | 3 + test/Chainweb/Test/Pact/SPV.hs | 1 + test/Chainweb/Test/Pact/TTL.hs | 3 + test/Chainweb/Test/Pact/TransactionTests.hs | 2 +- test/Chainweb/Test/Pact/Utils.hs | 1 + test/Chainweb/Test/Roundtrips.hs | 4 + test/Chainweb/Test/TreeDB.hs | 4 +- test/Chainweb/Test/Utils.hs | 4 +- tools/header-dump/HeaderDump.hs | 1 + tools/standalone/Standalone/Utils.hs | 1 + tools/test-miner/TestMiner.hs | 4 +- tools/txstream/TxStream.hs | 1 + 58 files changed, 357 insertions(+), 130 deletions(-) diff --git a/chainweb.cabal b/chainweb.cabal index 41cd28b697..a900c2ea9e 100644 --- a/chainweb.cabal +++ b/chainweb.cabal @@ -141,6 +141,7 @@ library , Chainweb.BlockHeaderDB.RestAPI.Client , Chainweb.BlockHeaderDB.RestAPI.Server , Chainweb.BlockHeaderDB.Types + , Chainweb.BlockHeight , Chainweb.ChainId , Chainweb.Chainweb , Chainweb.Chainweb.ChainResources diff --git a/src/Chainweb/BlockHeader.hs b/src/Chainweb/BlockHeader.hs index da7c93841c..c56ce254e3 100644 --- a/src/Chainweb/BlockHeader.hs +++ b/src/Chainweb/BlockHeader.hs @@ -42,13 +42,6 @@ module Chainweb.BlockHeader -- $guards , slowEpochGuard --- * Block Height -, BlockHeight(..) -, encodeBlockHeight -, decodeBlockHeight -, encodeBlockHeightBe -, decodeBlockHeightBe - -- * Block Weight , BlockWeight(..) , encodeBlockWeight @@ -80,9 +73,12 @@ module Chainweb.BlockHeader , epochStart -- * FeatureFlags -, FeatureFlags(..) +, FeatureFlags +, mkFeatureFlags , encodeFeatureFlags , decodeFeatureFlags +, featureFlagsGetPowHash +, featureFlagsSetPowHash -- * POW Target , powTarget @@ -104,6 +100,10 @@ module Chainweb.BlockHeader , blockFlags , _blockPow , blockPow +, _blockPowHashAlg +, blockPowHashAlg +, _blockPowMultiplyer +, blockPowMultiplyer , _blockAdjacentChainIds , blockAdjacentChainIds , encodeBlockHeader @@ -145,15 +145,19 @@ import Control.Monad.Catch import Data.Aeson import Data.Aeson.Types (Parser) +import Data.Bits import Data.Bytes.Get import Data.Bytes.Put import Data.ByteString.Char8 (ByteString) +import Data.Foldable import Data.Function (on) import Data.Hashable import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS import Data.Kind import Data.List (unfoldr) +import qualified Data.List.NonEmpty as NE +import Data.Maybe import qualified Data.Memory.Endian as BA import Data.MerkleLog hiding (Actual, Expected, MerkleHash) import Data.Serialize (Serialize(..)) @@ -162,9 +166,12 @@ import Data.Word import GHC.Generics (Generic) +import Numeric.Natural + -- Internal imports import Chainweb.BlockHash +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Crypto.MerkleLog import Chainweb.Difficulty @@ -232,38 +239,6 @@ slowEpochGuard (ParentHeader p) | otherwise = False {-# INLINE slowEpochGuard #-} --- -------------------------------------------------------------------------- -- --- | BlockHeight --- -newtype BlockHeight = BlockHeight { _height :: Word64 } - deriving (Eq, Ord, Generic) - deriving anyclass (NFData) - deriving newtype - ( Hashable, ToJSON, FromJSON - , AdditiveSemigroup, AdditiveAbelianSemigroup, AdditiveMonoid - , Num, Integral, Real, Enum - ) -instance Show BlockHeight where show (BlockHeight b) = show b - -instance IsMerkleLogEntry ChainwebHashTag BlockHeight where - type Tag BlockHeight = 'BlockHeightTag - toMerkleNode = encodeMerkleInputNode encodeBlockHeight - fromMerkleNode = decodeMerkleInputNode decodeBlockHeight - {-# INLINE toMerkleNode #-} - {-# INLINE fromMerkleNode #-} - -encodeBlockHeight :: MonadPut m => BlockHeight -> m () -encodeBlockHeight (BlockHeight h) = putWord64le h - -decodeBlockHeight :: MonadGet m => m BlockHeight -decodeBlockHeight = BlockHeight <$> getWord64le - -encodeBlockHeightBe :: MonadPut m => BlockHeight -> m () -encodeBlockHeightBe (BlockHeight r) = putWord64be r - -decodeBlockHeightBe :: MonadGet m => m BlockHeight -decodeBlockHeightBe = BlockHeight <$> getWord64be - -- -------------------------------------------------------------------------- -- -- Block Weight -- @@ -407,6 +382,10 @@ isLastInEpoch h = case effectiveWindow h of -- network. Thus we must perform Emergency Difficulty Adjustment to avoid -- stalling the chain. -- +-- NOTE: emergency DAs are now regarded a misfeature and have been disabled in +-- all chainweb version. Emergency DAs are enabled (and have occured) only on +-- mainnet01 for cut heights smaller than 80,000. +-- slowEpoch :: BlockHeader -> BlockCreationTime -> Bool slowEpoch p (BlockCreationTime ct) = actual > (expected * 5) where @@ -460,7 +439,7 @@ epochStart p (BlockCreationTime bt) -- Feature Flags newtype FeatureFlags = FeatureFlags Word64 - deriving stock (Show, Generic) + deriving stock (Show, Eq, Generic) deriving anyclass (NFData) deriving newtype (ToJSON, FromJSON) @@ -477,6 +456,16 @@ instance IsMerkleLogEntry ChainwebHashTag FeatureFlags where {-# INLINE toMerkleNode #-} {-# INLINE fromMerkleNode #-} +mkFeatureFlags :: PowHashAlg -> FeatureFlags +mkFeatureFlags alg = featureFlagsSetPowHash alg $ FeatureFlags 0x0 + +featureFlagsGetPowHash :: FeatureFlags -> PowHashAlg +featureFlagsGetPowHash (FeatureFlags f) = toEnum . int $ (f .&. 0xff) + +featureFlagsSetPowHash :: PowHashAlg -> FeatureFlags -> FeatureFlags +featureFlagsSetPowHash alg (FeatureFlags f) = FeatureFlags + $ f .|. (0xff .&. int (fromEnum alg)) + -- -------------------------------------------------------------------------- -- -- Newtype wrappers for function parameters @@ -488,6 +477,10 @@ newtype ParentHeader = ParentHeader BlockHeader -- | BlockHeader -- +-- Values of this type should never be constructed directly by external code. +-- Instead the 'newBlockHeader' smart constructor should be used. Once +-- constructed 'BlockHeader' values must not be modified. +-- -- Some redundant, aggregated information is included in the block and the block -- hash. This enables nodes to be checked inductively with respect to existing -- blocks without recalculating the aggregated value from the genesis block @@ -831,16 +824,42 @@ isGenesisBlockHeader b = _blockHeight b == BlockHeight 0 -- | The Proof-Of-Work hash includes all data in the block except for the -- '_blockHash'. The value (interpreted as 'BlockHashNat' must be smaller than --- the value of '_blockTarget' (interpreted as 'BlockHashNat'). +-- the value of '_blockTarget' (interpreted as 'BlockHashNat'), subject to the +-- POW hash multiplier for the respective chainweb version and block height +-- (cf. 'powHashAlg'). -- _blockPow :: BlockHeader -> PowHash -_blockPow h = powHash (_blockChainwebVersion h) - $ runPutS $ encodeBlockHeaderWithoutHash h +_blockPow h + = powHash (_blockPowHashAlg h) $ runPutS $ encodeBlockHeaderWithoutHash h blockPow :: Getter BlockHeader PowHash blockPow = to _blockPow {-# INLINE blockPow #-} +-- | The POW Hash that was used for the block +-- +_blockPowHashAlg :: BlockHeader -> PowHashAlg +_blockPowHashAlg = featureFlagsGetPowHash . _blockFlags +{-# INLINE _blockPowHashAlg #-} + +blockPowHashAlg :: Getter BlockHeader PowHashAlg +blockPowHashAlg = to _blockPowHashAlg +{-# INLINE blockPowHashAlg #-} + +-- | The multiplyer for the POW hash when checking the target. +-- +_blockPowMultiplyer :: BlockHeader -> Natural +_blockPowMultiplyer h = fromMaybe 1 $ lookup alg $ toList $ powHashAlg v bh + where + v = _blockChainwebVersion h + bh = _blockHeight h + alg = _blockPowHashAlg h +{-# INLINE _blockPowMultiplyer #-} + +blockPowMultiplyer :: Getter BlockHeader Natural +blockPowMultiplyer = to _blockPowMultiplyer +{-# INLINE blockPowMultiplyer #-} + -- | The number of microseconds between the creation time of two `BlockHeader`s. -- timeBetween :: BlockCreationTime -> BlockCreationTime -> Micros @@ -923,19 +942,27 @@ hashPayload v cid b = BlockPayloadHash $ MerkleLogHash -- -------------------------------------------------------------------------- -- -- Create new BlockHeader +-- | Creates a new block header. No validation of the input parameters is +-- performaned. +-- newBlockHeader :: BlockHashRecord -- ^ Adjacent parent hashes -> BlockPayloadHash -- ^ payload hash + -> PowHashAlg + -- ^ The POW hash algorithm that is used for the block. It is not + -- checked. whether the hash is legal for the chainweb version and the + -- block height. -> Nonce - -- ^ Randomness to affect the block hash + -- ^ Randomness to affect the block hash. It is not verified that the + -- nonce is valid with respect to the target and the POW hash algorithm. -> BlockCreationTime - -- ^ Creation time of the block + -- ^ Creation time of the block. -> ParentHeader -- ^ parent block header -> BlockHeader -newBlockHeader adj pay nonce t (ParentHeader b) = fromLog $ newMerkleLog +newBlockHeader adj pay alg nonce t (ParentHeader b) = fromLog $ newMerkleLog $ nonce :+: t :+: _blockHash b @@ -946,7 +973,7 @@ newBlockHeader adj pay nonce t (ParentHeader b) = fromLog $ newMerkleLog :+: _blockHeight b + 1 :+: v :+: epochStart b t - :+: FeatureFlags 0 + :+: mkFeatureFlags alg :+: MerkleLogBody (blockHashRecordToVector adj) where cid = _chainId b @@ -979,9 +1006,10 @@ testBlockHeader -- ^ parent block header -> BlockHeader testBlockHeader adj nonce p@(ParentHeader b) = - newBlockHeader adj (testBlockPayload b) nonce (BlockCreationTime $ add second t) p + newBlockHeader adj (testBlockPayload b) alg nonce (BlockCreationTime $ add second t) p where BlockCreationTime t = _blockCreationTime b + alg = fst . NE.head $ powHashAlg (_chainwebVersion b) (_blockHeight b + 1) -- | Given a `BlockHeader` of some initial parent, generate an infinite stream -- of `BlockHeader`s which form a legal chain. diff --git a/src/Chainweb/BlockHeader/Genesis.hs b/src/Chainweb/BlockHeader/Genesis.hs index b0422ee829..50f3f4d704 100644 --- a/src/Chainweb/BlockHeader/Genesis.hs +++ b/src/Chainweb/BlockHeader/Genesis.hs @@ -32,6 +32,7 @@ import Control.Arrow ((&&&)) import Data.Foldable (toList) import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS +import qualified Data.List.NonEmpty as NE import Data.MerkleLog hiding (Actual, Expected, MerkleHash) import Pact.Types.Command (CommandResult) @@ -41,6 +42,7 @@ import Pact.Types.Hash (Hash) import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import qualified Chainweb.BlockHeader.Genesis.Development0Payload as DN0 import qualified Chainweb.BlockHeader.Genesis.DevelopmentNPayload as DNN import qualified Chainweb.BlockHeader.Genesis.FastTimedCPM0Payload as TN0 @@ -64,6 +66,7 @@ import Chainweb.MerkleLogHash import Chainweb.MerkleUniverse import Chainweb.Miner.Pact import Chainweb.Payload +import Chainweb.PowHash import Chainweb.Time import Chainweb.Utils import Chainweb.Version @@ -196,7 +199,7 @@ genesisBlockHeader' v p ct@(BlockCreationTime t) n = fromLog mlog :+: BlockHeight 0 :+: v :+: EpochStartTime t - :+: FeatureFlags 0 + :+: mkFeatureFlags (fst . NE.head $ powHashAlg v (BlockHeight 0)) :+: MerkleLogBody (blockHashRecordToVector adjParents) adjParents = BlockHashRecord $ HM.fromList $ (\c -> (c, genesisParentBlockHash v c)) <$> HS.toList (adjacentChainIds g p) diff --git a/src/Chainweb/BlockHeader/Validation.hs b/src/Chainweb/BlockHeader/Validation.hs index e575bfccde..af9f3c5fe3 100644 --- a/src/Chainweb/BlockHeader/Validation.hs +++ b/src/Chainweb/BlockHeader/Validation.hs @@ -40,6 +40,8 @@ module Chainweb.BlockHeader.Validation , prop_block_genesis_parent , prop_block_genesis_target , prop_block_target +, prop_block_featureFlags +, prop_block_powHashAlg -- * Inductive BlockHeader Properties , prop_block_epoch @@ -65,6 +67,7 @@ import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis (genesisBlockTarget, genesisParentBlockHash) import Chainweb.ChainId import Chainweb.Difficulty +import Chainweb.PowHash import Chainweb.Time import Chainweb.Utils @@ -102,6 +105,8 @@ instance Show ValidationFailure where BlockInTheFuture -> "The creation time of the block is in the future" IncorrectPayloadHash -> "The payload hash does not match the payload hash that results from payload validation" MissingPayload -> "The payload of the block is missing" + InvalidFeatureFlags -> "The block has an invalid feature flag value" + InvalidPowHashAlg -> "The block uses an POW hash that is invalid for the chainweb version and block height" -- | An enumeration of possible validation failures for a block header. -- @@ -148,6 +153,10 @@ data ValidationFailureType -- ^ The validation of the payload hash failed. | MissingPayload -- ^ The payload for the block is missing. + | InvalidFeatureFlags + -- ^ The block has an invalid feature flag setting + | InvalidPowHashAlg + -- ^ The block uses an invalid POW hash algorithm deriving (Show, Eq, Ord) instance Exception ValidationFailure @@ -175,6 +184,8 @@ definiteValidationFailures = , IncorrectGenesisParent , IncorrectGenesisTarget , IncorrectPayloadHash + , InvalidFeatureFlags + , InvalidPowHashAlg ] -- | Predicate that checks whether a validation failure is definite. @@ -311,6 +322,8 @@ validateIntrinsic t b = concat , [ IncorrectGenesisParent | not (prop_block_genesis_parent b)] , [ IncorrectGenesisTarget | not (prop_block_genesis_target b)] , [ BlockInTheFuture | not (prop_block_current t b)] + , [ InvalidFeatureFlags | not (prop_block_featureFlags b)] + , [ InvalidPowHashAlg | not (prop_block_powHashAlg b)] ] -- | Validate properties of a block with respect to a given parent. @@ -376,7 +389,7 @@ validateBlocksM t lookupParent as -- Intrinsic BlockHeader properties prop_block_pow :: BlockHeader -> Bool -prop_block_pow b = checkTarget (_blockTarget b) (_blockPow b) +prop_block_pow b = checkTarget (_blockTarget b) (_blockPow b) (_blockPowMultiplyer b) prop_block_hash :: BlockHeader -> Bool prop_block_hash b = _blockHash b == computeBlockHash b @@ -396,6 +409,14 @@ prop_block_genesis_target b = isGenesisBlockHeader b prop_block_current :: Time Micros -> BlockHeader -> Bool prop_block_current t b = BlockCreationTime t >= _blockCreationTime b +prop_block_powHashAlg :: BlockHeader -> Bool +prop_block_powHashAlg b = _blockPowHashAlg b `elem` (toList algs) + where + algs = fst <$> powHashAlg (_blockChainwebVersion b) (int $ _blockHeight b) + +prop_block_featureFlags :: BlockHeader -> Bool +prop_block_featureFlags b = _blockFlags b == mkFeatureFlags (_blockPowHashAlg b) + -- -------------------------------------------------------------------------- -- -- Inductive BlockHeader Properties diff --git a/src/Chainweb/BlockHeaderDB.hs b/src/Chainweb/BlockHeaderDB.hs index 53b9a717d6..78a75f05c4 100644 --- a/src/Chainweb/BlockHeaderDB.hs +++ b/src/Chainweb/BlockHeaderDB.hs @@ -76,6 +76,7 @@ import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeaderDB.Types import Chainweb.BlockHeader.Genesis (genesisBlockHeader) +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Logger import Chainweb.TreeDB diff --git a/src/Chainweb/BlockHeaderDB/Types.hs b/src/Chainweb/BlockHeaderDB/Types.hs index 10dcdd742d..04637a1bc9 100644 --- a/src/Chainweb/BlockHeaderDB/Types.hs +++ b/src/Chainweb/BlockHeaderDB/Types.hs @@ -33,6 +33,7 @@ import Prelude hiding (lookup) import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Version diff --git a/src/Chainweb/Chainweb.hs b/src/Chainweb/Chainweb.hs index 7ca44b434a..5672a02f81 100644 --- a/src/Chainweb/Chainweb.hs +++ b/src/Chainweb/Chainweb.hs @@ -165,6 +165,7 @@ import qualified Pact.Types.Command as P import Chainweb.BlockHeader import Chainweb.BlockHeaderDB (BlockHeaderDb) import Chainweb.BlockHeaderDB.RestAPI (HeaderStream(..)) +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Chainweb.ChainResources import Chainweb.Chainweb.CutResources diff --git a/src/Chainweb/Cut.hs b/src/Chainweb/Cut.hs index 881a11541d..e63fa2d7b2 100644 --- a/src/Chainweb/Cut.hs +++ b/src/Chainweb/Cut.hs @@ -112,6 +112,7 @@ import qualified Streaming.Prelude as S import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis (genesisBlockHeaders) +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Graph import Chainweb.TreeDB hiding (properties) diff --git a/src/Chainweb/Cut/CutHashes.hs b/src/Chainweb/Cut/CutHashes.hs index 27726918eb..b2fb45290d 100644 --- a/src/Chainweb/Cut/CutHashes.hs +++ b/src/Chainweb/Cut/CutHashes.hs @@ -83,6 +83,7 @@ import System.IO.Unsafe import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Cut import Chainweb.Utils diff --git a/src/Chainweb/Cut/Test.hs b/src/Chainweb/Cut/Test.hs index 91b39fe2e4..a2df43dec9 100644 --- a/src/Chainweb/Cut/Test.hs +++ b/src/Chainweb/Cut/Test.hs @@ -81,10 +81,12 @@ import qualified Test.QuickCheck.Monadic as T import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Cut import Chainweb.Difficulty (checkTarget) import Chainweb.Graph +import Chainweb.PowHash import Chainweb.Time (Micros(..), Time, getCurrentTimeIntegral, second) import Chainweb.Utils import Chainweb.Version @@ -143,7 +145,7 @@ createNewCut -> Either MineFailure (T2 BlockHeader Cut) createNewCut n t pay i c = do h <- note BadAdjacents $ newHeader . BlockHashRecord <$> newAdjHashes - unless (checkTarget (_blockTarget h) $ _blockPow h) $ Left BadNonce + unless (checkTarget (_blockTarget h) (_blockPow h) (_blockPowMultiplyer h)) $ Left BadNonce c' <- first (\e -> error $ "Chainweb.Cut.createNewCut: " <> sshow e) $ monotonicCutExtension c h return $ T2 h c' @@ -155,8 +157,10 @@ createNewCut n t pay i c = do p :: BlockHeader p = c ^?! ixg cid + alg = defaultPowHashAlg (_chainwebVersion c) (_blockHeight p + 1) + newHeader :: BlockHashRecord -> BlockHeader - newHeader as = newBlockHeader as pay n (BlockCreationTime t) $ ParentHeader p + newHeader as = newBlockHeader as pay alg n (BlockCreationTime t) $ ParentHeader p -- | Try to get all adjacent hashes dependencies. -- diff --git a/src/Chainweb/CutDB.hs b/src/Chainweb/CutDB.hs index c72d91a50a..e2c081d0e3 100644 --- a/src/Chainweb/CutDB.hs +++ b/src/Chainweb/CutDB.hs @@ -120,6 +120,7 @@ import System.Timeout import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.BlockHeaderDB import Chainweb.ChainId import Chainweb.Cut diff --git a/src/Chainweb/CutDB/Sync.hs b/src/Chainweb/CutDB/Sync.hs index c5528cef94..8dbda92c63 100644 --- a/src/Chainweb/CutDB/Sync.hs +++ b/src/Chainweb/CutDB/Sync.hs @@ -33,7 +33,7 @@ import System.LogLevel -- internal modules -import Chainweb.BlockHeader (BlockHeight) +import Chainweb.BlockHeight import Chainweb.Cut (_cutHeight) import Chainweb.Cut.CutHashes import Chainweb.CutDB diff --git a/src/Chainweb/Difficulty.hs b/src/Chainweb/Difficulty.hs index 2ec5737c6b..96bb4466db 100644 --- a/src/Chainweb/Difficulty.hs +++ b/src/Chainweb/Difficulty.hs @@ -291,8 +291,8 @@ targetToDifficultyR (HashTarget (PowHashNat target)) = -- | The critical check in Proof-of-Work mining: did the generated hash match -- the target? -- -checkTarget :: HashTarget -> PowHash -> Bool -checkTarget (HashTarget target) h = powHashNat h <= target +checkTarget :: HashTarget -> PowHash -> Natural -> Bool +checkTarget (HashTarget target) h m = (int m) * powHashNat h <= target {-# INLINE checkTarget #-} encodeHashTarget :: MonadPut m => HashTarget -> m () diff --git a/src/Chainweb/Logging/Amberdata.hs b/src/Chainweb/Logging/Amberdata.hs index f890e75732..d73735d69b 100644 --- a/src/Chainweb/Logging/Amberdata.hs +++ b/src/Chainweb/Logging/Amberdata.hs @@ -65,6 +65,7 @@ import System.LogLevel import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.CutDB import Chainweb.HostAddress import Chainweb.Logger diff --git a/src/Chainweb/Mempool/InMem.hs b/src/Chainweb/Mempool/InMem.hs index 190aa164f2..1a48f1c470 100644 --- a/src/Chainweb/Mempool/InMem.hs +++ b/src/Chainweb/Mempool/InMem.hs @@ -61,7 +61,7 @@ import System.Random -- internal imports import Chainweb.BlockHash -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Logger import Chainweb.Mempool.InMemTypes import Chainweb.Mempool.Mempool diff --git a/src/Chainweb/Mempool/Mempool.hs b/src/Chainweb/Mempool/Mempool.hs index 2420be5636..e9c81cf976 100644 --- a/src/Chainweb/Mempool/Mempool.hs +++ b/src/Chainweb/Mempool/Mempool.hs @@ -127,7 +127,7 @@ import Pact.Types.Gas (GasLimit(..), GasPrice(..)) import qualified Pact.Types.Hash as H import Chainweb.BlockHash -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Time (Micros(..), Time(..), TimeSpan(..)) import qualified Chainweb.Time as Time import Chainweb.Transaction diff --git a/src/Chainweb/Miner/Coordinator.hs b/src/Chainweb/Miner/Coordinator.hs index fdec47afb1..3e3dbdcce3 100644 --- a/src/Chainweb/Miner/Coordinator.hs +++ b/src/Chainweb/Miner/Coordinator.hs @@ -52,6 +52,7 @@ import Data.Foldable (foldl') import Data.Generics.Wrapped (_Unwrapped) import qualified Data.HashMap.Strict as HM import qualified Data.Map.Strict as M +import qualified Data.List.NonEmpty as NE import Data.Ratio ((%)) import Data.Tuple.Strict (T2(..), T3(..)) import qualified Data.Vector as V @@ -67,6 +68,7 @@ import System.LogLevel (LogLevel(..)) import Chainweb.BlockHash (BlockHash, BlockHashRecord(..)) import Chainweb.BlockHeader import Chainweb.BlockHeader.Validation (prop_block_pow) +import Chainweb.BlockHeight import Chainweb.Cut import Chainweb.Cut.CutHashes import Chainweb.CutDB @@ -74,6 +76,7 @@ import Chainweb.Difficulty import Chainweb.Logging.Miner import Chainweb.Miner.Pact (Miner(..), MinerId(..), minerId) import Chainweb.Payload +import Chainweb.PowHash import Chainweb.Sync.WebBlockHeaderStore import Chainweb.Time (Micros(..), getCurrentTimeIntegral) import Chainweb.Utils hiding (check) @@ -146,11 +149,12 @@ newWork logFun choice eminer pact tpw c = do -- cid <- chainChoice c choice - -- The parent block the mine on. Any given chain will always + -- The parent block to mine on. Any given chain will always -- contain at least a genesis block, so this otherwise naughty -- `^?!` will always succeed. -- - let !p = ParentHeader (c ^?! ixg cid) + let !p@(ParentHeader ph) = ParentHeader (c ^?! ixg cid) + (alg, mult) = NE.head $ powHashAlg (_chainwebVersion c) (_blockHeight ph + 1) mr <- case eminer of Primed m -> primed m cid p <$> readTVarIO tpw @@ -165,7 +169,7 @@ newWork logFun choice eminer pact tpw c = do -- core Mining logic. -- let !phash = _payloadWithOutputsPayloadHash payload - !header = newBlockHeader adjParents phash (Nonce 0) creationTime p + !header = newBlockHeader adjParents phash alg (Nonce 0) creationTime p pure $ T3 (PrevTime . _blockCreationTime $ coerce p) header payload where primed diff --git a/src/Chainweb/Miner/Miners.hs b/src/Chainweb/Miner/Miners.hs index 7c64ad9717..002d6c3774 100644 --- a/src/Chainweb/Miner/Miners.hs +++ b/src/Chainweb/Miner/Miners.hs @@ -62,8 +62,6 @@ import Chainweb.WebPactExecutionService import Data.LogMessage (LogFunction) ---- - -------------------------------------------------------------------------------- -- Local Mining diff --git a/src/Chainweb/Miner/Pact.hs b/src/Chainweb/Miner/Pact.hs index 635a501235..fcf649d8d0 100644 --- a/src/Chainweb/Miner/Pact.hs +++ b/src/Chainweb/Miner/Pact.hs @@ -59,7 +59,7 @@ import Data.Word -- internal modules -import Chainweb.BlockHeader (BlockHeight(..)) +import Chainweb.BlockHeight (BlockHeight(..)) import Chainweb.Graph (HasChainGraph(..), order) import Chainweb.Payload (MinerData(..)) import Chainweb.Utils diff --git a/src/Chainweb/Pact/Backend/Bench.hs b/src/Chainweb/Pact/Backend/Bench.hs index f5cf6f62c3..99c443130f 100644 --- a/src/Chainweb/Pact/Backend/Bench.hs +++ b/src/Chainweb/Pact/Backend/Bench.hs @@ -36,7 +36,7 @@ import qualified Pact.Types.SQLite as PSQL -- chainweb imports import Chainweb.BlockHash -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.MerkleLogHash import Chainweb.Pact.Backend.RelationalCheckpointer import Chainweb.Pact.Backend.Types diff --git a/src/Chainweb/Pact/Backend/ChainwebPactDb.hs b/src/Chainweb/Pact/Backend/ChainwebPactDb.hs index f80b56e986..f6bb57bc15 100644 --- a/src/Chainweb/Pact/Backend/ChainwebPactDb.hs +++ b/src/Chainweb/Pact/Backend/ChainwebPactDb.hs @@ -51,7 +51,6 @@ import qualified Data.Serialize import qualified Data.Set as Set import Data.String import Data.String.Conv -import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Vector as V @@ -76,7 +75,7 @@ import Pact.Types.Util (AsString(..)) -- chainweb import Chainweb.BlockHash -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Pact.Backend.Types import Chainweb.Pact.Backend.Utils import Chainweb.Pact.Service.Types (PactException(..), internalError) diff --git a/src/Chainweb/Pact/Backend/ForkingBench.hs b/src/Chainweb/Pact/Backend/ForkingBench.hs index 99ebf838af..a6af8b3b9e 100644 --- a/src/Chainweb/Pact/Backend/ForkingBench.hs +++ b/src/Chainweb/Pact/Backend/ForkingBench.hs @@ -86,6 +86,7 @@ import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis import Chainweb.BlockHeaderDB +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Difficulty import Chainweb.Logger @@ -98,6 +99,7 @@ import Chainweb.Pact.Service.PactQueue import Chainweb.Payload import Chainweb.Payload.PayloadStore.InMemory import Chainweb.Payload.PayloadStore.Types +import Chainweb.PowHash import Chainweb.Time import Chainweb.Transaction import Chainweb.TreeDB @@ -228,34 +230,35 @@ mineBlock -> IO (T3 BlockHeader BlockHeader PayloadWithOutputs) mineBlock parentHeader nonce pdb bhdb r = do - -- assemble block without nonce and timestamp - creationTime <- BlockCreationTime <$> getCurrentTimeIntegral + -- assemble block without nonce and timestamp + creationTime <- BlockCreationTime <$> getCurrentTimeIntegral - mv <- newBlock noMiner parentHeader creationTime r + mv <- newBlock noMiner parentHeader creationTime r - payload <- assertNotLeft =<< takeMVar mv + payload <- assertNotLeft =<< takeMVar mv - let bh = newBlockHeader - (BlockHashRecord mempty) - (_payloadWithOutputsPayloadHash payload) - nonce - creationTime - (ParentHeader parentHeader) - hbytes = HeaderBytes . runPutS $ encodeBlockHeaderWithoutHash bh - tbytes = TargetBytes . runPutS . encodeHashTarget $ _blockTarget bh + let bh = newBlockHeader + (BlockHashRecord mempty) + (_payloadWithOutputsPayloadHash payload) + (defaultPowHashAlg (_chainwebVersion parentHeader) (_blockHeight parentHeader + 1)) + nonce + creationTime + (ParentHeader parentHeader) + hbytes = HeaderBytes . runPutS $ encodeBlockHeaderWithoutHash bh + tbytes = TargetBytes . runPutS . encodeHashTarget $ _blockTarget bh - T2 (HeaderBytes new) _ <- usePowHash testVer (\p -> mine p (_blockNonce bh) tbytes) hbytes - newHeader <- runGet decodeBlockHeaderWithoutHash new + T2 (HeaderBytes new) _ <- usePowHash testVer (\p -> mine p (_blockNonce bh) tbytes) hbytes + newHeader <- runGet decodeBlockHeaderWithoutHash new - mv' <- validateBlock newHeader (payloadWithOutputsToPayloadData payload) r + mv' <- validateBlock newHeader (payloadWithOutputsToPayloadData payload) r - void $ assertNotLeft =<< takeMVar mv' + void $ assertNotLeft =<< takeMVar mv' - addNewPayload pdb payload + addNewPayload pdb payload - insert bhdb newHeader + insert bhdb newHeader - return $ T3 parentHeader newHeader payload + return $ T3 parentHeader newHeader payload @@ -267,26 +270,27 @@ noMineBlock -> IO (T3 BlockHeader BlockHeader PayloadWithOutputs) noMineBlock validate parentHeader nonce r = do - -- assemble block without nonce and timestamp - creationTime <- BlockCreationTime <$> getCurrentTimeIntegral + -- assemble block without nonce and timestamp + creationTime <- BlockCreationTime <$> getCurrentTimeIntegral - mv <- newBlock noMiner parentHeader creationTime r + mv <- newBlock noMiner parentHeader creationTime r - payload <- assertNotLeft =<< takeMVar mv + payload <- assertNotLeft =<< takeMVar mv - let bh = newBlockHeader - (BlockHashRecord mempty) - (_payloadWithOutputsPayloadHash payload) - nonce - creationTime - (ParentHeader parentHeader) + let bh = newBlockHeader + (BlockHashRecord mempty) + (_payloadWithOutputsPayloadHash payload) + (defaultPowHashAlg (_chainwebVersion parentHeader) (_blockHeight parentHeader + 1)) + nonce + creationTime + (ParentHeader parentHeader) - when validate $ do - mv' <- validateBlock bh (payloadWithOutputsToPayloadData payload) r + when validate $ do + mv' <- validateBlock bh (payloadWithOutputsToPayloadData payload) r - void $ assertNotLeft =<< takeMVar mv' + void $ assertNotLeft =<< takeMVar mv' - return $ T3 parentHeader bh payload + return $ T3 parentHeader bh payload data Resources diff --git a/src/Chainweb/Pact/Backend/InMemoryCheckpointer.hs b/src/Chainweb/Pact/Backend/InMemoryCheckpointer.hs index d1d27bec2f..9ddd494e76 100644 --- a/src/Chainweb/Pact/Backend/InMemoryCheckpointer.hs +++ b/src/Chainweb/Pact/Backend/InMemoryCheckpointer.hs @@ -31,7 +31,7 @@ import Pact.Types.Logger -- internal modules import Chainweb.BlockHash -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Pact.Backend.Types import Chainweb.Pact.Service.Types (internalError) diff --git a/src/Chainweb/Pact/Backend/RelationalCheckpointer.hs b/src/Chainweb/Pact/Backend/RelationalCheckpointer.hs index c3eb31b57e..c52128866c 100644 --- a/src/Chainweb/Pact/Backend/RelationalCheckpointer.hs +++ b/src/Chainweb/Pact/Backend/RelationalCheckpointer.hs @@ -45,7 +45,7 @@ import Pact.Types.SQLite -- chainweb import Chainweb.BlockHash -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Pact.Backend.ChainwebPactDb import Chainweb.Pact.Backend.Types import Chainweb.Pact.Backend.Utils diff --git a/src/Chainweb/Pact/Backend/Types.hs b/src/Chainweb/Pact/Backend/Types.hs index 992d7e55fe..11f6aa7797 100644 --- a/src/Chainweb/Pact/Backend/Types.hs +++ b/src/Chainweb/Pact/Backend/Types.hs @@ -111,6 +111,7 @@ import Pact.Types.Runtime -- internal modules import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Mempool.Mempool (MempoolPreBlockCheck) import Chainweb.Transaction diff --git a/src/Chainweb/Pact/PactService.hs b/src/Chainweb/Pact/PactService.hs index 5bb5ad8199..d042927c34 100644 --- a/src/Chainweb/Pact/PactService.hs +++ b/src/Chainweb/Pact/PactService.hs @@ -108,6 +108,7 @@ import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis (genesisBlockHeader, genesisBlockPayload) import Chainweb.BlockHeaderDB +import Chainweb.BlockHeight import Chainweb.Logger import Chainweb.Mempool.Mempool as Mempool import Chainweb.Miner.Pact diff --git a/src/Chainweb/Pact/RestAPI/Server.hs b/src/Chainweb/Pact/RestAPI/Server.hs index 054fc4d720..f55893dffd 100644 --- a/src/Chainweb/Pact/RestAPI/Server.hs +++ b/src/Chainweb/Pact/RestAPI/Server.hs @@ -72,6 +72,7 @@ import qualified Pact.Types.Hash as Pact import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Chainweb.ChainResources import Chainweb.Chainweb.CutResources diff --git a/src/Chainweb/Pact/SPV.hs b/src/Chainweb/Pact/SPV.hs index 115a3ad569..ba87becd2b 100644 --- a/src/Chainweb/Pact/SPV.hs +++ b/src/Chainweb/Pact/SPV.hs @@ -46,6 +46,7 @@ import qualified Streaming.Prelude as S import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeaderDB +import Chainweb.BlockHeight import Chainweb.Pact.Service.Types import Chainweb.Pact.Utils (aeson) import Chainweb.Payload diff --git a/src/Chainweb/Pact/Service/BlockValidation.hs b/src/Chainweb/Pact/Service/BlockValidation.hs index 06c0c30de3..09f6aced0e 100644 --- a/src/Chainweb/Pact/Service/BlockValidation.hs +++ b/src/Chainweb/Pact/Service/BlockValidation.hs @@ -31,6 +31,7 @@ import Pact.Types.Hash import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Mempool.Mempool (InsertError) import Chainweb.Miner.Pact import Chainweb.Pact.Service.PactQueue diff --git a/src/Chainweb/Pact/Service/PactInProcApi.hs b/src/Chainweb/Pact/Service/PactInProcApi.hs index 4b26b47c99..82c2376415 100644 --- a/src/Chainweb/Pact/Service/PactInProcApi.hs +++ b/src/Chainweb/Pact/Service/PactInProcApi.hs @@ -39,6 +39,7 @@ import System.LogLevel import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeaderDB.Types +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Logger import Chainweb.Mempool.Consensus diff --git a/src/Chainweb/Pact/Service/Types.hs b/src/Chainweb/Pact/Service/Types.hs index df2b7dba47..4a0858840f 100644 --- a/src/Chainweb/Pact/Service/Types.hs +++ b/src/Chainweb/Pact/Service/Types.hs @@ -37,6 +37,7 @@ import Pact.Types.Hash import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Mempool.Mempool (InsertError(..)) import Chainweb.Miner.Pact import Chainweb.Payload diff --git a/src/Chainweb/Pact/Types.hs b/src/Chainweb/Pact/Types.hs index eb7a1c93dd..f5dd7b92bf 100644 --- a/src/Chainweb/Pact/Types.hs +++ b/src/Chainweb/Pact/Types.hs @@ -135,6 +135,7 @@ import Pact.Types.Term (PactId(..), Ref) import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.BlockHeaderDB import Chainweb.Miner.Pact import Chainweb.Pact.Backend.Types diff --git a/src/Chainweb/PowHash.hs b/src/Chainweb/PowHash.hs index d68f21ba37..f4a7a5e33a 100644 --- a/src/Chainweb/PowHash.hs +++ b/src/Chainweb/PowHash.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -19,7 +20,9 @@ -- TODO -- module Chainweb.PowHash -( PowHash +( +-- * POW Hash + PowHash , powHashBytes , mkPowHash , unsafeMkPowHash @@ -27,8 +30,17 @@ module Chainweb.PowHash , powHashBytesCount , encodePowHash , decodePowHash -, randomPowHash + +-- * POW Hash Algorithms +, PowHashAlg(..) +, encodePowHashAlg +, decodePowHashAlg +, powHashAlg +, defaultPowHashAlg + +-- * POW Hash Implementations , powHash +, randomPowHash ) where import Control.DeepSeq @@ -39,6 +51,7 @@ import qualified Crypto.Hash as C (hash) import Crypto.Hash.Algorithms import Data.Aeson +import Data.Bifunctor import Data.Bits import qualified Data.ByteArray as BA import Data.Bytes.Get @@ -47,13 +60,14 @@ import qualified Data.ByteString as B import qualified Data.ByteString.Random as BR import qualified Data.ByteString.Short as SB import Data.Hashable hiding (hash) +import qualified Data.List.NonEmpty as NE import Data.Proxy import Foreign.Storable import GHC.Generics -import GHC.TypeNats import GHC.Stack (HasCallStack) +import GHC.TypeNats import Numeric.Natural @@ -61,6 +75,7 @@ import System.IO.Unsafe -- internal modules +import Chainweb.BlockHeight import Chainweb.Crypto.MerkleLog import Chainweb.MerkleUniverse import Chainweb.Utils @@ -126,24 +141,126 @@ instance FromJSON PowHash where $ runGet decodePowHash =<< decodeB64UrlNoPaddingText t {-# INLINE parseJSON #-} +-- -------------------------------------------------------------------------- -- +-- POW Hash Algorithms + +-- | Enumeration of POW Hash Algorithms that are used in Chainweb. +-- +-- For backward compatibility it must hold that +-- +-- @ +-- fromEnum PowHash_Blake2s == 0 +-- @ +-- +data PowHashAlg + = PowHash_Blake2s + | PowHash_Sha256 + deriving (Show, Eq, Ord, Bounded, Enum, Generic) + +-- FIXME provide explicit Enum instance + +encodePowHashAlg :: MonadPut m => PowHashAlg -> m () +encodePowHashAlg = putWord8 . int . fromEnum +{-# INLINE encodePowHashAlg #-} + +-- FIXME use Enum instance +decodePowHashAlg :: MonadGet m => m PowHashAlg +decodePowHashAlg = getWord8 >>= \case + 0 -> return PowHash_Blake2s + 1 -> return PowHash_Sha256 + x -> fail $ "unknow POW hash algorithm code: " <> sshow x +{-# INLINE decodePowHashAlg #-} + +instance Hashable PowHashAlg where + hashWithSalt s = xor s . fromEnum + {-# INLINE hashWithSalt #-} + +instance ToJSON PowHashAlg where + toJSON = toJSON . fromEnum + {-# INLINE toJSON #-} + +-- FIXME use Enum instance +instance FromJSON PowHashAlg where + parseJSON = withScientific "PowHashAlg" $ \case + 0 -> return PowHash_Blake2s + 1 -> return PowHash_Sha256 + x -> fail $ "unknow POW hash algorithm code: " <> sshow x + {-# INLINE parseJSON #-} + +-- -------------------------------------------------------------------------- -- +-- POW Hash Selection + +-- | Hash algorithm that are supported by a given Chainweb Version. +-- +-- A chainweb version can support more than a single algorithm. Each algorithm +-- has an difficulty adjustment factor, that is used as a multiplier on the +-- result before comparing with the target. A value of 0 means that the outcome +-- is always smaller than the target, and thus any nonce succeeds. A value of 1 +-- leaves the target unchanged. Larger values make it more difficult to find +-- nonce. +-- +-- Only natural numbers are supported for adjusting the difficulty. +-- Multiplication uses 'Chainweb.PowHashNat' as defined in +-- "Chainweb.Difficulty". +-- +powHashAlg :: ChainwebVersion -> BlockHeight -> NE.NonEmpty (PowHashAlg, Natural) +powHashAlg Test{} _ = (PowHash_Blake2s, 1) NE.:| [] +powHashAlg TimedConsensus{} _ = (PowHash_Blake2s, 1) NE.:| [] +powHashAlg PowConsensus{} _ = (PowHash_Blake2s, 1) NE.:| [] +powHashAlg TimedCPM{} _ = (PowHash_Blake2s, 1) NE.:| [] +powHashAlg FastTimedCPM{} _ = (PowHash_Blake2s, 1) NE.:| [] + +powHashAlg Development h = (PowHash_Blake2s, a) NE.:| [(PowHash_Sha256, b)] + where + -- The transition starts at block height 250 has 10 steps and take about 20h + (a, b) = transition 250 10 240 (int h) + +powHashAlg Testnet04 _ = (PowHash_Blake2s, 1) NE.:| [] +powHashAlg Mainnet01 _ = (PowHash_Blake2s, 1) NE.:| [] + +-- | This function is meant mostly for testing. For mainnet transitions it is +-- recommend to encode the transition explicitely as a table. +-- +-- @stepDuration@ should be at least @2 * 120@, i.e. two DA epochs or about 2 +-- hours. In mainnet, @stepDurantion@ should probably be in the order of days +-- anyways. +-- +transition :: Natural -> Natural -> Natural -> Natural -> (Natural, Natural) +transition start stepCount stepDuration = bimap (+1) (+1) . go + where + go h + | h < start = (0, stepCount) + | h < start + (stepCount * stepDuration) = (i, stepCount - i) + | otherwise = (stepCount, 0) + where + i = (h - start) `div` stepDuration + +defaultPowHashAlg :: HasChainwebVersion v => v -> BlockHeight -> PowHashAlg +defaultPowHashAlg v h = fst $ NE.head $ powHashAlg (_chainwebVersion v) h + +-- -------------------------------------------------------------------------- -- +-- POW hash implementations + +-- | POW hash algorithm implemenations +-- +powHash :: PowHashAlg -> B.ByteString -> PowHash +powHash PowHash_Blake2s = cryptoHash @Blake2s_256 +powHash PowHash_Sha256 = cryptoHash @SHA256 + -- | This must be used only for testing. The result hash is uniformily -- distributed, but not cryptographically safe. -- randomPowHash :: MonadIO m => m PowHash randomPowHash = PowHash . SB.toShort <$> liftIO (BR.random powHashBytesCount) --- -------------------------------------------------------------------------- -- --- Cryptographic Hash - -powHash :: ChainwebVersion -> B.ByteString -> PowHash -powHash Test{} = cryptoHash @Blake2s_256 -powHash TimedConsensus{} = cryptoHash @Blake2s_256 -powHash PowConsensus{} = cryptoHash @Blake2s_256 -powHash TimedCPM{} = cryptoHash @Blake2s_256 -powHash FastTimedCPM{} = cryptoHash @Blake2s_256 -powHash Development = cryptoHash @Blake2s_256 -powHash Testnet04 = cryptoHash @Blake2s_256 -powHash Mainnet01 = cryptoHash @Blake2s_256 - cryptoHash :: forall a . HashAlgorithm a => B.ByteString -> PowHash -cryptoHash = PowHash . SB.toShort . BA.convert . C.hash @_ @a +cryptoHash = unsafeMkPowHash . BA.convert . C.hash @_ @a + -- + -- The usage of unsafeMkPowHash is justified here becaue we want to fail + -- (and actually we *will* fail) early and hard if we'd chose and invalid + -- hash algorithm. + -- + -- The overhead of using a smart constructor is justified because in-node + -- mining isn't competitive in mainnet. This implementation of the hash + -- function is only used for validation and during testing. + diff --git a/src/Chainweb/RestAPI/Orphans.hs b/src/Chainweb/RestAPI/Orphans.hs index d848b37fea..48a99818c4 100644 --- a/src/Chainweb/RestAPI/Orphans.hs +++ b/src/Chainweb/RestAPI/Orphans.hs @@ -49,6 +49,7 @@ import Servant.API import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeaderDB +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Cut.CutHashes import Chainweb.Difficulty hiding (properties) diff --git a/src/Chainweb/SPV.hs b/src/Chainweb/SPV.hs index 7ce9150841..e30e4510d4 100644 --- a/src/Chainweb/SPV.hs +++ b/src/Chainweb/SPV.hs @@ -40,6 +40,7 @@ import Prelude hiding (lookup) -- internal modules import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Utils diff --git a/src/Chainweb/SPV/CreateProof.hs b/src/Chainweb/SPV/CreateProof.hs index 2d7757e29d..a7c3a388e3 100644 --- a/src/Chainweb/SPV/CreateProof.hs +++ b/src/Chainweb/SPV/CreateProof.hs @@ -42,6 +42,7 @@ import Prelude hiding (lookup) import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Crypto.MerkleLog import Chainweb.CutDB diff --git a/src/Chainweb/SPV/RestAPI.hs b/src/Chainweb/SPV/RestAPI.hs index b0a871a59a..f8fe79ef89 100644 --- a/src/Chainweb/SPV/RestAPI.hs +++ b/src/Chainweb/SPV/RestAPI.hs @@ -44,7 +44,7 @@ import Servant.API -- internal modules -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.RestAPI.Orphans () import Chainweb.RestAPI.Utils diff --git a/src/Chainweb/SPV/RestAPI/Client.hs b/src/Chainweb/SPV/RestAPI/Client.hs index a3a3b6298e..18c547bfaa 100644 --- a/src/Chainweb/SPV/RestAPI/Client.hs +++ b/src/Chainweb/SPV/RestAPI/Client.hs @@ -32,7 +32,7 @@ import Servant.Client -- internal modules -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.SPV import Chainweb.SPV.RestAPI diff --git a/src/Chainweb/SPV/RestAPI/Server.hs b/src/Chainweb/SPV/RestAPI/Server.hs index 0959040f18..01c5a8436b 100644 --- a/src/Chainweb/SPV/RestAPI/Server.hs +++ b/src/Chainweb/SPV/RestAPI/Server.hs @@ -39,7 +39,7 @@ import Servant -- internal modules -import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.CutDB import Chainweb.Payload.PayloadStore diff --git a/src/Chainweb/WebPactExecutionService/Types.hs b/src/Chainweb/WebPactExecutionService/Types.hs index ccb528878e..22609e05ef 100644 --- a/src/Chainweb/WebPactExecutionService/Types.hs +++ b/src/Chainweb/WebPactExecutionService/Types.hs @@ -13,6 +13,7 @@ import Pact.Types.Hash import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Mempool.Mempool (InsertError) import Chainweb.Miner.Pact diff --git a/test/Chainweb/Test/CutDB.hs b/test/Chainweb/Test/CutDB.hs index f18276bd6a..176e1b686c 100644 --- a/test/Chainweb/Test/CutDB.hs +++ b/test/Chainweb/Test/CutDB.hs @@ -59,6 +59,7 @@ import Pact.Types.Hash (Hash) -- internal modules import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Cut import Chainweb.Cut.CutHashes diff --git a/test/Chainweb/Test/Mempool/Consensus.hs b/test/Chainweb/Test/Mempool/Consensus.hs index 2874bf7ab5..de17f9bbb1 100644 --- a/test/Chainweb/Test/Mempool/Consensus.hs +++ b/test/Chainweb/Test/Mempool/Consensus.hs @@ -41,6 +41,7 @@ import Chainweb.Crypto.MerkleLog hiding (header) import Chainweb.Difficulty (targetToDifficulty) import Chainweb.Mempool.Consensus import Chainweb.Mempool.Mempool +import Chainweb.PowHash import Chainweb.Test.Utils import Chainweb.Time import qualified Chainweb.TreeDB as TreeDB @@ -341,7 +342,7 @@ header' h = do :+: succ (_blockHeight h) :+: v :+: epochStart h t' - :+: FeatureFlags 0 + :+: mkFeatureFlags (defaultPowHashAlg v (_blockHeight h + 1)) :+: MerkleLogBody mempty where BlockCreationTime t = _blockCreationTime h diff --git a/test/Chainweb/Test/MultiNode.hs b/test/Chainweb/Test/MultiNode.hs index e815fdc439..8ee064efc9 100644 --- a/test/Chainweb/Test/MultiNode.hs +++ b/test/Chainweb/Test/MultiNode.hs @@ -74,6 +74,7 @@ import Test.Tasty.HUnit import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Chainweb import Chainweb.Chainweb.CutResources import Chainweb.Chainweb.PeerResources diff --git a/test/Chainweb/Test/Orphans/Internal.hs b/test/Chainweb/Test/Orphans/Internal.hs index 27615f3d27..186725a33e 100644 --- a/test/Chainweb/Test/Orphans/Internal.hs +++ b/test/Chainweb/Test/Orphans/Internal.hs @@ -27,6 +27,7 @@ import Test.QuickCheck.Gen (chooseAny) import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Crypto.MerkleLog import Chainweb.Difficulty @@ -113,8 +114,11 @@ instance Arbitrary BlockCreationTime where instance Arbitrary EpochStartTime where arbitrary = EpochStartTime <$> arbitrary +instance Arbitrary PowHashAlg where + arbitrary = elements [ PowHash_Blake2s, PowHash_Sha256 ] + instance Arbitrary FeatureFlags where - arbitrary = FeatureFlags <$> arbitrary + arbitrary = mkFeatureFlags <$> arbitrary instance Arbitrary BlockHeader where arbitrary = fromLog . newMerkleLog <$> entries diff --git a/test/Chainweb/Test/Pact/ChainData.hs b/test/Chainweb/Test/Pact/ChainData.hs index 004afff170..35683c839f 100644 --- a/test/Chainweb/Test/Pact/ChainData.hs +++ b/test/Chainweb/Test/Pact/ChainData.hs @@ -38,6 +38,7 @@ import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis import Chainweb.BlockHeaderDB hiding (withBlockHeaderDb) +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Difficulty import Chainweb.Mempool.Mempool (MempoolPreBlockCheck) @@ -48,6 +49,7 @@ import Chainweb.Pact.Service.BlockValidation import Chainweb.Pact.Service.PactQueue import Chainweb.Payload import Chainweb.Payload.PayloadStore.Types +import Chainweb.PowHash import Chainweb.Test.Pact.Utils import Chainweb.Test.Utils import Chainweb.Time @@ -171,6 +173,7 @@ mineBlock parentHeader nonce iopdb iobhdb r = do let bh = newBlockHeader (BlockHashRecord mempty) (_payloadWithOutputsPayloadHash payload) + (defaultPowHashAlg (_chainwebVersion parentHeader) (_blockHeight parentHeader + 1)) nonce creationTime (ParentHeader parentHeader) diff --git a/test/Chainweb/Test/Pact/Checkpointer.hs b/test/Chainweb/Test/Pact/Checkpointer.hs index 21174d659f..8133ac832f 100644 --- a/test/Chainweb/Test/Pact/Checkpointer.hs +++ b/test/Chainweb/Test/Pact/Checkpointer.hs @@ -41,7 +41,7 @@ import Test.Tasty.HUnit -- internal imports import Chainweb.BlockHash (BlockHash(..), nullBlockHash) -import Chainweb.BlockHeader (BlockHeight(..)) +import Chainweb.BlockHeight (BlockHeight(..)) import Chainweb.MerkleLogHash (merkleLogHash) import Chainweb.Pact.Backend.ChainwebPactDb import Chainweb.Pact.Backend.InMemoryCheckpointer (initInMemoryCheckpointEnv) diff --git a/test/Chainweb/Test/Pact/PactReplay.hs b/test/Chainweb/Test/Pact/PactReplay.hs index f4f32b80e8..d8b237c2e1 100644 --- a/test/Chainweb/Test/Pact/PactReplay.hs +++ b/test/Chainweb/Test/Pact/PactReplay.hs @@ -40,6 +40,7 @@ import Chainweb.BlockHash import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis import Chainweb.BlockHeaderDB hiding (withBlockHeaderDb) +import Chainweb.BlockHeight import Chainweb.Difficulty import Chainweb.Miner.Core (HeaderBytes(..), TargetBytes(..), mine, usePowHash) import Chainweb.Miner.Pact @@ -48,6 +49,7 @@ import Chainweb.Pact.Service.BlockValidation import Chainweb.Pact.Service.PactQueue import Chainweb.Payload import Chainweb.Payload.PayloadStore.Types +import Chainweb.PowHash import Chainweb.Test.Pact.Utils import Chainweb.Test.Utils import Chainweb.Time @@ -286,6 +288,7 @@ mineBlock parentHeader nonce iopdb iobhdb r = do let bh = newBlockHeader (BlockHashRecord mempty) (_payloadWithOutputsPayloadHash payload) + (defaultPowHashAlg (_chainwebVersion parentHeader) (_blockHeight parentHeader + 1)) nonce creationTime (ParentHeader parentHeader) diff --git a/test/Chainweb/Test/Pact/SPV.hs b/test/Chainweb/Test/Pact/SPV.hs index 4b5a86bebd..3a3688719a 100644 --- a/test/Chainweb/Test/Pact/SPV.hs +++ b/test/Chainweb/Test/Pact/SPV.hs @@ -69,6 +69,7 @@ import Pact.Types.Term import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Cut import Chainweb.CutDB diff --git a/test/Chainweb/Test/Pact/TTL.hs b/test/Chainweb/Test/Pact/TTL.hs index a365ccd8e0..5d471cc7ae 100644 --- a/test/Chainweb/Test/Pact/TTL.hs +++ b/test/Chainweb/Test/Pact/TTL.hs @@ -36,6 +36,7 @@ import Pact.Types.ChainMeta import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.BlockHeader.Genesis import Chainweb.BlockHeaderDB hiding (withBlockHeaderDb) import Chainweb.Difficulty @@ -46,6 +47,7 @@ import Chainweb.Pact.Service.BlockValidation import Chainweb.Pact.Service.PactQueue import Chainweb.Payload import Chainweb.Payload.PayloadStore.Types +import Chainweb.PowHash import Chainweb.Test.Pact.Utils import Chainweb.Test.Utils import Chainweb.Time @@ -195,6 +197,7 @@ mineBlock parentHeader nonce iopdb iobhdb r = do let bh = newBlockHeader (BlockHashRecord mempty) (_payloadWithOutputsPayloadHash payload) + (defaultPowHashAlg (_chainwebVersion parentHeader) (_blockHeight parentHeader + 1)) nonce creationTime (ParentHeader parentHeader) diff --git a/test/Chainweb/Test/Pact/TransactionTests.hs b/test/Chainweb/Test/Pact/TransactionTests.hs index b31e838e38..9343ae2fd8 100644 --- a/test/Chainweb/Test/Pact/TransactionTests.hs +++ b/test/Chainweb/Test/Pact/TransactionTests.hs @@ -25,7 +25,6 @@ import Control.Monad import Data.Aeson import Data.Aeson.Lens import Data.Foldable (for_, traverse_) -import Data.Functor (void) import Data.Text (isInfixOf,unpack) import Data.Default import Data.Tuple.Strict (T2(..)) @@ -49,6 +48,7 @@ import Pact.Types.SPV -- internal chainweb modules import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.Miner.Pact import Chainweb.Pact.Templates import Chainweb.Pact.TransactionExec diff --git a/test/Chainweb/Test/Pact/Utils.hs b/test/Chainweb/Test/Pact/Utils.hs index dc32e9db55..68eb3a2dc4 100644 --- a/test/Chainweb/Test/Pact/Utils.hs +++ b/test/Chainweb/Test/Pact/Utils.hs @@ -130,6 +130,7 @@ import Pact.Types.Util (toB16Text) import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis import Chainweb.BlockHeaderDB hiding (withBlockHeaderDb) +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Logger import Chainweb.Miner.Pact diff --git a/test/Chainweb/Test/Roundtrips.hs b/test/Chainweb/Test/Roundtrips.hs index ca5e10c294..b6397c627c 100644 --- a/test/Chainweb/Test/Roundtrips.hs +++ b/test/Chainweb/Test/Roundtrips.hs @@ -29,6 +29,7 @@ import Test.QuickCheck.Instances () import Chainweb.BlockHash import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Difficulty import Chainweb.HostAddress @@ -87,6 +88,8 @@ encodeDecodeTests = testGroup "Encode-Decode roundtrips" $ prop_encodeDecodeRoundtrip decodeHashTarget encodeHashTarget , testProperty "BlockWeight" $ prop_encodeDecodeRoundtrip decodeBlockWeight encodeBlockWeight + , testProperty "BlockWeight" + $ prop_encodeDecodeRoundtrip decodePowHashAlg encodePowHashAlg , testProperty "BlockHashRecord" $ prop_encodeDecodeRoundtrip decodeBlockHashRecord encodeBlockHashRecord @@ -146,6 +149,7 @@ jsonTestCases f = , testProperty "PeerId" $ f @PeerId , testProperty "PeerInfo" $ f @PeerInfo , testProperty "NetworkId" $ f @NetworkId + , testProperty "PowHashAlg" $ f @PowHashAlg , testProperty "BlockPayloadHash" $ f @BlockPayloadHash , testProperty "BlockTransactionsHash" $ f @BlockTransactionsHash diff --git a/test/Chainweb/Test/TreeDB.hs b/test/Chainweb/Test/TreeDB.hs index 323e6cf7ba..d0c31ad0fd 100644 --- a/test/Chainweb/Test/TreeDB.hs +++ b/test/Chainweb/Test/TreeDB.hs @@ -44,9 +44,9 @@ import Chainweb.Utils (len) treeDbInvariants :: (TreeDb db, IsBlockHeader (DbEntry db), Ord (DbEntry db), Ord (DbKey db)) - -- | Given a generic entry, should yield a database for testing, and then - -- safely close it after use. => (DbEntry db -> (db -> IO Bool) -> IO Bool) + -- ^ Given a generic entry, should yield a database for testing, and then + -- safely close it after use. -> RunStyle -> TestTree treeDbInvariants f rs = testGroup "TreeDb Invariants" diff --git a/test/Chainweb/Test/Utils.hs b/test/Chainweb/Test/Utils.hs index df23fb82dc..f1f5c62868 100644 --- a/test/Chainweb/Test/Utils.hs +++ b/test/Chainweb/Test/Utils.hs @@ -150,6 +150,7 @@ import Chainweb.Logger (Logger) import Chainweb.BlockHeader import Chainweb.BlockHeader.Genesis (genesisBlockHeader) import Chainweb.BlockHeaderDB +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Crypto.MerkleLog hiding (header) import Chainweb.CutDB @@ -157,6 +158,7 @@ import Chainweb.Difficulty (targetToDifficulty) import Chainweb.Graph import Chainweb.Mempool.Mempool (MempoolBackend(..)) import Chainweb.Payload.PayloadStore +import Chainweb.PowHash import Chainweb.RestAPI import Chainweb.RestAPI.NetworkID import Chainweb.Test.Orphans.Internal () @@ -356,7 +358,7 @@ header h = do :+: succ (_blockHeight h) :+: v :+: epochStart h t' - :+: FeatureFlags 0 + :+: mkFeatureFlags (defaultPowHashAlg v (_blockHeight h + 1)) :+: MerkleLogBody mempty where BlockCreationTime t = _blockCreationTime h diff --git a/tools/header-dump/HeaderDump.hs b/tools/header-dump/HeaderDump.hs index 18e9f9d555..7f8c7335b2 100644 --- a/tools/header-dump/HeaderDump.hs +++ b/tools/header-dump/HeaderDump.hs @@ -95,6 +95,7 @@ import System.LogLevel -- internal modules import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.BlockHeaderDB import Chainweb.Logger import Chainweb.Miner.Pact diff --git a/tools/standalone/Standalone/Utils.hs b/tools/standalone/Standalone/Utils.hs index e9e7a780f0..07d6a7bfa6 100644 --- a/tools/standalone/Standalone/Utils.hs +++ b/tools/standalone/Standalone/Utils.hs @@ -51,6 +51,7 @@ import Pact.Types.Util hiding (unwrap) -- chainweb imports import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.ChainId import Chainweb.Cut import Chainweb.CutDB diff --git a/tools/test-miner/TestMiner.hs b/tools/test-miner/TestMiner.hs index 72d7c557b1..d0e99c7471 100644 --- a/tools/test-miner/TestMiner.hs +++ b/tools/test-miner/TestMiner.hs @@ -43,6 +43,8 @@ pNumTrials = option auto pOpts :: Parser (Int, Int, FilePath) pOpts = (,,) <$> pTargetZeroes <*> pNumTrials <*> pMiner +powAlg :: PowHashAlg +powAlg = defaultPowHashAlg Testnet04 1 -- make the hex string then hex-decode it makeTarget :: Int -> ByteString @@ -62,7 +64,7 @@ checkMinerOutput nonceB targetBytes blockBytes0 = do return (ok, hashBytes) where !blockBytes = nonceB <> B.drop 8 blockBytes0 - hashBytes = SB.fromShort $ powHashBytes $ powHash Testnet04 blockBytes + hashBytes = SB.fromShort $ powHashBytes $ powHash powAlg blockBytes makeBlock :: IO ByteString makeBlock = MWC.withSystemRandom $ \gen -> do diff --git a/tools/txstream/TxStream.hs b/tools/txstream/TxStream.hs index 477ea8596e..94a624ef94 100644 --- a/tools/txstream/TxStream.hs +++ b/tools/txstream/TxStream.hs @@ -64,6 +64,7 @@ import System.LogLevel -- internal modules import Chainweb.BlockHeader +import Chainweb.BlockHeight import Chainweb.CutDB.RestAPI.Client import Chainweb.HostAddress import Chainweb.Logger