diff --git a/cwtools/ea/Ea.hs b/cwtools/ea/Ea.hs index fbaed6def8..d909ea3277 100644 --- a/cwtools/ea/Ea.hs +++ b/cwtools/ea/Ea.hs @@ -45,7 +45,6 @@ import Chainweb.Utils import Chainweb.Version import Chainweb.Version.Development (pattern Development) import Chainweb.Version.RecapDevelopment (pattern RecapDevelopment) -import Chainweb.Version.Registry (registerVersion) import Control.Concurrent.Async import Control.Exception import Control.Monad.Trans.Resource @@ -81,8 +80,6 @@ import Pact.Core.StableEncoding main :: IO () main = do - registerVersion RecapDevelopment - registerVersion Development mapConcurrently_ id [ devnet diff --git a/cwtools/evm-genesis/Main.hs b/cwtools/evm-genesis/Main.hs index 526d8f87f3..3270a828ef 100644 --- a/cwtools/evm-genesis/Main.hs +++ b/cwtools/evm-genesis/Main.hs @@ -40,15 +40,40 @@ import Control.Retry -- -------------------------------------------------------------------------- -- -- Main +-- | This program generates chain-spec files, genesis blocks, and the respective +-- block hashes for EVMs on Chainweb networks. +-- +-- The results can be used to define the genesis information for the respective +-- networks in the chainweb-node code basis. +-- main :: IO () main = do - cids <- traverse (fromText . T.pack) =<< getArgs + + -- parse command line + (n, cids, spec) <- getArgs >>= \case + [] -> error "No argument for the chainweb version provided. The version must be one of: 'mainnet', 'testnet', 'evm-testnet', or 'evm-development'." + ["mainnet"] -> do + let cids = [20..25] + return ("mainnet", cids, mainnetSpecFile) + ["testnet"] -> do + let cids = [20..25] + return ("testnet", cids, testnetSpecFile) + ["evm-testnet"] -> do + let cids = [20..25] + return ("evm-testnet", cids, evmTestnetSpecFile) + ["evm-development"] -> do + let cids = [20..25] + return ("evm-development", cids, evmDevnetSpecFile) + _ -> error "Invalid argument for the chainweb version provided. The version must be one of: 'mainnet', 'testnet', 'evm-testnet', or 'evm-development'." + hdrs <- forM cids $ \cid -> do - createDirectoryIfMissing True "./chain-specs" - let specFileName = "./chain-specs/chain-spec-" <> show cid <> ".json" - encodeFile specFileName $ specFile cid + let specFileDir = "./chain-specs/" <> n + createDirectoryIfMissing True specFileDir + let specFileName = specFileDir <> "/chain-spec-" <> show cid <> ".json" + encodeFile specFileName $ spec cid hdr <- queryNode cid specFileName return (cid, hdr) + T.putStrLn $ encodeToText [ object [ "chainId" .= cid @@ -128,8 +153,23 @@ mkRpcCtx u = do -- -------------------------------------------------------------------------- -- -- Spec File For EVM Devnet -specFile :: Natural -> Value -specFile cid = object [ +-- | Intended only for local development and testing. It is not intended for use +-- with public networks. +-- +-- The keys for all allocations are publicly known. +-- +-- The Ethereum network chain ids are not officially registered and overlap with +-- the chain ids of other networks. +-- +-- The configuration of the network may change at any time. +-- +-- EVMs are available at block height 0. +-- +evmDevnetSpecFile + :: Natural + -- numeric chainweb chain id + -> Value +evmDevnetSpecFile cid = object [ "config" .= object [ "chainId" .= (1789 + cid - 20), "daoForkSupport" .= True, @@ -166,6 +206,7 @@ specFile cid = object [ "0x0000000000000000000000000000000000000000000000000000000000000000" .= (printf "0x%064x" cid :: String) ] ], + -- TODO: add native-x-chain system contract "0x8849BAbdDcfC1327Ad199877861B577cEBd8A7b6".= object [ "balance" .= t "0xd3c21bcecceda1000000" ], @@ -240,3 +281,226 @@ specFile cid = object [ i :: Natural -> Natural i = id +-- -------------------------------------------------------------------------- -- +-- Spec File For EVM Testnet + +-- | Used with the public Kadena EVM testnet. This is a temporary feature +-- testnet in preparation for the launch of EVM chains on the Kadena mainet and +-- the regular permanent Kadena testnet. +-- +-- The network is expected to be decommissioned after EVM chains have been +-- launched on the Kadena mainnet. +-- +-- Funds on the network have no economic value. +-- +-- The keys for the genesis allocations are held by the Kadena team. +-- +-- The EVM chains are available at block height 0. +-- +evmTestnetSpecFile + :: Natural + -- ^ numeric chainweb chain id + -> Value +evmTestnetSpecFile cid = object [ + "config" .= object [ + "chainId" .= (1789 + cid - 20), + "daoForkSupport" .= True, + "terminalTotalDifficultyPassed" .= True, + "terminalTotalDifficulty" .= i 0, + "daoForkBlock" .= i 0, + "homesteadBlock" .= i 0, + "eip150Block" .= i 0, + "eip155Block" .= i 0, + "eip158Block" .= i 0, + "byzantiumBlock" .= i 0, + "constantinopleBlock" .= i 0, + "petersburgBlock" .= i 0, + "istanbulBlock" .= i 0, + "muirGlacierBlock" .= i 0, + "berlinBlock" .= i 0, + "londonBlock" .= i 0, + "arrowGlacierBlock" .= i 0, + "graphGlacierBlock" .= i 0, + "mergeForkBlock" .= i 0, + "mergeNetsplitBlock" .= i 0, + "shanghaiTime" .= i 0, + "cancunTime" .= i 0, + "pragueTime" .= i 0 + ], + "timestamp".= t "0x6490fdd2", + "extraData".= t "0x", + "gasLimit".= t "0x1c9c380", + "alloc".= object [ + "0x9b02c3e2df42533e0fd166798b5a616f59dbd2cc".= object [ + "balance".= t "0x0", + "code".= t "0x6080604052348015600f57600080fd5b506004361060285760003560e01c8063973e55d414602d575b600080fd5b600054603c9063ffffffff1681565b60405163ffffffff909116815260200160405180910390f3fea2646970667358221220b716cf70992d0b5a77124b3da9b37629f5625bf265c121cfb76f9714f249119b64736f6c634300081c0033", + "storage".= object [ + "0x0000000000000000000000000000000000000000000000000000000000000000" .= (printf "0x%064x" cid :: String) + ] + ] + -- TODO: Native-X-Chain System contract + -- TODO: funding of faucet + -- TODO: other allocations. + ], + + "number" .= t "0x0", + "nonce" .= t "0x0", + "difficulty" .= t "0x0", + "mixHash" .= t "0x0000000000000000000000000000000000000000000000000000000000000000", + "coinbase" .= t "0x0000000000000000000000000000000000000000" + ] + where + t :: T.Text -> T.Text + t = id + + i :: Natural -> Natural + i = id + +-- -------------------------------------------------------------------------- -- +-- Spec File For Kadena Mainnet + +-- | Used with the public Kadena Mainnet. +-- +-- Allocations are funded out of the platform share of the Kadena mainnet. +-- The keys for the Allocations are not publicly known. +-- +-- The EVM chains are launched at block height TODO. +-- +-- TODO +-- +mainnetSpecFile + :: Natural + -- ^ numeric chainweb chain id + -> Value +mainnetSpecFile cid = object [ + "config" .= object [ + "chainId" .= (3789 + cid - 20), + "daoForkSupport" .= True, + "terminalTotalDifficultyPassed" .= True, + "terminalTotalDifficulty" .= i 0, + "daoForkBlock" .= i 0, + "homesteadBlock" .= i 0, + "eip150Block" .= i 0, + "eip155Block" .= i 0, + "eip158Block" .= i 0, + "byzantiumBlock" .= i 0, + "constantinopleBlock" .= i 0, + "petersburgBlock" .= i 0, + "istanbulBlock" .= i 0, + "muirGlacierBlock" .= i 0, + "berlinBlock" .= i 0, + "londonBlock" .= i 0, + "arrowGlacierBlock" .= i 0, + "graphGlacierBlock" .= i 0, + "mergeForkBlock" .= i 0, + "mergeNetsplitBlock" .= i 0, + "shanghaiTime" .= i 0, + "cancunTime" .= i 0, + "pragueTime" .= i 0 + ], + "timestamp".= t "0x6490fdd2", + "extraData".= t "0x", + "gasLimit".= t "0x1c9c380", + "alloc".= object [ + "0x9b02c3e2df42533e0fd166798b5a616f59dbd2cc".= object [ + "balance".= t "0x0", + "code".= t "0x6080604052348015600f57600080fd5b506004361060285760003560e01c8063973e55d414602d575b600080fd5b600054603c9063ffffffff1681565b60405163ffffffff909116815260200160405180910390f3fea2646970667358221220b716cf70992d0b5a77124b3da9b37629f5625bf265c121cfb76f9714f249119b64736f6c634300081c0033", + "storage".= object [ + "0x0000000000000000000000000000000000000000000000000000000000000000" .= (printf "0x%064x" cid :: String) + ] + ], + error "mainnetSpecFile: the EVM genesis allocations for mainnet are TBD" + -- TODO: Native-X-Chain System contract + -- TODO: other allocations. + ], + + "number" .= error @_ @() "mainnetSpecFile: the initial block height is TBD", -- t "0x0", + "nonce" .= t "0x0", + "difficulty" .= t "0x0", + "mixHash" .= t "0x0000000000000000000000000000000000000000000000000000000000000000", + "coinbase" .= t "0x0000000000000000000000000000000000000000" + ] + where + t :: T.Text -> T.Text + t = id + + i :: Natural -> Natural + i = id + + +-- -------------------------------------------------------------------------- -- +-- Spec File For Kadena Testnet + +-- | Used with the public Kadena testnet. This is a permament testnet that +-- has the same features and properties of the Kadena mainnet. It has the +-- purpose to facilitate testing of services and applications under the same +-- conditions as on the Kadena mainnet. +-- +-- Funds on the network have no economic value. +-- +-- The keys for the genesis allocations are held by the Kadena team. +-- +-- The EVM chains are launched at block height TODO. +-- +-- TODO +-- +testnetSpecFile + :: Natural + -- ^ numeric chainweb chain id + -> Value +testnetSpecFile cid = object [ + "config" .= object [ + "chainId" .= (2789 + cid - 20), + "daoForkSupport" .= True, + "terminalTotalDifficultyPassed" .= True, + "terminalTotalDifficulty" .= i 0, + "daoForkBlock" .= i 0, + "homesteadBlock" .= i 0, + "eip150Block" .= i 0, + "eip155Block" .= i 0, + "eip158Block" .= i 0, + "byzantiumBlock" .= i 0, + "constantinopleBlock" .= i 0, + "petersburgBlock" .= i 0, + "istanbulBlock" .= i 0, + "muirGlacierBlock" .= i 0, + "berlinBlock" .= i 0, + "londonBlock" .= i 0, + "arrowGlacierBlock" .= i 0, + "graphGlacierBlock" .= i 0, + "mergeForkBlock" .= i 0, + "mergeNetsplitBlock" .= i 0, + "shanghaiTime" .= i 0, + "cancunTime" .= i 0, + "pragueTime" .= i 0 + ], + "timestamp".= t "0x6490fdd2", + "extraData".= t "0x", + "gasLimit".= t "0x1c9c380", + "alloc".= object [ + "0x9b02c3e2df42533e0fd166798b5a616f59dbd2cc".= object [ + "balance".= t "0x0", + "code".= t "0x6080604052348015600f57600080fd5b506004361060285760003560e01c8063973e55d414602d575b600080fd5b600054603c9063ffffffff1681565b60405163ffffffff909116815260200160405180910390f3fea2646970667358221220b716cf70992d0b5a77124b3da9b37629f5625bf265c121cfb76f9714f249119b64736f6c634300081c0033", + "storage".= object [ + "0x0000000000000000000000000000000000000000000000000000000000000000" .= (printf "0x%064x" cid :: String) + ] + ], + error "mainnetSpecFile: the EVM genesis allocations for mainnet are TBD" + -- TODO: Native-X-Chain System contract + -- TODO: other allocations. + ], + + "number" .= error @_ @() "mainnetSpecFile: the initial block height is TBD", -- t "0x0", + "nonce" .= t "0x0", + "difficulty" .= t "0x0", + "mixHash" .= t "0x0000000000000000000000000000000000000000000000000000000000000000", + "coinbase" .= t "0x0000000000000000000000000000000000000000" + ] + where + t :: T.Text -> T.Text + t = id + + i :: Natural -> Natural + i = id + + diff --git a/node/src/ChainwebNode.hs b/node/src/ChainwebNode.hs index 36febaa0f2..727be169ee 100644 --- a/node/src/ChainwebNode.hs +++ b/node/src/ChainwebNode.hs @@ -98,7 +98,6 @@ import Chainweb.Utils.RequestLog import Chainweb.Version import Chainweb.Version.Mainnet import Chainweb.Version.Testnet04 (testnet04) -import Chainweb.Version.Registry import Chainweb.Storage.Table.RocksDB @@ -198,7 +197,12 @@ runMonitorLoop actionLabel logger = runForeverThrottled 10 -- 10 bursts in case of failure (10 * mega) -- allow restart every 10 seconds in case of failure -runCutMonitor :: Logger logger => logger -> CutDb -> IO () +runCutMonitor + :: HasVersion + => Logger logger + => logger + -> CutDb + -> IO () runCutMonitor logger db = L.withLoggerLabel ("component", "cut-monitor") logger $ \l -> runMonitorLoop "ChainwebNode.runCutMonitor" l $ do logFunctionJson l Info . cutToCutHashes Nothing @@ -213,7 +217,7 @@ data BlockUpdate = BlockUpdate } deriving (Show, Eq, Ord, Generic, NFData) -instance ToJSON BlockUpdate where +instance HasVersion => ToJSON BlockUpdate where toEncoding o = pairs $ "header" .= _blockUpdateBlockHeader o <> "orphaned" .= _blockUpdateOrphaned o @@ -308,7 +312,7 @@ runDatabaseMonitor logger rocksDbDir pactDbDir = L.withLoggerLabel ("component", -- -------------------------------------------------------------------------- -- -- Run Node -node :: HasCallStack => Logger logger => ChainwebNodeConfiguration -> logger -> IO () +node :: HasCallStack => HasVersion => Logger logger => ChainwebNodeConfiguration -> logger -> IO () node conf logger = do rocksDbDir <- getRocksDbDir conf pactDbDir <- getPactDbDir conf @@ -345,7 +349,8 @@ node conf logger = do cwConf = _nodeConfigChainweb conf withNodeLogger - :: LogConfig + :: HasVersion + => LogConfig -> ChainwebConfiguration -> ChainwebVersion -> (L.Logger SomeLogMessage -> IO ()) @@ -530,21 +535,20 @@ main = do installFatalSignalHandlers [ sigHUP, sigTERM, sigXCPU, sigXFSZ ] checkRLimits runWithPkgInfoConfiguration mainInfo pkgInfo $ \conf -> do - let v = _configChainwebVersion $ _nodeConfigChainweb conf - registerVersion v - hSetBuffering stderr LineBuffering - withNodeLogger (_nodeConfigLog conf) (_nodeConfigChainweb conf) v $ \logger -> do - logFunctionJson logger Info ProcessStarted - handles - [ Handler $ \(e :: SomeAsyncException) -> - logFunctionJson logger Info (ProcessDied $ show e) >> throwIO e - , Handler $ \(e :: SomeException) -> - logFunctionJson logger Error (ProcessDied $ show e) >> throwIO e - ] $ do - kt <- mapM iso8601ParseM (_versionServiceDate v) - withServiceDate (_configChainwebVersion (_nodeConfigChainweb conf)) (logFunctionText logger) kt $ void $ - race (node conf logger) (gcRunner (logFunctionText logger)) - where + withVersion (_configChainwebVersion $ _nodeConfigChainweb conf) $ do + hSetBuffering stderr LineBuffering + withNodeLogger (_nodeConfigLog conf) (_nodeConfigChainweb conf) implicitVersion $ \logger -> do + logFunctionJson logger Info ProcessStarted + handles + [ Handler $ \(e :: SomeAsyncException) -> + logFunctionJson logger Info (ProcessDied $ show e) >> throwIO e + , Handler $ \(e :: SomeException) -> + logFunctionJson logger Error (ProcessDied $ show e) >> throwIO e + ] $ do + kt <- mapM iso8601ParseM (_versionServiceDate implicitVersion) + withServiceDate (_configChainwebVersion (_nodeConfigChainweb conf)) (logFunctionText logger) kt $ void $ + race (node conf logger) (gcRunner (logFunctionText logger)) + where gcRunner lf = runForever lf "GarbageCollect" $ do performMajorGC threadDelay (30 * 1_000_000) diff --git a/src/Chainweb/Chainweb.hs b/src/Chainweb/Chainweb.hs index ca0cf2d2e6..1606df282a 100644 --- a/src/Chainweb/Chainweb.hs +++ b/src/Chainweb/Chainweb.hs @@ -61,6 +61,7 @@ module Chainweb.Chainweb , chainwebConfig , chainwebServiceSocket , chainwebBackup +, chainwebManager , StartedChainweb(..) , ChainwebStatus(..) , NowServing(..) @@ -211,9 +212,9 @@ withChainweb -> FilePath -> (StartedChainweb logger -> IO ()) -> IO () -withChainweb c logger rocksDb pactDbDir backupDir inner = +withChainweb c logger rocksDb defaultPactDbDir backupDir inner = withVersion (c ^. configChainwebVersion) $ - withPeerResources (view configP2p confWithBootstraps) logger $ \logger' peerRes -> + withPeerResources (view configP2p confWithBootstraps) logger $ \logger' peerRes -> do withSocket serviceApiPort serviceApiHost $ \serviceSock -> do let conf' = confWithBootstraps & set configP2p (_peerResConfig peerRes) @@ -224,7 +225,7 @@ withChainweb c logger rocksDb pactDbDir backupDir inner = peerRes serviceSock rocksDb - pactDbDir + defaultPactDbDir backupDir inner where @@ -273,7 +274,7 @@ withChainwebInternal -> FilePath -> (StartedChainweb logger -> IO ()) -> IO () -withChainwebInternal conf logger peerRes serviceSock rocksDb pactDbDir backupDir inner = do +withChainwebInternal conf logger peerRes serviceSock rocksDb defaultPactDbDir backupDir inner = do logFunctionJson logger Info InitializingChainResources txFailuresCounter <- newCounter @"txFailures" let monitorTxFailuresCounter = @@ -282,7 +283,7 @@ withChainwebInternal conf logger peerRes serviceSock rocksDb pactDbDir backupDir logFunctionCounter logger Info . (:[]) =<< roll txFailuresCounter logg Debug "start initializing chain resources" - logFunctionText logger Info $ "opening pact db in directory " <> sshow pactDbDir + logFunctionText logger Info $ "opening pact db in directory " <> sshow defaultPactDbDir withAsync monitorTxFailuresCounter $ \_ -> concurrentWith -- initialize chains concurrently @@ -294,7 +295,7 @@ withChainwebInternal conf logger peerRes serviceSock rocksDb pactDbDir backupDir cid rocksDb (_peerResManager peerRes) - pactDbDir + defaultPactDbDir (_peerResConfig peerRes) myInfo peerDb @@ -511,7 +512,7 @@ withChainwebInternal conf logger peerRes serviceSock rocksDb pactDbDir backupDir , _chainwebBackup = BackupEnv { _backupRocksDb = rocksDb , _backupDir = backupDir - , _backupPactDbDir = pactDbDir + , _backupPactDbDir = defaultPactDbDir , _backupChainIds = cids , _backupLogger = backupLogger } @@ -519,7 +520,10 @@ withChainwebInternal conf logger peerRes serviceSock rocksDb pactDbDir backupDir synchronizeProviders :: WebBlockHeaderDb -> ChainMap ConfiguredPayloadProvider -> Cut -> IO () synchronizeProviders wbh providers c = do - mapConcurrently_ syncOne (_cutHeaders c) + let startHeaders = HM.unionWith (\startHeader _genesisHeader -> startHeader) + (_cutHeaders c) + (imap (\cid () -> genesisBlockHeader cid) (HS.toMap chainIds)) + mapConcurrently_ syncOne startHeaders where syncOne hdr = forM_ (providers ^? atChain (_chainId hdr)) $ \case ConfiguredPayloadProvider provider -> do @@ -701,8 +705,6 @@ runChainweb cw nowServing = do -- I.e. the handler would be created in the chain resource. -- Similar to how it is done with the payload provider APIs. -- - -- chainDbsToServe :: [(ChainId, BlockHeaderDb)] - -- chainDbsToServe = proj _chainResBlockHeaderDb chainDbsToServe :: ChainMap BlockHeaderDb chainDbsToServe = _chainResBlockHeaderDb <$> _chainwebChains cw diff --git a/src/Chainweb/Chainweb/ChainResources.hs b/src/Chainweb/Chainweb/ChainResources.hs index 6ce0a34ae2..95f18f74f0 100644 --- a/src/Chainweb/Chainweb/ChainResources.hs +++ b/src/Chainweb/Chainweb/ChainResources.hs @@ -57,7 +57,6 @@ module Chainweb.Chainweb.ChainResources , payloadServiceApiResources ) where -import Control.Exception(evaluate) import Control.Lens hiding ((.=), (<.>)) import Control.Monad.IO.Class import Control.Monad.Trans.Resource @@ -233,9 +232,13 @@ withPayloadProviderResources -- ^ the reorg limit for the payload providers -> Bool -- ^ whether to allow unlimited rewind on startup + -> FilePath + -- ^ default database directory for pact databases. As long as Pact + -- payload providers live within chainweb-consensus they inherit the + -- default db location from the chainweb configuration. -> PayloadProviderConfig -> ResourceT IO ProviderResources -withPayloadProviderResources logger cid p2pConfig myInfo peerDb rdb mgr rewindLimit initialUnlimitedRewind configs = do +withPayloadProviderResources logger cid p2pConfig myInfo peerDb rdb mgr rewindLimit initialUnlimitedRewind defaultPactDbDir configs = do SomeChainwebVersionT @v' _ <- return $ someChainwebVersionVal SomeChainIdT @c' _ <- return $ someChainIdVal cid withSomeSing provider $ \case @@ -294,7 +297,9 @@ withPayloadProviderResources logger cid p2pConfig myInfo peerDb rdb mgr rewindLi } let pdb = newPayloadDb rdb - pactDbDir <- liftIO $ evaluate $ fromJuste $ _pactConfigDatabaseDirectory conf + let pactDbDir = case _pactConfigDatabaseDirectory conf of + Just x -> x + Nothing -> defaultPactDbDir rec pp <- withPactPayloadProvider @@ -400,7 +405,9 @@ withChainResources -> RocksDb -> HTTP.Manager -> FilePath - -- ^ database directory for pact databases + -- ^ default database directory for pact databases. As long as Pact + -- payload providers live within chainweb-consensus they inherit the + -- default db location from the chainweb configuration. -> P2pConfiguration -> PeerInfo -> PeerDb @@ -410,7 +417,7 @@ withChainResources -- ^ whether to allow unlimited rewind on startup -> PayloadProviderConfig -> ResourceT IO (ChainResources logger) -withChainResources logger cid rdb mgr _pactDbDir p2pConf myInfo peerDb rewindLimit initialUnlimitedRewind configs = do +withChainResources logger cid rdb mgr defaultPactDbDir p2pConf myInfo peerDb rewindLimit initialUnlimitedRewind configs = do -- This uses the the CutNetwork for fetching block headers. cdb <- withBlockHeaderDb rdb cid @@ -418,7 +425,7 @@ withChainResources logger cid rdb mgr _pactDbDir p2pConf myInfo peerDb rewindLim -- Payload Providers are using per chain payload networks for fetching -- block headers. provider <- withPayloadProviderResources - providerLogger cid p2pConf myInfo peerDb rdb mgr rewindLimit initialUnlimitedRewind configs + providerLogger cid p2pConf myInfo peerDb rdb mgr rewindLimit initialUnlimitedRewind defaultPactDbDir configs return ChainResources { _chainResBlockHeaderDb = cdb diff --git a/src/Chainweb/Chainweb/PeerResources.hs b/src/Chainweb/Chainweb/PeerResources.hs index fe3ca1b6e1..43535622e0 100644 --- a/src/Chainweb/Chainweb/PeerResources.hs +++ b/src/Chainweb/Chainweb/PeerResources.hs @@ -127,7 +127,6 @@ withPeerResources conf logger inner = withPeerSocket conf $ \(conf', sock) -> do withPeerDb_ conf' $ \peerDb -> do (!mgr, !counter) <- connectionManager peerDb withHost mgr conf' logger $ \conf'' -> do - peer <- unsafeCreatePeer $ _p2pConfigPeer conf'' let pinf = _peerInfo peer @@ -228,7 +227,7 @@ getHost mgr logger peers = do -- Allocate Socket withPeerSocket :: P2pConfiguration -> ((P2pConfiguration, Socket) -> IO a) -> IO a -withPeerSocket conf act = withSocket port interface $ \(p, s) -> +withPeerSocket conf act = withSocket port interface $ \(p, s) -> do act (set (p2pConfigPeer . peerConfigPort) p conf, s) where port = _peerConfigPort $ _p2pConfigPeer conf diff --git a/src/Chainweb/Cut.hs b/src/Chainweb/Cut.hs index 68204bfcf7..d1946f8734 100644 --- a/src/Chainweb/Cut.hs +++ b/src/Chainweb/Cut.hs @@ -59,10 +59,6 @@ module Chainweb.Cut , cutAdjPairs , cutAdjs , lookupCutM -, forkDepth -, limitCut -, tryLimitCut -, limitCutHeaders , unsafeMkCut , chainHeights @@ -78,23 +74,6 @@ module Chainweb.Cut , checkBraidingOfCutPair , isBraidingOfCutPair --- * Extending Cuts -, isMonotonicCutExtension -, monotonicCutExtension -, tryMonotonicCutExtension - --- * Join -, Join(..) -, join -, applyJoin -, prioritizeHeavier -, prioritizeHeavier_ -, joinIntoHeavier -, joinIntoHeavier_ - --- * Meet -, meet - ) where import Control.DeepSeq @@ -110,14 +89,12 @@ import Data.Function import Data.Functor.Of import qualified Data.HashMap.Strict as HM import qualified Data.HashSet as HS -import qualified Data.Heap as H import qualified Data.List as List import Data.Maybe (fromMaybe) import Data.Monoid import Data.Ord import Data.Text (Text) import qualified Data.Text as T -import Data.These import GHC.Generics (Generic) import GHC.Stack @@ -331,175 +308,6 @@ chainHeights :: Cut -> [BlockHeight] chainHeights = fmap (view blockHeight) . toList . _cutHeaders {-# INLINE chainHeights #-} --- -------------------------------------------------------------------------- -- --- Tools for Graph Transitions --- --- These functions are used to adjust the available chains during construction --- of new cuts: --- --- * 'monotonicCutExtension' and 'tryMonotonicCutExtension': extend the --- resulting cut with genesis headers of new chains. --- --- * 'limitCut': project out chains that don't exist in the result cut. --- --- * 'join' and 'applyJoin': add chains from both cuts to the input cuts, so --- that all chains are available in the join base and can be restored during --- 'applyJoin'; project out non-existing chains in the result. --- --- The graph is determined by the /minimum/ height of the blocks in the cut. --- --- The minimum is used to ensure that cuts in a new graph only exist when /all/ --- blocks are on the new cut. This means the new chains are included only if all --- old chains have transitioned to the minimum block height of the new graph. - -cutHeadersMinHeight :: HM.HashMap ChainId BlockHeader -> BlockHeight -cutHeadersMinHeight = minimum . fmap (view blockHeight) -{-# INLINE cutHeadersMinHeight #-} - --- | The function projects onto the chains available at the minimum block height --- in input headers. --- --- At a graph change chains are considered blocked until "all" chains performed --- the transition to the new graph. Thus, a block in the new graph has all of --- its dependencies available. --- --- This an internal function. The result is meaningful only if the input headers --- form a valid cut. In particular, the input must not be empty. --- -projectChains - :: HasVersion - => HM.HashMap ChainId BlockHeader - -> HM.HashMap ChainId BlockHeader -projectChains m = HM.intersection m - $ HS.toMap - $ chainIdsAt (cutHeadersMinHeight m) -{-# INLINE projectChains #-} - -cutProjectChains :: HasVersion => Cut -> Cut -cutProjectChains c = unsafeMkCut $ projectChains $ _cutHeaders c - where -{-# INLINE cutProjectChains #-} - --- | Extend the chains for the graph at the minimum block height of the input --- headers. If a header for a chain is missing the genesis block header for that --- chain is added. --- --- This an internal function. The result is meaningful only if the input headers --- form a valid cut. In particular, the input must not be empty. --- -extendChains - :: HasVersion - => HM.HashMap ChainId BlockHeader - -> HM.HashMap ChainId BlockHeader -extendChains m = HM.union m - $ genesisBlockHeadersAtHeight (cutHeadersMinHeight m) -{-# INLINE extendChains #-} - --- | This function adds all chains that are available in either of the input --- headers. It is assumed that both input header maps are contain headers for --- all chains for the graph at the respective minimum height of the headers. --- --- This function is used when dealing with joins that internally compute an --- intersection on the blocks on all chains, but the goal is to preserve blocks --- from all chains. --- --- This an internal function. The result is meaningful only if the input headers --- form a valid cut. In particular, the input must not be empty. --- -joinChains - :: HasVersion - => HM.HashMap ChainId BlockHeader - -> HM.HashMap ChainId BlockHeader - -> (HM.HashMap ChainId BlockHeader, HM.HashMap ChainId BlockHeader) -joinChains a b = (HM.union a c, HM.union b c) - where - c = genesisBlockHeader <$> a <> b -{-# INLINE joinChains #-} - --- -------------------------------------------------------------------------- -- --- Limit Cut Hashes By Height - --- | Find a `Cut` that is a predecessor of the given one, and that has a block --- height that is smaller or equal the given height. --- --- If the requested limit is larger or equal to the current height, the given --- cut is returned. --- --- Otherwise, the predecessor of the given cut at the given height on each chain --- is returned. --- -limitCut - :: (HasCallStack, HasVersion) - => WebBlockHeaderDb - -> BlockHeight - -- ^ upper bound for the block height of each chain. This is not a tight - -- bound. - -> Cut - -> IO Cut -limitCut wdb h c - | all (\bh -> h >= view blockHeight bh) (view cutHeaders c) = - return c - | otherwise = do - hdrs <- itraverse go $ view cutHeaders c - return $! unsafeMkCut $ projectChains $ HM.mapMaybe id hdrs - where - - go :: ChainId -> BlockHeader -> IO (Maybe BlockHeader) - go cid bh = do - if h >= view blockHeight bh - then return (Just bh) - else do - !db <- getWebBlockHeaderDb wdb cid - seekAncestor db bh (min (int $ view blockHeight bh) (int h)) - -- this is safe because it's guaranteed that the requested rank is - -- smaller then the block height of the argument - --- | Find a `Cut` that is a predecessor of the given one, and that has a block --- height that is as low as possible while not exceeding the given height and --- including all of the chains in the given cut. --- --- If the requested limit is larger or equal to the current height, the given --- cut is returned. --- -tryLimitCut - :: (HasCallStack, HasVersion) - => WebBlockHeaderDb - -> BlockHeight - -- upper bound for the block height of each chain. This is not a tight bound. - -> Cut - -> IO Cut -tryLimitCut wdb h c - | all (\bh -> h >= view blockHeight bh) (view cutHeaders c) = - return c - | otherwise = do - hdrs <- itraverse go $ view cutHeaders c - return $! unsafeMkCut hdrs - where - go :: ChainId -> BlockHeader -> IO BlockHeader - go cid bh = do - if h >= view blockHeight bh - then return bh - else do - !db <- getWebBlockHeaderDb wdb cid - -- this is safe because it's guaranteed that the requested rank is - -- smaller then the block height of the argument - let ancestorHeight = min (int $ view blockHeight bh) (int h) - if ancestorHeight <= fromIntegral (genesisHeight cid) - then return $ genesisBlockHeader cid - else fromJuste <$> seekAncestor db bh ancestorHeight - --- | The resulting headers are valid cut headers only if the input headers are --- valid cut headers, too. The inverse is not true. --- -limitCutHeaders - :: (HasCallStack, HasVersion) - => WebBlockHeaderDb - -> BlockHeight - -- ^ upper bound for the block height of each chain. This is not a tight bound. - -> HM.HashMap ChainId BlockHeader - -> IO (HM.HashMap ChainId BlockHeader) -limitCutHeaders whdb h ch = _cutHeaders <$> limitCut whdb h (unsafeMkCut ch) - -- -------------------------------------------------------------------------- -- -- Genesis Cut @@ -620,291 +428,6 @@ isBraidingOfCutPair a b = do || (view blockHeight a > view blockHeight b) && ab == Parent (view blockHash b) || (view blockHeight a < view blockHeight b) && True {- if same graph: ba == view blockHash a -} --- -------------------------------------------------------------------------- -- --- Extending Cuts - --- | Extends a Cut monotonically, i.e. the replaced block header is the parent --- of the added block header. --- --- Checks --- --- * block header is from the ChainGraph of the Cut --- * result has valid braiding --- * result is a cut --- * update is monotonic --- --- This includes a check that inductively maintains 'checkBraidingOfCut'. --- --- FIXME: this must conform with 'isBraidingOfCutPair'. Double check that we --- have test for this or check if the implementation can be shared. --- --- TODO: do we have to check that the correct graph is used? --- -isMonotonicCutExtension - :: (HasCallStack, HasVersion) - => MonadThrow m - => Cut - -> BlockHeader - -> m Bool -isMonotonicCutExtension c h = do - checkBlockHeaderGraph h - return $! monotonic && validBraiding - where - monotonic = view blockParent h == case c ^? ixg (_chainId h) . blockHash of - Nothing -> error $ T.unpack $ "isMonotonicCutExtension.monotonic: missing parent in cut. " <> encodeToText h - Just x -> Parent x - validBraiding = getAll $ ifoldMap - (\cid -> All . validBraidingCid cid) - (_getBlockHashRecord $ view blockAdjacentHashes h) - - validBraidingCid cid a - | Just b <- c ^? ixg cid = Parent (view blockHash b) == a || view blockParent b == a - | view blockHeight h == genesisHeight cid = a == genesisParentBlockHash cid - | otherwise = error $ T.unpack $ "isMonotonicCutExtension.validBraiding: missing adjacent parent on chain " <> toText cid <> " in cut. " <> encodeToText h - --- | Extend a cut with a block header. Throws 'InvalidCutExtension' if the block --- header isn't a monotonic cut extension. --- -monotonicCutExtension - :: (MonadThrow m, HasVersion) - => Cut - -> BlockHeader - -> m Cut -monotonicCutExtension c h = tryMonotonicCutExtension c h >>= \case - Nothing -> throwM $ InvalidCutExtension h - Just x -> return x - --- | Extend a cut with a block header. Returns 'Nothing' the block header isn't --- a monotonic cut extension. --- -tryMonotonicCutExtension - :: (MonadThrow m, HasVersion) - => Cut - -> BlockHeader - -> m (Maybe Cut) -tryMonotonicCutExtension c h = isMonotonicCutExtension c h >>= \case - False -> return Nothing - True -> return $! Just - $! unsafeMkCut - $ extendChains - $ set (ix' (_chainId h)) h - $ _cutHeaders c - --- -------------------------------------------------------------------------- -- --- Join - -type DiffItem a = These a a - -type JoinQueue a = H.Heap (H.Entry (BlockHeight, a) BlockHeader) - --- | This represents the Join of two cuts in an algorithmically convenient way. --- -data Join a = Join - { _joinBase :: !Cut - -- ^ the base of the join, the largest cut that is contained in both - -- cuts, or when viewed as sets, the intersection. - , _joinQueue :: !(JoinQueue a) - -- ^ a queue of block headers from both cuts that allows construct - -- the join cut from the join base. - } - --- | This computes the join for cuts across all chains. --- --- If you want to compute a join for cuts that include only a subset of all --- chains. --- -join - :: (Ord a, HasVersion) - => WebBlockHeaderDb - -> (DiffItem BlockHeader -> DiffItem (Maybe a)) - -> Cut - -> Cut - -> IO (Join a) -join wdb f = join_ wdb f `on` _cutHeaders - --- | This merges two maps from ChainIds to BlockHeaders such that the result is --- a Cut. Note, however, that the resulting cut contains only the chain ids from --- the intersection of the input maps. --- --- NOTE: For this to work as expected make sure that both inputs contain all --- chains that should be present in the output. --- --- Adds genesis blocks for chains that are not yet active. This purpose of this --- is to make sure that all chains of both inputs are preserved in the join, so --- that the result of the join contains all chains of the original cuts. --- Otherwise the join would contain only the intersection of all chains and any --- information/blocks in the other chains would be lost when applying the join. --- -join_ - :: forall a - . (Ord a, HasVersion) - => WebBlockHeaderDb - -> (DiffItem BlockHeader -> DiffItem (Maybe a)) - -> HM.HashMap ChainId BlockHeader - -> HM.HashMap ChainId BlockHeader - -> IO (Join a) -join_ wdb prioFun a b = do - (m, h) <- runStateT (HM.traverseWithKey f (HM.intersectionWith (,) a' b')) mempty - return $! Join (unsafeMkCut m) h - where - (a', b') = joinChains a b - - f - :: ChainId - -> (BlockHeader, BlockHeader) - -> StateT (JoinQueue a) IO BlockHeader - f cid (x, y) = do - !q <- get - db <- getWebBlockHeaderDb wdb cid - (q' :> !h) <- liftIO $ S.fold g q id $ branchDiff_ db x y - put q' - return h - - g :: JoinQueue a -> DiffItem BlockHeader -> JoinQueue a - g q x = foldl' maybeInsert q $ zip (biList x) (biList (prioFun x)) - - maybeInsert - :: H.Heap (H.Entry (BlockHeight, a) BlockHeader) - -> (BlockHeader, Maybe a) - -> H.Heap (H.Entry (BlockHeight, a) BlockHeader) - maybeInsert !q (_, Nothing) = q - maybeInsert !q (!h, (Just !p)) = H.insert (H.Entry (view blockHeight h, p) h) q - --- This can't fail because of missing dependencies. It can't fail because --- of conflict. --- --- Non-existing chains are stripped from the result. --- -applyJoin :: (MonadThrow m, HasVersion) => Join a -> m Cut -applyJoin m = cutProjectChains - <$> foldM - (\c b -> fromMaybe c <$> tryMonotonicCutExtension c (H.payload b)) - (_joinBase m) - (_joinQueue m) - --- | Merge two Cuts. If at least one of the input cuts had a valid braiding the --- result is guaranteed to have a valid braiding for all blocks included in cut --- and their ancestors. --- --- This is because the merge starts with the intersection of both cuts, using --- 'branchDiff_' on each chain, and constructs the merge cut using --- 'tryMonotonicCutExtension'. If one of the inputs is correctly braided, so is --- the intersection. 'tryMonotonicCutExtension' is guaranteed to maintain that --- property. --- --- Chains that aren't yet initialized are included in the join and later --- stripped from the result. --- --- If you want to compute a join for cuts that include only a subset of all --- chains, make sure that @genesisBlockHeaders v@ only returns genesis headers --- for those chains that you care about. --- -joinIntoHeavier - :: HasVersion - => WebBlockHeaderDb - -> Cut - -> Cut - -> IO Cut -joinIntoHeavier wdb = joinIntoHeavier_ wdb `on` _cutHeaders - --- | Chains that aren't yet initialized are included in the join and later --- stripped from the result. --- --- If you want to compute a join for cuts that include only a subset of all --- chains, make sure that @genesisBlockHeaders v@ only returns genesis headers --- for those chains that you care about. --- -joinIntoHeavier_ - :: HasVersion - => WebBlockHeaderDb - -> HM.HashMap ChainId BlockHeader - -> HM.HashMap ChainId BlockHeader - -> IO Cut -joinIntoHeavier_ wdb a b = do - m <- join_ wdb (prioritizeHeavier_ a b) a b - applyJoin m - -prioritizeHeavier :: Cut -> Cut -> DiffItem BlockHeader -> DiffItem (Maybe Int) -prioritizeHeavier = prioritizeHeavier_ `on` _cutHeaders - --- | Note: consider the weight of the recursive dependencies for the --- priority of a block header. For that we would have to annotate the --- block headers before putting them in the queue. To traverse only once, --- we'd have to traverse the zipped cuts by height and not by chainid, which --- could easily be done by merging/zipping the branch-diff streams. --- -prioritizeHeavier_ - :: Foldable f - => Eq (f BlockHeader) - => f BlockHeader - -> f BlockHeader - -> DiffItem BlockHeader - -> DiffItem (Maybe Int) -prioritizeHeavier_ a b = f - where - heaviest = maxBy (compare `on` weight) a b - w c = if c == heaviest then 0 else 1 - - f (This _) = This (Just $ w a) - f (That _) = That (Just $ w b) - f (These _ _) - | heaviest == a = These (Just 0) Nothing - | otherwise = These Nothing (Just 0) - - weight c = - ( sumOf (folded . blockWeight) c - -- first sort by weight - , sumOf (folded . blockHeight) c - -- for scenarios with trivial difficulty height is added as - -- secondary metrics - - -- NOTE: - -- We could consider prioritizing the latest block in the cut here as - -- first-level tie breaker. That would further incentivize miners to use - -- a block creation time that is close to the real world time (note that - -- blocks from the future are rejected, so post-dating blocks is risky - -- for miners.) - - , List.sort (toList c) - -- the block hashes of the cut are added as tie breaker in order - -- to guarantee commutativity. - -- - ) - --- -------------------------------------------------------------------------- -- --- Cut Meet - --- | Intersection of cuts --- -meet - :: HasVersion - => WebBlockHeaderDb - -> Cut - -> Cut - -> IO Cut -meet wdb a b = do - !r <- imapM f $ HM.intersectionWith (,) (_cutHeaders a) (_cutHeaders b) - return $! unsafeMkCut r - where - f !cid (!x, !y) = do - db <- getWebBlockHeaderDb wdb cid - forkEntry db x y - -forkDepth - :: HasVersion - => WebBlockHeaderDb - -> Cut - -> Cut - -> IO Natural -forkDepth wdb a b = do - m <- meet wdb a b - return $! int $ max (maxDepth m a) (maxDepth m b) - where - maxDepth l u = maximum $ HM.intersectionWith - (\x y -> view blockHeight y - view blockHeight x) - (_cutHeaders l) - (_cutHeaders u) - cutToTextShort :: Cut -> [Text] cutToTextShort c = [ blockHeaderShortDescription bh diff --git a/src/Chainweb/Cut/Create.hs b/src/Chainweb/Cut/Create.hs index 112bfa9186..365f609db5 100644 --- a/src/Chainweb/Cut/Create.hs +++ b/src/Chainweb/Cut/Create.hs @@ -50,6 +50,29 @@ module Chainweb.Cut.Create , cutExtensionAdjacentHashes , getCutExtension +-- * Limit cuts +, limitCut +, tryLimitCut +, limitCutHeaders + +-- * Predicates +, isMonotonicCutExtension +, monotonicCutExtension +, tryMonotonicCutExtension + +-- * Join +, Join(..) +, join +, applyJoin +, prioritizeHeavier +, prioritizeHeavier_ +, joinIntoHeavier +, joinIntoHeavier_ + +-- * Meet +, meet +, forkDepth + -- * WorkParents , WorkParents(..) , workParents @@ -76,18 +99,18 @@ module Chainweb.Cut.Create import Control.DeepSeq import Control.Lens -import Control.Monad +import Control.Monad hiding (join) import Control.Monad.Catch - +import Control.Monad.State.Strict import Data.ByteString.Short qualified as SB import Data.HashMap.Strict qualified as HM import Data.HashSet qualified as HS +import Data.Heap qualified as H import Data.Text qualified as T - +import Data.These import GHC.Generics (Generic) import GHC.Stack - --- internal modules +import Numeric.Natural import Chainweb.BlockCreationTime import Chainweb.BlockHash @@ -100,11 +123,20 @@ import Chainweb.Cut import Chainweb.Cut.CutHashes import Chainweb.Difficulty import Chainweb.Parent -import Chainweb.PayloadProvider(EncodedPayloadData(..), EncodedPayloadOutputs) +import Chainweb.PayloadProvider (EncodedPayloadData (..), EncodedPayloadOutputs) import Chainweb.Utils import Chainweb.Utils.Serialization import Chainweb.Version import Chainweb.Version.Utils +import Chainweb.WebBlockHeaderDB +import Data.Monoid +import Chainweb.TreeDB ( branchDiff_, forkEntry, seekAncestor ) +import Data.Function +import qualified Streaming.Prelude as S +import Data.Bifoldable +import Data.Foldable +import Data.Maybe +import qualified Data.List as List -- -------------------------------------------------------------------------- -- -- Adjacent Parent Hashes @@ -182,7 +214,7 @@ instance HasChainId CutExtension where -- blocks for the new chains and move ahead. So steps in the new graph are not -- allowed. -- --- TODO: it is important that the semantics of this function corresponds to the +-- NB: it is important that the semantics of this function corresponds to the -- respective validation in the module "Chainweb.Cut", in particular -- 'isMonotonicCutExtension'. It must not happen, that a cut passes validation -- that can't be further extended. @@ -197,9 +229,9 @@ getCutExtension -> Maybe CutExtension getCutExtension c cid = do - -- In a graph transition we wait for all chains to do the transition to the - -- new graph before moving ahead. Blocks chains that reach the new graph - -- until all chains have reached the new graph. + -- If ANY chains in the graph have completed the graph transition (i.e. + -- reached the transition height) then we wait for ALL chains to complete + -- the transition before moving ahead on those chains. -- guard (not $ isGraphTransitionCut && isGraphTransitionPost) @@ -597,3 +629,460 @@ extendCut c ps s = do (bh,) <$> tryMonotonicCutExtension c bh where bh = newHeader ps s + +-- -------------------------------------------------------------------------- -- +-- Limit Cut Hashes By Height + +-- | Find a `Cut` that is a predecessor of the given one, and that has a block +-- height that is smaller or equal the given height. +-- +-- If the requested limit is larger or equal to the current height, the given +-- cut is returned. +-- +-- Otherwise, the predecessor of the given cut at the given height on each chain +-- is returned. +-- +limitCut + :: (HasCallStack, HasVersion) + => WebBlockHeaderDb + -> BlockHeight + -- ^ upper bound for the block height of each chain. This is not a tight + -- bound. + -> Cut + -> IO Cut +limitCut wdb h c + | all (\bh -> h >= view blockHeight bh) (view cutHeaders c) = + return c + | otherwise = do + hdrs <- itraverse go $ view cutHeaders c + return $! unsafeMkCut $ projectChains $ HM.mapMaybe id hdrs + where + + go :: ChainId -> BlockHeader -> IO (Maybe BlockHeader) + go cid bh = do + if h >= view blockHeight bh + then return (Just bh) + else do + !db <- getWebBlockHeaderDb wdb cid + seekAncestor db bh (min (int $ view blockHeight bh) (int h)) + -- this is safe because it's guaranteed that the requested rank is + -- smaller then the block height of the argument + +-- | Find a `Cut` that is a predecessor of the given one, and that has a block +-- height that is as low as possible while not exceeding the given height and +-- including all of the chains in the given cut. +-- +-- If the requested limit is larger or equal to the current height, the given +-- cut is returned. +-- +tryLimitCut + :: (HasCallStack, HasVersion) + => WebBlockHeaderDb + -> BlockHeight + -- upper bound for the block height of each chain. This is not a tight bound. + -> Cut + -> IO Cut +tryLimitCut wdb h c + | all (\bh -> h >= view blockHeight bh) (view cutHeaders c) = + return c + | otherwise = do + hdrs <- itraverse go $ view cutHeaders c + return $! unsafeMkCut hdrs + where + go :: ChainId -> BlockHeader -> IO BlockHeader + go cid bh = do + if h >= view blockHeight bh + then return bh + else do + !db <- getWebBlockHeaderDb wdb cid + -- this is safe because it's guaranteed that the requested rank is + -- smaller then the block height of the argument + let ancestorHeight = min (int $ view blockHeight bh) (int h) + if ancestorHeight <= fromIntegral (genesisHeight cid) + then return $ genesisBlockHeader cid + else fromJuste <$> seekAncestor db bh ancestorHeight + +-- | The resulting headers are valid cut headers only if the input headers are +-- valid cut headers, too. The inverse is not true. +-- +limitCutHeaders + :: (HasCallStack, HasVersion) + => WebBlockHeaderDb + -> BlockHeight + -- ^ upper bound for the block height of each chain. This is not a tight bound. + -> HM.HashMap ChainId BlockHeader + -> IO (HM.HashMap ChainId BlockHeader) +limitCutHeaders whdb h ch = _cutHeaders <$> limitCut whdb h (unsafeMkCut ch) + +-- -------------------------------------------------------------------------- -- +-- Tools for Graph Transitions +-- +-- These functions are used to adjust the available chains during construction +-- of new cuts: +-- +-- * 'monotonicCutExtension' and 'tryMonotonicCutExtension': extend the +-- resulting cut with genesis headers of new chains. +-- +-- * 'limitCut': project out chains that don't exist in the result cut. +-- +-- * 'join' and 'applyJoin': add chains from both cuts to the input cuts, so +-- that all chains are available in the join base and can be restored during +-- 'applyJoin'; project out non-existing chains in the result. +-- +-- The graph is determined by the /minimum/ height of the blocks in the cut. +-- +-- The minimum is used to ensure that cuts in a new graph only exist when /all/ +-- blocks are on the new cut. This means the new chains are included only if all +-- old chains have transitioned to the minimum block height of the new graph. + +cutHeadersMinHeight :: HM.HashMap ChainId BlockHeader -> BlockHeight +cutHeadersMinHeight = minimum . fmap (view blockHeight) +{-# INLINE cutHeadersMinHeight #-} + + +-- | The function projects onto the chains available at the minimum block height +-- in input headers. +-- +-- At a graph change chains are considered blocked until "all" chains performed +-- the transition to the new graph. Thus, a block in the new graph has all of +-- its dependencies available. +-- +-- This an internal function. The result is meaningful only if the input headers +-- form a valid cut. In particular, the input must not be empty. +-- +projectChains + :: HasVersion + => HM.HashMap ChainId BlockHeader + -> HM.HashMap ChainId BlockHeader +projectChains m = HM.intersection m + $ HS.toMap + $ chainIdsAt (cutHeadersMinHeight m) +{-# INLINE projectChains #-} + +cutProjectChains :: HasVersion => Cut -> Cut +cutProjectChains c = unsafeMkCut $ projectChains $ _cutHeaders c +{-# INLINE cutProjectChains #-} + +-- | Extend the chains for the graph at the minimum block height of the input +-- headers. If a header for a chain is missing the genesis block header for that +-- chain is added. +-- +-- This an internal function. The result is meaningful only if the input headers +-- form a valid cut. In particular, the input must not be empty. +-- +extendChains + :: HasVersion + => HM.HashMap ChainId BlockHeader + -> HM.HashMap ChainId BlockHeader +extendChains m = HM.union m + $ genesisBlockHeadersAtHeight (cutHeadersMinHeight m) +{-# INLINE extendChains #-} + +-- | This function adds all chains that are available in either of the input +-- headers. It is assumed that both input header maps are contain headers for +-- all chains for the graph at the respective minimum height of the headers. +-- +-- This function is used when dealing with joins that internally compute an +-- intersection on the blocks on all chains, but the goal is to preserve blocks +-- from all chains. +-- +-- This an internal function. The result is meaningful only if the input headers +-- form a valid cut. In particular, the input must not be empty. +-- +joinChains + :: HasVersion + => HM.HashMap ChainId BlockHeader + -> HM.HashMap ChainId BlockHeader + -> (HM.HashMap ChainId BlockHeader, HM.HashMap ChainId BlockHeader) +joinChains a b = (HM.union a c, HM.union b c) + where + c = genesisBlockHeader <$> a <> b +{-# INLINE joinChains #-} + +-- -------------------------------------------------------------------------- -- +-- Extending Cuts + +-- | Extends a Cut monotonically, i.e. the replaced block header is the parent +-- of the added block header. +-- +-- Checks +-- +-- * block header is from the ChainGraph of the Cut +-- * result has valid braiding +-- * result is a cut +-- * update is monotonic +-- +-- This includes a check that inductively maintains 'checkBraidingOfCut'. +-- +-- FIXME: this must conform with 'isBraidingOfCutPair'. Double check that we +-- have test for this or check if the implementation can be shared. +-- +isMonotonicCutExtension + :: (HasCallStack, HasVersion) + => MonadThrow m + => Cut + -> BlockHeader + -> m Bool +isMonotonicCutExtension c h = do + case getCutExtension c (_chainId h) of + Just ext -> do + let cutParent = _cutExtensionParent' ext + let monotonic = view blockParent h == fmap (view blockHash) cutParent + checkBlockHeaderGraph h + return $! monotonic && validBraiding + Nothing -> return False + + where + validBraiding = getAll $ ifoldMap + (\cid -> All . validBraidingCid cid) + (_getBlockHashRecord $ view blockAdjacentHashes h) + + validBraidingCid cid a + | Just b <- c ^? ixg cid = Parent (view blockHash b) == a || view blockParent b == a + | view blockHeight h == genesisHeight cid = a == genesisParentBlockHash cid + | otherwise = error $ T.unpack $ "isMonotonicCutExtension.validBraiding: missing adjacent parent on chain " <> toText cid <> " in cut. " <> encodeToText h + + + +-- | Extend a cut with a block header. Throws 'InvalidCutExtension' if the block +-- header isn't a monotonic cut extension. +-- +monotonicCutExtension + :: (MonadThrow m, HasVersion) + => Cut + -> BlockHeader + -> m Cut +monotonicCutExtension c h = tryMonotonicCutExtension c h >>= \case + Nothing -> throwM $ InvalidCutExtension h + Just x -> return x + +-- | Extend a cut with a block header. Returns 'Nothing' the block header isn't +-- a monotonic cut extension. +-- +tryMonotonicCutExtension + :: (MonadThrow m, HasVersion) + => Cut + -> BlockHeader + -> m (Maybe Cut) +tryMonotonicCutExtension c h = isMonotonicCutExtension c h >>= \case + False -> return Nothing + True -> return $! Just + $! unsafeMkCut + $ extendChains + $ set (ix' (_chainId h)) h + $ _cutHeaders c + +-- -------------------------------------------------------------------------- -- +-- Join + +type DiffItem a = These a a + +type JoinQueue a = H.Heap (H.Entry (BlockHeight, a) BlockHeader) + +-- | This represents the Join of two cuts in an algorithmically convenient way. +-- +data Join a = Join + { _joinBase :: !Cut + -- ^ the base of the join, the largest cut that is contained in both + -- cuts, or when viewed as sets, the intersection. + , _joinQueue :: !(JoinQueue a) + -- ^ a queue of block headers from both cuts that allows construct + -- the join cut from the join base. + } + +-- | This computes the join for cuts across all chains. +-- +-- If you want to compute a join for cuts that include only a subset of all +-- chains. +-- +join + :: (Ord a, HasVersion) + => WebBlockHeaderDb + -> (DiffItem BlockHeader -> DiffItem (Maybe a)) + -> Cut + -> Cut + -> IO (Join a) +join wdb f = join_ wdb f `on` _cutHeaders + +-- | This merges two maps from ChainIds to BlockHeaders such that the result is +-- a Cut. Note, however, that the resulting cut contains only the chain ids from +-- the intersection of the input maps. +-- +-- NOTE: For this to work as expected make sure that both inputs contain all +-- chains that should be present in the output. +-- +-- Adds genesis blocks for chains that are not yet active. This purpose of this +-- is to make sure that all chains of both inputs are preserved in the join, so +-- that the result of the join contains all chains of the original cuts. +-- Otherwise the join would contain only the intersection of all chains and any +-- information/blocks in the other chains would be lost when applying the join. +-- +join_ + :: forall a + . (Ord a, HasVersion) + => WebBlockHeaderDb + -> (DiffItem BlockHeader -> DiffItem (Maybe a)) + -> HM.HashMap ChainId BlockHeader + -> HM.HashMap ChainId BlockHeader + -> IO (Join a) +join_ wdb prioFun a b = do + (m, h) <- runStateT (HM.traverseWithKey f (HM.intersectionWith (,) a' b')) mempty + return $! Join (unsafeMkCut m) h + where + (a', b') = joinChains a b + + f + :: ChainId + -> (BlockHeader, BlockHeader) + -> StateT (JoinQueue a) IO BlockHeader + f cid (x, y) = do + !q <- get + db <- getWebBlockHeaderDb wdb cid + (q' S.:> !h) <- liftIO $ S.fold g q id $ branchDiff_ db x y + put q' + return h + + g :: JoinQueue a -> DiffItem BlockHeader -> JoinQueue a + g q x = foldl' maybeInsert q $ zip (biList x) (biList (prioFun x)) + + maybeInsert + :: H.Heap (H.Entry (BlockHeight, a) BlockHeader) + -> (BlockHeader, Maybe a) + -> H.Heap (H.Entry (BlockHeight, a) BlockHeader) + maybeInsert !q (_, Nothing) = q + maybeInsert !q (!h, (Just !p)) = H.insert (H.Entry (view blockHeight h, p) h) q + +-- This can't fail because of missing dependencies. It can't fail because +-- of conflict. +-- +-- Non-existing chains are stripped from the result. +-- +applyJoin :: (MonadThrow m, HasVersion) => Join a -> m Cut +applyJoin m = cutProjectChains + <$> foldM + (\c b -> fromMaybe c <$> tryMonotonicCutExtension c (H.payload b)) + (_joinBase m) + (_joinQueue m) + +-- | Merge two Cuts. If at least one of the input cuts had a valid braiding the +-- result is guaranteed to have a valid braiding for all blocks included in cut +-- and their ancestors. +-- +-- This is because the merge starts with the intersection of both cuts, using +-- 'branchDiff_' on each chain, and constructs the merge cut using +-- 'tryMonotonicCutExtension'. If one of the inputs is correctly braided, so is +-- the intersection. 'tryMonotonicCutExtension' is guaranteed to maintain that +-- property. +-- +-- Chains that aren't yet initialized are included in the join and later +-- stripped from the result. +-- +-- If you want to compute a join for cuts that include only a subset of all +-- chains, make sure that @genesisBlockHeaders v@ only returns genesis headers +-- for those chains that you care about. +-- +joinIntoHeavier + :: HasVersion + => WebBlockHeaderDb + -> Cut + -> Cut + -> IO Cut +joinIntoHeavier wdb = joinIntoHeavier_ wdb `on` _cutHeaders + +-- | Chains that aren't yet initialized are included in the join and later +-- stripped from the result. +-- +-- If you want to compute a join for cuts that include only a subset of all +-- chains, make sure that @genesisBlockHeaders v@ only returns genesis headers +-- for those chains that you care about. +-- +joinIntoHeavier_ + :: HasVersion + => WebBlockHeaderDb + -> HM.HashMap ChainId BlockHeader + -> HM.HashMap ChainId BlockHeader + -> IO Cut +joinIntoHeavier_ wdb a b = do + m <- join_ wdb (prioritizeHeavier_ a b) a b + applyJoin m + +prioritizeHeavier :: Cut -> Cut -> DiffItem BlockHeader -> DiffItem (Maybe Int) +prioritizeHeavier = prioritizeHeavier_ `on` _cutHeaders + +-- | Note: consider the weight of the recursive dependencies for the +-- priority of a block header. For that we would have to annotate the +-- block headers before putting them in the queue. To traverse only once, +-- we'd have to traverse the zipped cuts by height and not by chainid, which +-- could easily be done by merging/zipping the branch-diff streams. +-- +prioritizeHeavier_ + :: Foldable f + => Eq (f BlockHeader) + => f BlockHeader + -> f BlockHeader + -> DiffItem BlockHeader + -> DiffItem (Maybe Int) +prioritizeHeavier_ a b = f + where + heaviest = maxBy (compare `on` weight) a b + w c = if c == heaviest then 0 else 1 + + f (This _) = This (Just $ w a) + f (That _) = That (Just $ w b) + f (These _ _) + | heaviest == a = These (Just 0) Nothing + | otherwise = These Nothing (Just 0) + + weight c = + ( sumOf (folded . blockWeight) c + -- first sort by weight + , sumOf (folded . blockHeight) c + -- for scenarios with trivial difficulty height is added as + -- secondary metrics + + -- NOTE: + -- We could consider prioritizing the latest block in the cut here as + -- first-level tie breaker. That would further incentivize miners to use + -- a block creation time that is close to the real world time (note that + -- blocks from the future are rejected, so post-dating blocks is risky + -- for miners.) + + , List.sort (toList c) + -- the block hashes of the cut are added as tie breaker in order + -- to guarantee commutativity. + -- + ) + +-- -------------------------------------------------------------------------- -- +-- Cut Meet + +-- | Intersection of cuts +-- +meet + :: HasVersion + => WebBlockHeaderDb + -> Cut + -> Cut + -> IO Cut +meet wdb a b = do + !r <- imapM f $ HM.intersectionWith (,) (_cutHeaders a) (_cutHeaders b) + return $! unsafeMkCut r + where + f !cid (!x, !y) = do + db <- getWebBlockHeaderDb wdb cid + forkEntry db x y + +forkDepth + :: HasVersion + => WebBlockHeaderDb + -> Cut + -> Cut + -> IO Natural +forkDepth wdb a b = do + m <- meet wdb a b + return $! int $ max (maxDepth m a) (maxDepth m b) + where + maxDepth l u = maximum $ HM.intersectionWith + (\x y -> view blockHeight y - view blockHeight x) + (_cutHeaders l) + (_cutHeaders u) diff --git a/src/Chainweb/CutDB.hs b/src/Chainweb/CutDB.hs index e6bd533851..36d7e1ae96 100644 --- a/src/Chainweb/CutDB.hs +++ b/src/Chainweb/CutDB.hs @@ -140,6 +140,7 @@ import Chainweb.BlockWeight import Chainweb.ChainId import Chainweb.Cut import Chainweb.Cut.CutHashes +import Chainweb.Cut.Create import Chainweb.Graph import Chainweb.PayloadProvider import Chainweb.Storage.Table diff --git a/src/Chainweb/CutDB/RestAPI/Server.hs b/src/Chainweb/CutDB/RestAPI/Server.hs index 5867693fe6..ecee58fb7f 100644 --- a/src/Chainweb/CutDB/RestAPI/Server.hs +++ b/src/Chainweb/CutDB/RestAPI/Server.hs @@ -48,7 +48,7 @@ import Servant.Server -- internal modules import Chainweb.BlockHeight -import Chainweb.Cut +import Chainweb.Cut.Create import Chainweb.Cut.CutHashes import Chainweb.CutDB import Chainweb.CutDB.RestAPI diff --git a/src/Chainweb/Miner/Coordinator.hs b/src/Chainweb/Miner/Coordinator.hs index 90f0997620..3756746d32 100644 --- a/src/Chainweb/Miner/Coordinator.hs +++ b/src/Chainweb/Miner/Coordinator.hs @@ -277,10 +277,10 @@ updateForCut -> Cut -> IO () updateForCut lf hdb ms c = do - iforM_ ms $ \cid var -> - forChain cid var + forM_ (HM.keys (c ^. cutMap)) forChain where - forChain cid var = do + forChain cid = do + let var = ms ^?! atChain cid maybeNewParents <- workParents hdb c cid atomically $ do maybeOldParentState <- readTVar var @@ -453,7 +453,7 @@ runCoordination mr = do withProvider cid $ \provider -> runForever lf label $ do payloadStream provider - & S.chain (\_ -> lf Info $ "update cache on chain " <> toText cid) + & S.chain (\_ -> lf Debug $ "update cache on chain " <> toText cid) & S.mapM_ (insertIO cache) where label = "miningCoordination.updateCache." <> toText cid @@ -461,9 +461,9 @@ runCoordination mr = do -- Update the work state -- updateWork = runForever lf "miningCoordination" $ do - lf Info "start updateWork event stream" + lf Debug "start updateWork event stream" eventStream cdb caches - & S.chain (\e -> lf Info $ "coordination event: " <> brief e) + & S.chain (\e -> lf Debug $ "coordination event: " <> brief e) & S.mapM_ \case CutEvent c -> updateForCut lf f state c NewPayloadEvent _ -> return () @@ -472,17 +472,17 @@ runCoordination mr = do -- STM variable, too. -- TODO: is there still? - -- FIXME: this is probably more aggressive than needed initializeState = do - lf Info $ "initialize mining state" - forConcurrently_ (itoList caches) $ \(cid, cache) -> do - lf Info $ "initialize mining state for chain " <> brief cid + lf Debug $ "initialize mining state" + curCut <- _cut $ cdb + forConcurrently_ (HM.keys (curCut ^. cutMap)) $ \cid -> do + let cache = caches ^?! atChain cid + lf Debug $ "initialize mining state for chain " <> brief cid pld <- withProvider cid latestPayloadIO - lf Info $ "got latest payload for chain " <> brief cid + lf Debug $ "got latest payload for chain " <> brief cid insertIO cache pld - curCut <- _cut $ cdb updateForCut lf f state curCut - lf Info "done initializing mining state for all chains" + lf Debug "done initializing mining state for all chains" -- | Note that this stream is lossy. It always delivers the latest available -- item and skips over any previous items that have not been consumed. @@ -563,7 +563,7 @@ awaitEvent cdb caches c p = -- 4. some payload providers are very slow in producing new payloads. -- randomWork :: HasVersion => LogFunction -> PayloadCaches -> ChainMap (TVar (Maybe ParentState)) -> IO MiningWork -randomWork logFun caches state = do +randomWork logFun caches parentStateVars = do -- Pick a random chain. -- @@ -577,7 +577,7 @@ randomWork logFun caches state = do -- that has work ready. We could prune the random range and search space, -- but at this, point the slight, temporary overhead seems acceptable. -- - n <- randomRIO (0, length state) + n <- randomRIO (0, length parentStateVars) -- NOTE: it is tempting to search for a matching chain within a single STM -- transaction. However, that is problematic: the search restarts when the @@ -590,7 +590,7 @@ randomWork logFun caches state = do -- towards chains for which block are produced more quickly, but we think, -- that it is negligible. -- - let (s0, s1) = splitAt n (itoList state) + let (s0, s1) = splitAt n (itoList parentStateVars) go (s1 <> s0) where awaitWorkReady :: ChainId -> TVar (Maybe ParentState) -> STM (WorkParents, NewPayload) @@ -632,7 +632,7 @@ randomWork logFun caches state = do -- timeoutVar <- registerDelay (int staleMiningStateDelay) w <- atomically $ - Right <$> msum (imap awaitWorkReady state) <|> awaitTimeout timeoutVar + Right <$> msum (imap awaitWorkReady parentStateVars) <|> awaitTimeout timeoutVar case w of Right (ps, npld) -> do ct <- BlockCreationTime <$> getCurrentTimeIntegral @@ -648,7 +648,7 @@ randomWork logFun caches state = do logFun @T.Text Debug $ "randomWork: picked chain " <> brief cid return $ newWork ct parents (_newPayloadBlockPayloadHash payload) Nothing -> do - logFun @T.Text Info $ "randomWork: not ready for " <> brief cid + logFun @T.Text Debug $ "randomWork: not ready for " <> brief cid go t awaitTimeout var = do diff --git a/src/Chainweb/Pact/Backend/ChainwebPactDb.hs b/src/Chainweb/Pact/Backend/ChainwebPactDb.hs index f3643c8fe2..16a687f063 100644 --- a/src/Chainweb/Pact/Backend/ChainwebPactDb.hs +++ b/src/Chainweb/Pact/Backend/ChainwebPactDb.hs @@ -409,8 +409,8 @@ withTableExistenceCheck tableName action = do case tableStatus of TableDoesNotExist -> liftGas $ throwDbOpErrorGasM $ Pact.NoSuchTable tableName TableCreationPending -> return Nothing - TableExists -> liftIO (putStrLn "WAT1") >> error (sshow err) - Left err -> liftIO (putStrLn "WAT2") >> error (sshow err) + TableExists -> error (sshow err) + Left err -> error (sshow err) Right result -> return (Just result) else do -- if we're rewound, we just check if the table exists first diff --git a/src/Chainweb/PayloadProvider/EVM/Genesis.hs b/src/Chainweb/PayloadProvider/EVM/Genesis.hs index bb2eacb283..29327c1458 100644 --- a/src/Chainweb/PayloadProvider/EVM/Genesis.hs +++ b/src/Chainweb/PayloadProvider/EVM/Genesis.hs @@ -68,7 +68,7 @@ import Data.Text qualified as T -- 1. Query the EVM genesis header and compute block payload hash and header: -- -- @ --- cabal run cwtools:exe:evm-genesis +-- cabal run cwtools:exe:evm-genesis evm-development -- @ -- genesisBlocks @@ -90,36 +90,6 @@ genesisBlocks c = go (_versionCode implicitVersion) (_chainId c) "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoOG8PeZNPmM3lrR8_XYZiV77h9JISltItpJrMg3uWzISoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" ChainId 24 -> f "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoL_zw0Kq1MfRVs38rgQLmxq1zFk8ac976rfmBmNiPvc0oFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 25 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoAR82Mmf_nzgqOuk-JuK2c6y4cUsnjj_mthufymqwKl4oFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 26 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoLIoqmCAur1Y7jpeSGyRpx71kbUqXT-R5dTjIswNvgyXoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 27 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoEa3cdjo4w54WX1slUf3N6RgIFddjDWTfYNUg4mMF_ExoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 28 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoJGErv8Pw9R_vy2jSuU8h22F9iPtZMzBDYhF33EA0PGhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 29 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoMh5sX_kYQkGl1nZ-RHbBlbBwbp-VcznAOB0nAVnXOzroFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 30 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoGcOIoUzg5FTvy0MC0EZJsxo030YmtHVbISpQi0iaD3poFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 31 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoNkhLvaaRHuHwXutFpApXpQMuKIUXeN0riiBvHCjpezvoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 32 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoAZn-r-AVUqdftFL0aAYgnXg3Ihh3TpvNHF1Lk2f5dO7oFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 33 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoI5MZQFQY_vcdKf1l4cilyj0fjzDsAGNw5ZFew7mLNB7oFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 34 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoFIGyZq62efyMMlN-YowvgItKWe3F4BY3CG2g_9q7jfRoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 35 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoBV-hCyAvRGG3t7rNKZd1fKF1ZuQjEBKezJpX2508UDioFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 36 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoFH9aUrJ9ByuptHRBLi9Qz5ZfxB9PHQo49SlwaBIgb6ZoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 37 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoNMYg9Jdt7H6aQ8qvbWwbcqKrAYx8dFuK4ZQjkUPo-jNoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 38 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoArbi8-FGeh8uGxs7MxDXJUwVMznEnD_W-imVRojX9PnoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" - ChainId 39 -> f - "-QJfoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAoB3MTejex116q4W1Z7bM1BrTEkUblIp0E_ChQv1A1JNHlAAAAAAAAAAAAAAAAAAAAAAAAAAAoPitbBNoKjvjSCImGCqCmwST-kMGThKeiK5WSDMw-CfqoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhoFboHxcbzFWm_4NF5pLA-G5bSOAbmWytwAFiL7XjY7QhuQEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAICAhAHJw4CAhGSQ_dKAoAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAiAAAAAAAAAAAhDuaygCgVugfFxvMVab_g0XmksD4bltI4BuZbK3AAWIvteNjtCGAgKAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAKDjsMRCmPwcFJr79MiZb7kkJ65B5GSbk0yklZkbeFK4VQ" _ -> error $ "unsupported chain: " <> T.unpack (toText (_chainId c)) | otherwise = error "requested genesis block for unsupported chain" diff --git a/src/Chainweb/Sync/WebBlockHeaderStore.hs b/src/Chainweb/Sync/WebBlockHeaderStore.hs index 22eddcfce8..e812f5d999 100644 --- a/src/Chainweb/Sync/WebBlockHeaderStore.hs +++ b/src/Chainweb/Sync/WebBlockHeaderStore.hs @@ -214,8 +214,9 @@ consensusState wdb hdr = do } where WindowWidth w = _versionWindow implicitVersion - finalHeight = int @Int @_ $ max 0 (int height - int w * 4) - safeHeight = int @Int @_ $ max 0 (int height - 6 * int diam) + cid = _chainId hdr + finalHeight = int @Int @_ $ max (int $ genesisHeight cid) (int height - int w * 4) + safeHeight = int @Int @_ $ max (int $ genesisHeight cid) (int height - 6 * int diam) height = view blockHeight hdr diam = diameterAt height diff --git a/src/Chainweb/Version.hs b/src/Chainweb/Version.hs index f0a110e593..93795c97f8 100644 --- a/src/Chainweb/Version.hs +++ b/src/Chainweb/Version.hs @@ -327,7 +327,7 @@ instance FromJSON Fork where instance FromJSONKey Fork where fromJSONKey = FromJSONKeyTextParser $ either fail return . eitherFromText -data ForkHeight = ForkAtBlockHeight !BlockHeight | ForkAtGenesis | ForkNever +data ForkHeight = ForkAtBlockHeight BlockHeight | ForkAtGenesis | ForkNever deriving stock (Generic, Eq, Ord, Show) deriving anyclass (Hashable, NFData) @@ -401,7 +401,7 @@ makePrisms ''TxIdxInBlock -- sense one-offs which can't be expressed as upgrade transactions and must be -- preserved. data VersionQuirks = VersionQuirks - { _quirkGasFees :: !(ChainMap (HashMap (BlockHeight, TxIdxInBlock) Gas)) + { _quirkGasFees :: (ChainMap (HashMap (BlockHeight, TxIdxInBlock) Gas)) } deriving stock (Show, Eq, Ord, Generic) deriving anyclass (NFData) diff --git a/src/Chainweb/Version/EvmDevelopment.hs b/src/Chainweb/Version/EvmDevelopment.hs index 0e462c0320..2f4fc6a9ce 100644 --- a/src/Chainweb/Version/EvmDevelopment.hs +++ b/src/Chainweb/Version/EvmDevelopment.hs @@ -38,13 +38,13 @@ pattern EvmDevelopment <- ((== evmDevnet) -> True) where -- import Chainweb.Version.EvmDevelopment -- -- registerVersion EvmDevelopment --- mapM_ (\i -> T.putStrLn (sshow i <> " " <> encodeToText (view payloadHash $ genesisPayload EvmDevelopment $ unsafeChainId i))) [40..97] +-- mapM_ (\i -> T.putStrLn (sshow i <> " " <> encodeToText (view payloadHash $ genesisPayload EvmDevelopment $ unsafeChainId i))) [25..97] -- @ -- -- EVM Payload Provider: -- -- @ --- cabal run evm-genesis -- 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 +-- cabal run evm-genesis -- evm-development -- @ -- -- Pact Provider: @@ -55,11 +55,7 @@ evmDevnet :: ChainwebVersion evmDevnet = withVersion evmDevnet $ ChainwebVersion { _versionCode = ChainwebVersionCode 0x0000_000a , _versionName = ChainwebVersionName "evm-development" - , _versionForks = tabulateHashMap $ \case - -- TODO: for now, Pact 5 is never enabled on EVM devnet. - -- this will change as it stabilizes. - Pact5Fork -> onAllChains ForkNever - _ -> onAllChains ForkAtGenesis + , _versionForks = tabulateHashMap $ const $ onAllChains ForkAtGenesis , _versionUpgrades = onAllChains mempty , _versionGraphs = Bottom (minBound, d4k4ChainGraph) , _versionBlockDelay = BlockDelay 30_000_000 @@ -70,8 +66,8 @@ evmDevnet = withVersion evmDevnet $ ChainwebVersion { _genesisBlockTarget = onAllChains $ HashTarget (maxBound `div` 500_000) , _genesisTime = onChains $ [ (unsafeChainId i, BlockCreationTime [timeMicrosQQ| 2025-01-01T00:00:00.000000 |]) | i <- [0..19] ] - <> [ (unsafeChainId i, BlockCreationTime (Time (secondsToTimeSpan 1687223762))) | i <- [20..39] ] - <> [ (unsafeChainId i, BlockCreationTime [timeMicrosQQ| 2025-01-01T00:00:00.000000 |]) | i <- [40..97] ] + <> [ (unsafeChainId i, BlockCreationTime (Time (secondsToTimeSpan 1687223762))) | i <- [20..24] ] + <> [ (unsafeChainId i, BlockCreationTime [timeMicrosQQ| 2025-01-01T00:00:00.000000 |]) | i <- [25..97] ] , _genesisBlockPayload = onChains $ -- Pact Payload Provider [ (unsafeChainId 0, unsafeFromText "QzxVHFZ5go4PYd3QeAZhxP61hsVnICPw4BB9h-T3PDM") @@ -100,22 +96,22 @@ evmDevnet = withVersion evmDevnet $ ChainwebVersion , (unsafeChainId 22, unsafeFromText "IQLMke3si3QrlqKRyesUJr0iOdYFawl0UhPVXHYc6-M") , (unsafeChainId 23, unsafeFromText "-dc_2udXDNRodCsLAX02kKVsnI-gQMeBZdsZHjxEkbw") , (unsafeChainId 24, unsafeFromText "nWj_l1UK6k9hdMRV53WfNPEIHmUW2NFDpv0-iI2SnPQ") - , (unsafeChainId 25, unsafeFromText "8OH3La_FkKuK91jQZETYp_QnE2UhQHJnlyZdSql6nhs") - , (unsafeChainId 26, unsafeFromText "tHw2yo16N5wEyz2jsd53kplg2xeIi-5PwdzY0KlzzSM") - , (unsafeChainId 27, unsafeFromText "20Rw_Wl_AZl0BmsYPYkv6ghIL8jqGCUeOpUiLhCuS84") - , (unsafeChainId 28, unsafeFromText "_ThaCzgNd-zBRfzz3l-ggZT_XWPwR0OTrolGSUexdsA") - , (unsafeChainId 29, unsafeFromText "vi1Pgfd1Uyio0OUi1RHCHvRNNYIjEX9Z4-YY9Hkrjo4") - , (unsafeChainId 30, unsafeFromText "a0cPOU3F0WTHWrQXPJIGToEpVETRetRM4-FabZ3WhfU") - , (unsafeChainId 31, unsafeFromText "gRs2a2_sBlxwVABhjLkPqdBGY4jSOI-9FsYeLYZX42s") - , (unsafeChainId 32, unsafeFromText "-IFOzOxVR2-yusLt_W9ns_eURYgFsEYTmWBeqCiWowo") - , (unsafeChainId 33, unsafeFromText "_yCbWuqwwYEX_YbGxH8XJ5ZmCWoobO7WUyyMt1MGgxE") - , (unsafeChainId 34, unsafeFromText "cv9ZuWQvqVkPZAyaaVX-NUPpgrwxg23_K7vtD3CRqB8") - , (unsafeChainId 35, unsafeFromText "iNZJV9TWAEOB9W_4bCrEB0tpvSOcEz63K3NfSFbiDXw") - , (unsafeChainId 36, unsafeFromText "e4PE6KrZkxtncGRGS4sscjuq75JZ1S798-TJHja__Kg") - , (unsafeChainId 37, unsafeFromText "gj4cGxxI_maEK2yIXTE1JW-s10W8291mAZiEQQHevcs") - , (unsafeChainId 38, unsafeFromText "miWz2MqGFUUx_KsbYUHWmJ6HMEP0w5UlT83m6r7onLY") - , (unsafeChainId 39, unsafeFromText "KfnCJ-BsVoG7ae42M9STk2Y6FO8LKdsijDklbDhyUfo") -- Minimal Payload Provider + , (unsafeChainId 25, unsafeFromText "Gt116uJVwjUEM0f07u_x8-SUFHgGpoH1xf3sfPoe0ZY") + , (unsafeChainId 26, unsafeFromText "NLRP0OiqRldiZclvoKBGhv9m5wO0TrhNKaZZslZuZvw") + , (unsafeChainId 27, unsafeFromText "xAOBFMKZ_lSHNVhHW-GhbhiWh6sX48S2KPyyPMjAnZM") + , (unsafeChainId 28, unsafeFromText "eav79QetdNuKo1HDW27Aeqbxr8oAt6Fh2U6ZtSfVyYU") + , (unsafeChainId 29, unsafeFromText "jlcxQ4wXUrApJDUQRS8KxuSyoG7ZFEwLV4-92wmqLOQ") + , (unsafeChainId 30, unsafeFromText "odUxYpZ8ZeW0WuQcibJH3isuI045MuEEeQqLrkivWEk") + , (unsafeChainId 31, unsafeFromText "poJ65aDiZYYthbhrgUI2jJS_8vK1CTHRE2C6dLbjTXA") + , (unsafeChainId 32, unsafeFromText "SC3ol1uFOHAewfQrMQczKrvhE8Dw1Bp9fBzNi9l_zTw") + , (unsafeChainId 33, unsafeFromText "p38GsNdY-T8ULYN1OTpYyO1E7WOGwzE2g92aIPereUw") + , (unsafeChainId 34, unsafeFromText "1V0SzqA9fHDOMnfvXvSd57H0r-iycjjLu3CKkRLcjRk") + , (unsafeChainId 35, unsafeFromText "SeiRMENBv5XqR7wXUYSR2orjGHSUrtawx5gLrDCfZYA") + , (unsafeChainId 36, unsafeFromText "JpsiIjm8aZEbyrcsMqLDneT0BNoJAJunk4BYqDO_1Y0") + , (unsafeChainId 37, unsafeFromText "0yx4OFT3sbLS_wrqpULgPpgzzxmMRwM6VTmkasitTlA") + , (unsafeChainId 38, unsafeFromText "Z3LE9JHGpSYuR3SvoYWPae7zB9-X05vFLjwD4GnXX_A") + , (unsafeChainId 39, unsafeFromText "9ZHBlxeYPWjhvMySgVx3ThEyooYx724zjORClgmq8Lk") , (unsafeChainId 40, unsafeFromText "H3VBsNGh-SQE-0d_qlYSHnS2obzUeo6Zi1XDDvhndYo") , (unsafeChainId 41, unsafeFromText "N6hVHz6vo0frpS3eyqvtMeZg1eFbAMJ1CS315M-JpWw") , (unsafeChainId 42, unsafeFromText "9mo8CRwvTLLJ4cSQtErBfOIxzwpale-AwnbXPWQd184") @@ -197,6 +193,6 @@ evmDevnet = withVersion evmDevnet $ ChainwebVersion -- FIXME make this safe for graph changes , _versionPayloadProviderTypes = onChains $ [ (unsafeChainId i, PactProvider) | i <- [0..19] ] - <> [ (unsafeChainId i, EvmProvider (1789 - 20 + int i)) | i <- [20..39] ] - <> [ (unsafeChainId i, MinimalProvider) | i <- [40..97] ] + <> [ (unsafeChainId i, EvmProvider (1789 - 20 + int i)) | i <- [20..24] ] + <> [ (unsafeChainId i, MinimalProvider) | i <- [25..97] ] } diff --git a/test/lib/Chainweb/Test/Cut.hs b/test/lib/Chainweb/Test/Cut.hs index dc409b3e2c..a29c87a2b7 100644 --- a/test/lib/Chainweb/Test/Cut.hs +++ b/test/lib/Chainweb/Test/Cut.hs @@ -14,6 +14,7 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -Wno-orphans #-} +{-# LANGUAGE PartialTypeSignatures #-} -- | -- Module: Chainweb.Test.Cut @@ -66,12 +67,15 @@ import Control.Lens hiding ((:>), (??)) import Control.Monad hiding (join) import Control.Monad.Catch import Control.Monad.IO.Class +import Control.Monad.State.Strict import qualified Data.ByteString.Char8 as B8 import qualified Data.ByteString.Short as BS import Data.Foldable import Data.Function import qualified Data.HashMap.Strict as HM +import qualified Data.HashSet as HS +import Data.Maybe (isNothing) import Data.Monoid import Data.Ord import qualified Data.Text as T @@ -97,12 +101,14 @@ import Chainweb.Cut import Chainweb.Cut.Create import Chainweb.Graph import Chainweb.Payload +import Chainweb.Parent import Chainweb.Test.TestVersions import Chainweb.Test.Utils.BlockHeader import Chainweb.Test.Utils -import Chainweb.Time (Micros(..), Time, TimeSpan) +import Chainweb.Time (Micros(..), Time, TimeSpan, epoch) import qualified Chainweb.Time as Time (second) import Chainweb.Utils +import Chainweb.Utils.Rule import Chainweb.Utils.Serialization import Chainweb.Version import Chainweb.Version.Utils @@ -530,35 +536,112 @@ prop_meetJoinAbsorption wdb = do properties_lattice :: HasVersion - => RocksDb -> ChainwebVersion -> [(String, T.Property)] -properties_lattice db v = - [ ("joinIdemPotent", ioTest db v prop_joinIdempotent) - , ("joinCommutative", ioTest db v prop_joinCommutative) - , ("joinAssociative", ioTest db v prop_joinAssociative) -- Fails - , ("joinIdentity", ioTest db v prop_joinIdentity) - - , ("meetIdemPotent", ioTest db v prop_meetIdempotent) - , ("meetCommutative", ioTest db v prop_meetCommutative) - , ("meetAssociative", ioTest db v prop_meetAssociative) - , ("meetZeroAbsorption", ioTest db v prop_meetZeroAbsorption) -- Fails - - , ("joinMeetAbsorption", ioTest db v prop_joinMeetAbsorption) - , ("meetJoinAbsorption", ioTest db v prop_meetJoinAbsorption) -- Fails + => RocksDb -> [(String, T.Property)] +properties_lattice db = + [ ("joinIdemPotent", ioTest db prop_joinIdempotent) + , ("joinCommutative", ioTest db prop_joinCommutative) + , ("joinAssociative", ioTest db prop_joinAssociative) -- Fails + , ("joinIdentity", ioTest db prop_joinIdentity) + + , ("meetIdemPotent", ioTest db prop_meetIdempotent) + , ("meetCommutative", ioTest db prop_meetCommutative) + , ("meetAssociative", ioTest db prop_meetAssociative) + , ("meetZeroAbsorption", ioTest db prop_meetZeroAbsorption) -- Fails + + , ("joinMeetAbsorption", ioTest db prop_joinMeetAbsorption) + , ("meetJoinAbsorption", ioTest db prop_meetJoinAbsorption) -- Fails + , ("noMixedTransitionalCuts", prop_noMixedTransitionalCuts db) ] +prop_noMixedTransitionalCuts + :: RocksDb + -> T.Property +prop_noMixedTransitionalCuts baseDb = + T.monadicIO $ withVersion v $ case implicitVersion ^. versionGraphs of + (transitionHeight, transitionGraph) `Above` Bottom (_, startGraph) -> do + db' <- liftIO $ testRocksDb "Chainweb.Test.Cut" baseDb + wdb <- liftIO (initWebBlockHeaderDb db') + let startCut = genesisCut + let startCids = graphChainIds startGraph + -- to start, mine until we are one block behind the transition on all chains. + preTransitionCut <- flip execStateT startCut $ + replicateM_ (int $ transitionHeight - 1) $ do + forM_ startCids $ \cid -> do + c <- get + Right (T2 _ c') <- lift $ mine wdb 0 c cid + put c' + -- then, pick a breakout chain which we will attempt to mine beyond + -- the transition before the rest of the chains reach the + -- transition. + -- note that in order to do this, the transition chain *must* have + -- adjacent chains post-transition that all exist pre-transition, + -- otherwise we cannot continue to mine it past the transition. + (breakoutChain, breakoutChainAdjacents) <- T.pick $ do + T.suchThat + (do + breakoutChain <- T.oneof (return <$> toList startCids) + let breakoutChainAdjacents = adjacentChainIds transitionGraph breakoutChain + return (breakoutChain, breakoutChainAdjacents) + ) + (\(_, breakoutChainAdjacents) -> + breakoutChainAdjacents `HS.isSubsetOf` graphChainIds startGraph) + -- now we set up a dangerous situation: we mine the breakout chain + -- and its adjacents to get them to the transition height. unless + -- it's prevented, the breakout chain should be able to progress + -- beyond the transition. + dangerousCut <- flip execStateT preTransitionCut $ + forM_ (breakoutChain : toList breakoutChainAdjacents) $ \cid -> do + c <- get + Right (T2 _ c') <- lift $ mine wdb 0 c cid + put c' + let adjacentBlocks = HM.mapWithKey + (\acid () -> Parent $ dangerousCut ^?! ixg acid) + (HS.toMap breakoutChainAdjacents) + (_, ext) <- liftIO $ + extend dangerousCut Nothing Nothing + WorkParents + { _workParent' = Parent $ dangerousCut ^?! ixg breakoutChain + , _workAdjacentParents' = adjacentBlocks + } + SolvedWork + { _solvedAdjacentHash = + adjacentsHash $ BlockHashRecord (fmap (view blockHash) <$> adjacentBlocks) + , _solvedChainId = breakoutChain + , _solvedParentHash = Parent $ + dangerousCut ^?! ixg breakoutChain . blockHash + , _solvedPayloadHash = _payloadWithOutputsPayloadHash $ testPayload + $ B8.intercalate "," [ sshow (_versionName implicitVersion), sshow breakoutChain, "TEST PAYLOAD"] + , _solvedWorkNonce = Nonce 0 + , _solvedWorkCreationTime = BlockCreationTime epoch + } + liftIO $ deleteNamespaceRocksDb db' + -- there should be no such legal cut extension. + T.assert (isNothing ext) + _ -> error "timedConsensusVersion graphs have changed" + where + v = timedConsensusVersion petersenChainGraph twentyChainGraph + mine :: HasVersion => WebBlockHeaderDb -> Int -> Cut -> ChainId -> T.PropertyM IO (Either MineFailure (T2 BlockHeader Cut)) + mine wdb seed c cid = do + n' <- T.pick $ Nonce . int . (* seed) <$> T.arbitrary + delay <- pickBlind $ arbitraryBlockTimeOffset Time.second (plus Time.second Time.second) + liftIO (testMine' wdb n' delay pay cid c) + where + pay = _payloadWithOutputsPayloadHash $ testPayload + $ B8.intercalate "," [ sshow (_versionName implicitVersion), sshow cid, "TEST PAYLOAD"] + properties_lattice_passing :: HasVersion - => RocksDb -> ChainwebVersion -> [(String, T.Property)] -properties_lattice_passing db v = - [ ("joinIdemPotent", ioTest db v prop_joinIdempotent) - , ("joinCommutative", ioTest db v prop_joinCommutative) - , ("joinIdentity", ioTest db v prop_joinIdentity) + => RocksDb -> [(String, T.Property)] +properties_lattice_passing db = + [ ("joinIdemPotent", ioTest db prop_joinIdempotent) + , ("joinCommutative", ioTest db prop_joinCommutative) + , ("joinIdentity", ioTest db prop_joinIdentity) - , ("meetIdemPotent", ioTest db v prop_meetIdempotent) - , ("meetCommutative", ioTest db v prop_meetCommutative) - , ("meetAssociative", ioTest db v prop_meetAssociative) + , ("meetIdemPotent", ioTest db prop_meetIdempotent) + , ("meetCommutative", ioTest db prop_meetCommutative) + , ("meetAssociative", ioTest db prop_meetAssociative) - , ("joinMeetAbsorption", ioTest db v prop_joinMeetAbsorption) + , ("joinMeetAbsorption", ioTest db prop_joinMeetAbsorption) ] -- -------------------------------------------------------------------------- -- @@ -598,8 +681,8 @@ prop_meetGenesisCut wdb = liftIO $ prop_arbitraryForkBraiding :: HasVersion - => RocksDb -> ChainwebVersion -> T.Property -prop_arbitraryForkBraiding db v = ioTest db v $ \wdb -> do + => RocksDb -> T.Property +prop_arbitraryForkBraiding db = ioTest db $ \wdb -> do TestFork b cl cr <- arbitraryFork wdb T.assert (prop_cutBraiding b) T.assert (prop_cutBraiding cl) @@ -608,16 +691,16 @@ prop_arbitraryForkBraiding db v = ioTest db v $ \wdb -> do prop_joinBase :: HasVersion - => RocksDb -> ChainwebVersion -> T.Property -prop_joinBase db v = ioTest db v $ \wdb -> do + => RocksDb -> T.Property +prop_joinBase db = ioTest db $ \wdb -> do TestFork b cl cr <- arbitraryFork wdb m <- liftIO $ join wdb (prioritizeHeavier cl cr) cl cr return (_joinBase m == b) prop_joinBaseMeet :: HasVersion - => RocksDb -> ChainwebVersion -> T.Property -prop_joinBaseMeet db v = ioTest db v $ \wdb -> do + => RocksDb -> T.Property +prop_joinBaseMeet db = ioTest db $ \wdb -> do TestFork _ a b <- arbitraryFork wdb liftIO $ (==) <$> meet wdb a b @@ -625,18 +708,19 @@ prop_joinBaseMeet db v = ioTest db v $ \wdb -> do properties_testMining :: HasVersion - => RocksDb -> ChainwebVersion -> [(String, T.Property)] -properties_testMining db v = - [ ("Cuts of arbitrary fork have valid braiding", prop_arbitraryForkBraiding db v)] + => RocksDb -> [(String, T.Property)] +properties_testMining db = + [ ("Cuts of arbitrary fork have valid braiding", prop_arbitraryForkBraiding db)] properties_miscCut :: HasVersion - => RocksDb -> ChainwebVersion -> [(String, T.Property)] -properties_miscCut db v = - [ ("prop_joinBase", prop_joinBase db v) - , ("prop_joinBaseMeet", prop_joinBaseMeet db v) - , ("prop_meetGenesisCut", ioTest db v prop_meetGenesisCut) - , ("Cuts of arbitrary fork have valid braiding", prop_arbitraryForkBraiding db v) + => RocksDb -> [(String, T.Property)] +properties_miscCut db = + [ ("prop_joinBase", prop_joinBase db) + , ("prop_joinBaseMeet", prop_joinBaseMeet db) + , ("prop_meetGenesisCut", ioTest db prop_meetGenesisCut) + , ("Cuts of arbitrary fork have valid braiding", prop_arbitraryForkBraiding db) + , ("noMixedTransitionalCuts", prop_noMixedTransitionalCuts db) ] -- -------------------------------------------------------------------------- -- @@ -675,10 +759,10 @@ properties_misc = properties :: RocksDb -> [(String, T.Property)] properties db = withVersion v - $ properties_lattice_passing db v + $ properties_lattice_passing db <> withVersion v properties_cut - <> properties_testMining db v - <> properties_miscCut db v + <> properties_testMining db + <> properties_miscCut db <> properties_misc where v = barebonesTestVersion pairChainGraph @@ -687,13 +771,13 @@ properties db -- TestTools ioTest - :: RocksDb - -> ChainwebVersion + :: HasVersion + => RocksDb -> (WebBlockHeaderDb -> T.PropertyM IO Bool) -> T.Property -ioTest baseDb v f = T.monadicIO $ do +ioTest baseDb f = T.monadicIO $ do db' <- liftIO $ testRocksDb "Chainweb.Test.Cut" baseDb - liftIO (withVersion v initWebBlockHeaderDb db') >>= f >>= T.assert + liftIO (initWebBlockHeaderDb db') >>= f >>= T.assert liftIO $ deleteNamespaceRocksDb db' pickBlind :: T.Gen a -> T.PropertyM IO a diff --git a/test/lib/Chainweb/Test/MultiNode.hs b/test/lib/Chainweb/Test/MultiNode.hs index a91e943bda..a760652b84 100644 --- a/test/lib/Chainweb/Test/MultiNode.hs +++ b/test/lib/Chainweb/Test/MultiNode.hs @@ -92,6 +92,7 @@ import Data.Set qualified as Set import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T +import Data.Text.IO qualified as T import Database.SQLite3.Direct (Database) import GHC.Generics import Numeric.Natural @@ -236,7 +237,7 @@ multiNode loglevel write bootstrapPeerInfoVar conf rdb pactDbDir nid inner = do inner nid cw where logger :: GenericLogger - logger = addLabel ("node", toText nid) $ genericLogger loglevel write + logger = addLabel ("node", toText nid) $ genericLogger loglevel T.putStrLn namespacedNodeRocksDb = rdb { _rocksDbNamespace = T.encodeUtf8 $ toText nid } @@ -627,7 +628,7 @@ test test loglevel n seconds rdb pactDbDir step = do -- Count log messages and only print the first 60 messages let tastylog = step . T.unpack - let logFun = tastylog + let logFun = T.putStrLn maxLogMsgs = 60 var <- newMVar (0 :: Int) let countedLog msg = modifyMVar_ var $ \c -> force (succ c) <$ diff --git a/test/lib/Chainweb/Test/TestVersions.hs b/test/lib/Chainweb/Test/TestVersions.hs index 69cea4a2b4..c298c3eca9 100644 --- a/test/lib/Chainweb/Test/TestVersions.hs +++ b/test/lib/Chainweb/Test/TestVersions.hs @@ -7,6 +7,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE RankNTypes #-} +{-# OPTIONS_GHC -Wno-missing-fields #-} module Chainweb.Test.TestVersions ( barebonesTestVersion @@ -18,7 +19,6 @@ module Chainweb.Test.TestVersions , timedConsensusVersion , instantCpmTestVersion , checkpointerTestVersion - , testVersions ) where import Control.Lens hiding (elements) @@ -52,6 +52,7 @@ import P2P.Peer import Chainweb.Payload (PayloadWithOutputs_(_payloadWithOutputsPayloadHash), PayloadWithOutputs) import qualified Pact.Core.Names as Pact import qualified Pact.Core.Gas as Pact +import qualified Data.List as L testBootstrapPeerInfos :: PeerInfo testBootstrapPeerInfos = @@ -73,78 +74,27 @@ testBootstrapPeerInfos = } } -type VersionBuilder = HasVersion => ChainwebVersion - --- | Executes a `VersionBuilder` to build a `ChainwebVersion`, by taking its --- fixed point. Additionally registers it in the global version registry. -buildTestVersion :: VersionBuilder -> ChainwebVersion -buildTestVersion f = - v - where - v = withVersion v f -{-# noinline buildTestVersion #-} - --- | All testing `ChainwebVersion`s *must* have unique names and *must* be --- included in this list to be assigned a version code, and also registered via --- `buildTestVersion` into the global version registry. Failure to do so will --- result in runtime errors from `Chainweb.Version.Registry`. -testVersions :: [ChainwebVersionName] -testVersions = _versionName <$> concat - -- [ [ fastForkingCpmTestVersion (knownChainGraph g) - -- | g :: KnownGraph <- [minBound..maxBound] - -- ] - -- , [ slowForkingCpmTestVersion (knownChainGraph g) - -- | g :: KnownGraph <- [minBound..maxBound] - -- ] - [ [ barebonesTestVersion (knownChainGraph g) - | g :: KnownGraph <- [minBound..maxBound] - ] - -- , [ noBridgeCpmTestVersion (knownChainGraph g) - -- | g :: KnownGraph <- [minBound..maxBound] - -- ] - , [ timedConsensusVersion (knownChainGraph g1) (knownChainGraph g2) - | g1 :: KnownGraph <- [minBound..maxBound] - , g2 :: KnownGraph <- [minBound..maxBound] - ] - , [ quirkedGasInstantCpmTestVersion (knownChainGraph g) - | g :: KnownGraph <- [minBound..maxBound] - ] - , [ quirkedGasPact5InstantCpmTestVersion (knownChainGraph g) - | g :: KnownGraph <- [minBound..maxBound] - ] - , [ instantCpmTestVersion (knownChainGraph g) - | g :: KnownGraph <- [minBound..maxBound] - ] - -- , [ pact5InstantCpmTestVersion (knownChainGraph g) - -- | g :: KnownGraph <- [minBound..maxBound] - -- ] - , [ checkpointerTestVersion (knownChainGraph g) - | g :: KnownGraph <- [minBound..maxBound] - ] - ] - -- | Details common to all test versions thus far. --- Using this, a `ChainwebVersion`'s `versionCode` is set to the version's --- index in `testVersions`, to ensure that all test versions have unique codes --- in the global version registry in `Chainweb.Version.Registry`. -testVersionTemplate :: VersionBuilder -testVersionTemplate = implicitVersion - & versionCode .~ ChainwebVersionCode (int (fromJuste $ List.elemIndex (_versionName implicitVersion) testVersions) + 0x80000000) - & versionHeaderBaseSizeBytes .~ 318 - 110 - & versionWindow .~ WindowWidth 120 - & versionMaxBlockGasLimit .~ Bottom (minBound, Just 2_000_000) - & versionBootstraps .~ [testBootstrapPeerInfos] - & versionVerifierPluginNames .~ onAllChains (Bottom (minBound, mempty)) - & versionServiceDate .~ Nothing +testVersionTemplate :: Rule BlockHeight ChainGraph -> ChainwebVersion +testVersionTemplate gs = ChainwebVersion + { _versionCode = ChainwebVersionCode 0x80000000 + , _versionGraphs = gs + , _versionHeaderBaseSizeBytes = 318 - 110 + , _versionWindow = WindowWidth 120 + , _versionMaxBlockGasLimit = Bottom (minBound, Just 2_000_000) + , _versionBootstraps = [testBootstrapPeerInfos] + , _versionVerifierPluginNames = (Bottom (minBound, mempty) <$ cids) + , _versionServiceDate = Nothing + } + where cids = ChainMap $ HS.toMap $ graphChainIds $ snd $ ruleHead gs -- | A test version without Pact or PoW, with only one chain graph. barebonesTestVersion :: ChainGraph -> ChainwebVersion -barebonesTestVersion g = buildTestVersion $ - testVersionTemplate +barebonesTestVersion g = + testVersionTemplate gs & versionWindow .~ WindowWidth 120 & versionBlockDelay .~ BlockDelay 1_000_000 & versionName .~ ChainwebVersionName ("test-" <> toText g) - & versionGraphs .~ Bottom (minBound, g) & versionCheats .~ VersionCheats { _disablePow = True , _fakeFirstEpochStart = True @@ -155,126 +105,151 @@ barebonesTestVersion g = buildTestVersion $ , _disablePeerValidation = True } & versionGenesis .~ VersionGenesis - { _genesisBlockPayload = onAllChains $ _payloadWithOutputsPayloadHash emptyPayload - , _genesisBlockTarget = onAllChains maxTarget - , _genesisTime = onAllChains $ BlockCreationTime epoch + { _genesisBlockPayload = _payloadWithOutputsPayloadHash emptyPayload <$ cids + , _genesisBlockTarget = maxTarget <$ cids + , _genesisTime = BlockCreationTime epoch <$ cids + } + & versionForks .~ HM.fromList [ (f, ForkAtGenesis <$ cids) | f <- [minBound..maxBound] ] + & versionQuirks .~ VersionQuirks + { _quirkGasFees = HM.empty <$ cids } - & versionForks .~ HM.fromList [ (f, onAllChains ForkAtGenesis) | f <- [minBound..maxBound] ] - & versionQuirks .~ noQuirks - & versionUpgrades .~ onAllChains HM.empty + & versionUpgrades .~ (HM.empty <$ cids) + where + gs = Bottom (minBound, g) + cids = ChainMap $ HS.toMap $ graphChainIds $ snd $ ruleHead gs -- | A test version without Pact or PoW, with a chain graph upgrade at block height 8. timedConsensusVersion :: ChainGraph -> ChainGraph -> ChainwebVersion -timedConsensusVersion g1 g2 = buildTestVersion $ - testVersionTemplate - & versionName .~ ChainwebVersionName ("timedConsensus-" <> toText g1 <> "-" <> toText g2) - & versionBlockDelay .~ BlockDelay 1_000_000 - & versionWindow .~ WindowWidth 120 - & versionForks .~ tabulateHashMap (\case - SkipTxTimingValidation -> onAllChains $ ForkAtBlockHeight (BlockHeight 2) - -- pact is disabled, we don't care about pact forks - _ -> onAllChains ForkAtGenesis - ) - & versionQuirks .~ noQuirks - & versionUpgrades .~ onAllChains HM.empty - & versionGraphs .~ (BlockHeight 8, g2) `Above` Bottom (minBound, g1) - & versionCheats .~ VersionCheats - { _disablePow = True - , _fakeFirstEpochStart = True - , _disablePact = True - } - & versionDefaults .~ VersionDefaults - { _disableMempoolSync = True - , _disablePeerValidation = True - } - & versionGenesis .~ VersionGenesis - { _genesisBlockPayload = onChains $ [] -- TODO: PP - -- (unsafeChainId 0, TN0.payloadBlock) : - -- [(n, TNN.payloadBlock) | n <- HS.toList (unsafeChainId 0 `HS.delete` chainIds v)] - , _genesisBlockTarget = onAllChains maxTarget - , _genesisTime = onAllChains $ BlockCreationTime epoch - } +timedConsensusVersion g1 g2 = + testVersionTemplate gs + & versionName .~ ChainwebVersionName ("timedConsensus-" <> toText g1 <> "-" <> toText g2) + & versionBlockDelay .~ BlockDelay 1_000_000 + & versionWindow .~ WindowWidth 120 + & versionForks .~ tabulateHashMap (\case + SkipTxTimingValidation -> ForkAtBlockHeight (BlockHeight 2) <$ cids + -- pact is disabled, we don't care about pact forks + _ -> ForkAtGenesis <$ cids + ) + & versionQuirks .~ VersionQuirks + { _quirkGasFees = HM.empty <$ cids + } + & versionUpgrades .~ (HM.empty <$ cids) + & versionCheats .~ VersionCheats + { _disablePow = True + , _fakeFirstEpochStart = True + , _disablePact = True + } + & versionDefaults .~ VersionDefaults + { _disableMempoolSync = True + , _disablePeerValidation = True + } + & versionGenesis .~ VersionGenesis + { _genesisBlockPayload = onChains $ + (unsafeChainId 0, _payloadWithOutputsPayloadHash $ IN0.payloadBlock) : + [ (n, _payloadWithOutputsPayloadHash INN.payloadBlock) + | n <- unsafeChainId 0 `L.delete` fmap fst (itoList cids) + ] + , _genesisBlockTarget = maxTarget <$ cids + , _genesisTime = BlockCreationTime epoch <$ cids + } + & versionPayloadProviderTypes .~ (PactProvider <$ cids) + where + gs = (BlockHeight 8, g2) `Above` Bottom (minBound, g1) + cids = ChainMap $ HS.toMap $ graphChainIds $ snd $ ruleHead gs -- | A test version without Pact or PoW. checkpointerTestVersion :: ChainGraph -> ChainwebVersion -checkpointerTestVersion g1 = buildTestVersion $ - testVersionTemplate - & versionName .~ ChainwebVersionName ("pact5-checkpointertest-" <> toText g1) - & versionBlockDelay .~ BlockDelay 1_000_000 - & versionWindow .~ WindowWidth 120 - & versionForks .~ tabulateHashMap (\case - SkipTxTimingValidation -> onAllChains $ ForkAtBlockHeight (BlockHeight 2) - -- pact is disabled, we don't care about pact forks - _ -> onAllChains ForkAtGenesis - ) - & versionQuirks .~ noQuirks - & versionUpgrades .~ onAllChains HM.empty - & versionGraphs .~ Bottom (minBound, g1) - & versionCheats .~ VersionCheats - { _disablePow = True - , _fakeFirstEpochStart = True - , _disablePact = True - } - & versionDefaults .~ VersionDefaults - { _disableMempoolSync = True - , _disablePeerValidation = True - } - & versionGenesis .~ VersionGenesis - { _genesisBlockPayload = onChains [ (n, _payloadWithOutputsPayloadHash emptyPayload) | n <- HS.toList chainIds ] - , _genesisBlockTarget = onAllChains maxTarget - , _genesisTime = onAllChains $ BlockCreationTime epoch - } - & versionPayloadProviderTypes .~ onAllChains PactProvider +checkpointerTestVersion g1 = + testVersionTemplate gs + & versionName .~ ChainwebVersionName ("pact5-checkpointertest-" <> toText g1) + & versionBlockDelay .~ BlockDelay 1_000_000 + & versionWindow .~ WindowWidth 120 + & versionForks .~ tabulateHashMap (\case + SkipTxTimingValidation -> ForkAtBlockHeight (BlockHeight 2) <$ cids + -- pact is disabled, we don't care about pact forks + _ -> ForkAtGenesis <$ cids + ) + & versionQuirks .~ VersionQuirks + { _quirkGasFees = HM.empty <$ cids + } + & versionUpgrades .~ (HM.empty <$ cids) + & versionCheats .~ VersionCheats + { _disablePow = True + , _fakeFirstEpochStart = True + , _disablePact = True + } + & versionDefaults .~ VersionDefaults + { _disableMempoolSync = True + , _disablePeerValidation = True + } + & versionGenesis .~ VersionGenesis + { _genesisBlockPayload = onChains + [ (n, _payloadWithOutputsPayloadHash emptyPayload) + | n <- fst <$> itoList cids + ] + , _genesisBlockTarget = maxTarget <$ cids + , _genesisTime = BlockCreationTime epoch <$ cids + } + & versionPayloadProviderTypes .~ (PactProvider <$ cids) + where + gs = Bottom (minBound, g1) + cids = ChainMap $ HS.toMap $ graphChainIds $ snd $ ruleHead gs -- | A family of versions each with Pact enabled and PoW disabled. -cpmTestVersion :: ChainGraph -> VersionBuilder -cpmTestVersion g = - testVersionTemplate - & versionWindow .~ WindowWidth 120 - & versionBlockDelay .~ BlockDelay (Micros 100_000) - & versionGraphs .~ Bottom (minBound, g) - & versionCheats .~ VersionCheats - { _disablePow = True - , _fakeFirstEpochStart = True - , _disablePact = False - } - & versionDefaults .~ VersionDefaults - { _disableMempoolSync = False - , _disablePeerValidation = True - } - & versionUpgrades .~ onAllChains mempty - & versionPayloadProviderTypes .~ onAllChains PactProvider +cpmTestVersion :: Rule BlockHeight ChainGraph -> ChainwebVersion +cpmTestVersion gs = + testVersionTemplate gs + & versionWindow .~ WindowWidth 120 + & versionBlockDelay .~ BlockDelay (Micros 100_000) + & versionCheats .~ VersionCheats + { _disablePow = True + , _fakeFirstEpochStart = True + , _disablePact = False + } + & versionDefaults .~ VersionDefaults + { _disableMempoolSync = False + , _disablePeerValidation = True + } + & versionUpgrades .~ (mempty <$ cids) + & versionPayloadProviderTypes .~ (PactProvider <$ cids) + where + cids = ChainMap $ HS.toMap $ graphChainIds $ snd $ ruleHead gs -- | CPM version (see `cpmTestVersion`) with forks and upgrades instantly enabled, -- and with a gas fee quirk. quirkedGasInstantCpmTestVersion :: ChainGraph -> ChainwebVersion -quirkedGasInstantCpmTestVersion g = buildTestVersion $ - cpmTestVersion g +quirkedGasInstantCpmTestVersion g = + cpmTestVersion gs & versionName .~ ChainwebVersionName ("quirked-instant-CPM-" <> toText g) & versionForks .~ tabulateHashMap (\case - _ -> onAllChains ForkAtGenesis) + _ -> ForkAtGenesis <$ cids) & versionQuirks .~ VersionQuirks { _quirkGasFees = onChain (unsafeChainId 0) $ HM.singleton (BlockHeight 2, TxBlockIdx 0) (Pact.Gas 1) } & versionGenesis .~ VersionGenesis - { _genesisBlockPayload = onChains $ [] -- TODO: PP - -- (unsafeChainId 0, IN0.payloadBlock) : - -- [(n, INN.payloadBlock) | n <- HS.toList (unsafeChainId 0 `HS.delete` graphChainIds g)] - , _genesisBlockTarget = onAllChains maxTarget - , _genesisTime = onAllChains $ BlockCreationTime epoch + { _genesisBlockPayload = onChains $ + (unsafeChainId 0, _payloadWithOutputsPayloadHash IN0.payloadBlock) : + [ (n, _payloadWithOutputsPayloadHash INN.payloadBlock) + | n <- HS.toList (unsafeChainId 0 `HS.delete` graphChainIds g) + ] + , _genesisBlockTarget = maxTarget <$ cids + , _genesisTime = BlockCreationTime epoch <$ cids } - & versionUpgrades .~ onAllChains mempty - & versionVerifierPluginNames .~ onAllChains (Bottom (minBound, mempty)) + & versionUpgrades .~ (mempty <$ cids) + & versionVerifierPluginNames .~ (Bottom (minBound, mempty) <$ cids) + where + gs = Bottom (minBound, g) + cids = ChainMap $ HS.toMap $ graphChainIds $ snd $ ruleHead gs -- | CPM version (see `cpmTestVersion`) with forks and upgrades instantly enabled, -- and with a gas fee quirk. quirkedGasPact5InstantCpmTestVersion :: ChainGraph -> ChainwebVersion -quirkedGasPact5InstantCpmTestVersion g = buildTestVersion $ - cpmTestVersion g +quirkedGasPact5InstantCpmTestVersion g = + cpmTestVersion gs & versionName .~ ChainwebVersionName ("quirked-pact5-instant-CPM-" <> toText g) & versionForks .~ tabulateHashMap (\case - _ -> onAllChains ForkAtGenesis) + _ -> ForkAtGenesis <$ cids) & versionQuirks .~ VersionQuirks { _quirkGasFees = onChain (unsafeChainId 0) $ HM.singleton (BlockHeight 1, TxBlockIdx 0) (Pact.Gas 1) @@ -283,65 +258,73 @@ quirkedGasPact5InstantCpmTestVersion g = buildTestVersion $ { _genesisBlockPayload = onChains $ (unsafeChainId 0, _payloadWithOutputsPayloadHash IN0.payloadBlock) : [(n, _payloadWithOutputsPayloadHash INN.payloadBlock) | n <- HS.toList (unsafeChainId 0 `HS.delete` graphChainIds g)] - , _genesisBlockTarget = onAllChains maxTarget - , _genesisTime = onAllChains $ BlockCreationTime epoch + , _genesisBlockTarget = maxTarget <$ cids + , _genesisTime = BlockCreationTime epoch <$ cids } - & versionUpgrades .~ onAllChains mempty - & versionVerifierPluginNames .~ onAllChains (Bottom (minBound, mempty)) + & versionUpgrades .~ (mempty <$ cids) + & versionVerifierPluginNames .~ (Bottom (minBound, mempty) <$ cids) + where + gs = Bottom (minBound, g) + cids = ChainMap $ HS.toMap $ graphChainIds $ snd $ ruleHead gs -- | CPM version (see `cpmTestVersion`) with forks and upgrades instantly enabled -- at genesis EXCEPT Pact 5. instantCpmTestVersion :: ChainGraph -> ChainwebVersion -instantCpmTestVersion g = buildTestVersion $ - cpmTestVersion g +instantCpmTestVersion g = + cpmTestVersion gs & versionName .~ ChainwebVersionName ("instant-CPM-" <> toText g) & versionForks .~ tabulateHashMap (\case - _ -> onAllChains ForkAtGenesis + _ -> ForkAtGenesis <$ cids ) - & versionQuirks .~ noQuirks + & versionQuirks .~ VersionQuirks + { _quirkGasFees = mempty <$ cids + } & versionGenesis .~ VersionGenesis { _genesisBlockPayload = onChains $ (unsafeChainId 0, _payloadWithOutputsPayloadHash IN0.payloadBlock) : [(n, _payloadWithOutputsPayloadHash INN.payloadBlock) | n <- HS.toList (unsafeChainId 0 `HS.delete` graphChainIds g)] - , _genesisBlockTarget = onAllChains maxTarget - , _genesisTime = onAllChains $ BlockCreationTime epoch + , _genesisBlockTarget = maxTarget <$ cids + , _genesisTime = BlockCreationTime epoch <$ cids } - & versionUpgrades .~ onAllChains mempty - & versionVerifierPluginNames .~ onAllChains + & versionUpgrades .~ ChainMap mempty + & versionVerifierPluginNames .~ (Bottom ( minBound , Set.fromList $ map Pact.VerifierName ["allow", "hyperlane_v3_announcement", "hyperlane_v3_message"] ) - ) + <$ cids) + where + gs = Bottom (minBound, g) + cids = ChainMap $ HS.toMap $ graphChainIds $ snd $ ruleHead gs -- -- | CPM version (see `cpmTestVersion`) with forks and upgrades instantly enabled -- -- at genesis. We also have an upgrade after genesis that redeploys Coin v5 as -- -- a Pact 5 module. -- pact5SlowCpmTestVersion :: ChainGraph -> ChainwebVersion --- pact5SlowCpmTestVersion g = buildTestVersion $ \v -> v +-- pact5SlowCpmTestVersion g = -- & cpmTestVersion g -- & versionName .~ ChainwebVersionName ("pact5-slow-CPM-" <> toText g) -- & versionForks .~ tabulateHashMap (\case -- -- genesis blocks are not ever run with Pact 5 -- Pact5Fork -> onChains [ (cid, ForkAtBlockHeight (succ $ genesisBlockHeight v cid)) | cid <- HS.toList $ graphChainIds g ] -- -- SPV Bridge is not in effect for Pact 5 yet. --- SPVBridge -> onAllChains ForkNever --- _ -> onAllChains ForkAtGenesis +-- SPVBridge -> ChainMap ForkNever +-- _ -> ChainMap ForkAtGenesis -- ) -- & versionQuirks .~ noQuirks -- & versionGenesis .~ VersionGenesis -- { _genesisBlockPayload = onChains $ [] -- TODO: PP -- -- (unsafeChainId 0, IN0.payloadBlock) : -- -- [(n, INN.payloadBlock) | n <- HS.toList (unsafeChainId 0 `HS.delete` graphChainIds g)] --- , _genesisBlockTarget = onAllChains maxTarget --- , _genesisTime = onAllChains $ BlockCreationTime epoch +-- , _genesisBlockTarget = ChainMap maxTarget +-- , _genesisTime = ChainMap $ BlockCreationTime epoch -- } -- & versionUpgrades .~ indexByForkHeights v -- -- TODO: PP --- -- [ (Pact5Fork, onAllChains (Pact5Upgrade (List.map pactTxFrom4To5 CoinV6.transactions))) +-- -- [ (Pact5Fork, ChainMap (Pact5Upgrade (List.map pactTxFrom4To5 CoinV6.transactions))) -- [ -- ] --- & versionVerifierPluginNames .~ onAllChains +-- & versionVerifierPluginNames .~ ChainMap -- (Bottom -- ( minBound -- , Set.fromList $ map Pact.VerifierName ["allow", "hyperlane_v3_announcement", "hyperlane_v3_message"] diff --git a/test/multinode/MultiNodeNetworkTests.hs b/test/multinode/MultiNodeNetworkTests.hs index bd99e7f52e..57b5a3487d 100644 --- a/test/multinode/MultiNodeNetworkTests.hs +++ b/test/multinode/MultiNodeNetworkTests.hs @@ -21,6 +21,7 @@ import System.LogLevel import Test.Tasty import Test.Tasty.HUnit import qualified Chainweb.Test.MultiNode +import Chainweb.Version (withVersion) main :: IO () main = defaultMain suite @@ -34,7 +35,8 @@ suite = independentSequentialTestGroup "MultiNodeNetworkTests" [ testCaseSteps "ConsensusNetwork - TimedConsensus - 10 nodes - 30 seconds" $ \step -> withTempRocksDb "multinode-tests-timedconsensus-petersen-twenty-rocks" $ \rdb -> withSystemTempDirectory "multinode-tests-timedconsensus-petersen-twenty-pact" $ \pactDbDir -> - Chainweb.Test.MultiNode.test loglevel (timedConsensusVersion petersenChainGraph twentyChainGraph) 10 30 rdb pactDbDir step + withVersion (timedConsensusVersion petersenChainGraph twentyChainGraph) $ + Chainweb.Test.MultiNode.test loglevel 10 30 rdb pactDbDir step -- , testCaseSteps "ConsensusNetwork - InstantTimedCPM singleChainGraph - 10 nodes - 30 seconds" $ \step -> -- withTempRocksDb "multinode-tests-instantcpm-single-rocks" $ \rdb -> -- withSystemTempDirectory "multinode-tests-instantcpm-single-pact" $ \pactDbDir ->