diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,38 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## [2.3.0] - 2026-11-06 + +### Changed + +- This package requires haskoin-core 1.6.0, the release with the fixes of + the November 2026 security review. +- Breaking: the `version`, `timestamp` and `startHeight` fields of the + `Version` of an `OnlinePeer` are signed numbers, as haskoin-core 1.6.0 + reads them. `buildVersion` takes the same arguments as before. +- The headers are not reported as synced before the best header has the + `minimumChainWork` of the network. This holds for the `ChainSynced` event + and for `chainIsSynced`. A recent header on a chain with less work used to + be enough. +- Once the best header has the `minimumChainWork` of the network, a peer + whose headers fork from far below the tip, on a chain with less work, is + disconnected. haskoin-core 1.6.0 refuses such headers. +- A peer that sends a header the node already has at or below a checkpoint + is no longer disconnected. haskoin-core 1.6.0 returns the stored header. +- Transactions from Bitcoin Cash peers are read in the format without + witness only, as haskoin-core 1.6.0 reads them on a network without SegWit. +- The log line for an invalid payload gives the reason the parser refused it. +- The payload size limit is the `maxPayloadSize` of the command on the + network instead of the network's `maxMessageSize`. On Bitcoin Cash that is + 2 MiB for every message but `block`, `cmpctblock` and `blocktxn`, which may + be twice the block size. + +### Fixed + +- Peers that send more than 50000 entries in an `inv` or `getdata` message, + or a block locator of more than 101 hashes, are disconnected. haskoin-core + 1.6.0 refuses such a message as soon as it reads the count. + ## [2.2.0] - 2026-11-04 ### Changed diff --git a/haskoin-node.cabal b/haskoin-node.cabal --- a/haskoin-node.cabal +++ b/haskoin-node.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: haskoin-node -version: 2.2.0 +version: 2.3.0 synopsis: P2P library for Bitcoin and Bitcoin Cash description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -47,7 +47,7 @@ , data-default , fast-logger , hashable - , haskoin-core >=1.5.1 + , haskoin-core >=1.6.0 , mtl , network , nqe >=0.6.3 @@ -84,7 +84,7 @@ , data-default , fast-logger , hashable - , haskoin-core >=1.5.1 + , haskoin-core >=1.6.0 , haskoin-node , hspec , mtl diff --git a/src/Haskoin/Node/Chain.hs b/src/Haskoin/Node/Chain.hs --- a/src/Haskoin/Node/Chain.hs +++ b/src/Haskoin/Node/Chain.hs @@ -386,10 +386,11 @@ go it _ -> return () --- | Import a bunch of continuous headers. Returns 'True' if the number of --- headers is less than 2000, which means that there are no more headers to sync --- from the peer that delivered these. An empty headers message, which a peer --- sends when it has nothing after the locator, counts as done too. +-- | Import a bunch of continuous headers. Returns 'True' when the peer that +-- delivered them has no more headers to sync. That is the case when it sent +-- fewer than 'maxHeadersSize' (2000) headers, the most that one message may +-- hold. An empty headers message, which a peer sends when it has nothing +-- after the locator, counts as done too. importHeaders :: (MonadIO m) => Chain -> UTCTime -> [BlockHeader] -> m (Maybe Bool) importHeaders ch now hs = @@ -403,7 +404,7 @@ bb <- get_last atomically . modifyTVar ch.state $ \s -> s {syncing = set_best bb <$> s.syncing} - return (Just (length bns < 2000)) + return (Just (length bns < fromIntegral maxHeadersSize)) where set_best bb ChainSync {..} = ChainSync {best = bb, ..} timestamp = floor (utcTimeToPOSIXSeconds now) @@ -417,6 +418,11 @@ -- whether to notify other processes that the header chain has been synced. The -- state of the chain will be flipped to synced when this function returns -- 'True'. +-- +-- The best block must also have the 'minimumChainWork' of the network. +-- Bitcoin Core requires the same before it leaves initial block download. A +-- chain with less work is not the real one, however recent its last block +-- is. Below that work 'connectBlocks' does not refuse cheap forks either. notifySynced :: (MonadIO m) => Chain -> m Bool notifySynced ch = do bb <- runReaderT getBestBlockHeader ch.config @@ -425,6 +431,7 @@ s <- readTVar ch.state if | df > 7200 -> return False + | bb.work < ch.config.net.minimumChainWork -> return False | isJust s.syncing -> return False | not (null s.peers) -> return False | s.beenInSync -> return False diff --git a/src/Haskoin/Node/Peer.hs b/src/Haskoin/Node/Peer.hs --- a/src/Haskoin/Node/Peer.hs +++ b/src/Haskoin/Node/Peer.hs @@ -30,8 +30,6 @@ setFree, peerMessageDone, maxPendingMessages, - maxHeadersCount, - maxAddrCount, ) where @@ -45,10 +43,10 @@ import Data.Function (on) import Data.List (union) import Data.Maybe (isJust) -import Data.Serialize (decode, get, runGet, runPut) +import Data.Serialize (decode, runGet, runPut) import Data.String.Conversions (cs) import Data.Text (Text) -import Data.Word (Word32, Word64) +import Data.Word (Word32) import Haskoin import Haskoin.Node.Logger import Haskoin.Node.Loop (loopForever) @@ -120,15 +118,6 @@ maxPendingMessages :: Int maxPendingMessages = 16 --- | Most block headers a @headers@ message may carry. Bitcoin Core never --- sends more and disconnects peers that do. -maxHeadersCount :: Word64 -maxHeadersCount = 2000 - --- | Most addresses an @addr@ or @addrv2@ message may carry. -maxAddrCount :: Word64 -maxAddrCount = 1000 - -- | Tell the peer process that the node has finished handling one of the -- messages that it published, so that it may read another one. peerMessageDone :: (MonadIO m) => Peer -> m () @@ -185,8 +174,13 @@ -- | Internal conduit to parse messages coming from peer. The header is checked -- before the payload is read, so that a peer cannot make the node buffer a --- payload that it will reject anyway. A peer that sends anything invalid is --- disconnected. +-- payload that it will reject anyway. The size limit is the 'maxPayloadSize' +-- of the command. On Bitcoin Cash only messages that carry block content may +-- be larger than 2 MiB. A peer that sends anything invalid is disconnected. +-- +-- The counts of list messages are not checked here. 'getMessage' fails as +-- soon as it reads a count above the limit of the message. The limits are +-- 2000 headers and 1000 addresses, for example. inPeerConduit :: (MonadIO m) => PeerConfig -> ConduitT ByteString Message m () inPeerConduit PeerConfig {label, net, logger} = loopForever $ do @@ -200,7 +194,7 @@ Right h -> return h when (mgc /= net.magic) $ bad ("wrong network magic " <> cs (show mgc)) - when (len > net.maxMessageSize) $ + when (len > maxPayloadSize net cmd) $ bad ( "too large payload of " <> cs (show len) @@ -211,19 +205,14 @@ y <- takeCE (fromIntegral len) .| foldC when (B.length y /= fromIntegral len) $ bad ("truncated payload for cmd " <> cs (show cmd)) - forM_ (countLimit cmd) $ \limit -> - case runGet getCount y of - Right n - | n > limit -> - bad - ( "too many items (" - <> cs (show n) - <> ") in cmd " - <> cs (show cmd) - ) - _ -> return () case runGet (getMessage net) $ x `B.append` y of - Left _ -> bad ("invalid payload for cmd " <> cs (show cmd)) + Left e -> + bad + ( "invalid payload for cmd " + <> cs (show cmd) + <> ": " + <> cs (firstLine e) + ) Right msg -> do logDebug logger @@ -234,13 +223,9 @@ bad e = do logError logger (label <> " sent " <> e) error ("Peer sent " <> cs e) - getCount = do - VarInt n <- get - return n - countLimit MCHeaders = Just maxHeadersCount - countLimit MCAddr = Just maxAddrCount - countLimit MCAddrV2 = Just maxAddrCount - countLimit _ = Nothing + -- The reason is on the first line of the parser's error text. The lines + -- after it are call stack noise. + firstLine = takeWhile (/= '\n') -- | Outgoing peer conduit to serialize and send messages. outPeerConduit :: (Monad m) => Network -> ConduitT Message ByteString m () diff --git a/src/Haskoin/Node/PeerMgr.hs b/src/Haskoin/Node/PeerMgr.hs --- a/src/Haskoin/Node/PeerMgr.hs +++ b/src/Haskoin/Node/PeerMgr.hs @@ -658,15 +658,18 @@ Word64 -> Version buildVersion net nonce height loc rmt time = + -- The version, timestamp and start height of a version message are signed + -- numbers, as in Bitcoin Core. The values the node sends are far below the + -- point where the conversion would change them. Version - { version = myVersion, + { version = fromIntegral myVersion, services = loc.services, - timestamp = time, + timestamp = fromIntegral time, addrRecv = rmt, addrSend = loc, nonce = nonce, userAgent = VarString net.userAgent, - startHeight = height, + startHeight = fromIntegral height, relay = True } diff --git a/test/Haskoin/NodeSpec.hs b/test/Haskoin/NodeSpec.hs --- a/test/Haskoin/NodeSpec.hs +++ b/test/Haskoin/NodeSpec.hs @@ -22,7 +22,7 @@ import Data.Either (fromRight) import Data.List (find) import Data.Maybe (isJust, listToMaybe, mapMaybe) -import Data.Serialize (decode, get, runGet, runPut) +import Data.Serialize (decode, get, put, runGet, runPut) import Data.Time.Clock (NominalDiffTime) import Data.Time.Clock.POSIX (getPOSIXTime) import Database.RocksDB qualified as R @@ -172,6 +172,26 @@ testMerkle b = buildMerkleRoot (ths b) `shouldBe` Right b.header.merkle testMerkle b1 testMerkle b2 + it "downloads a block larger than 2 MiB" $ do + -- On Bitcoin Cash a block message may be up to twice the block size, + -- while every other message is limited to 2 MiB (2097152 bytes). + let script = B.replicate 3000000 0x6a + tx = Tx 1 [TxIn nullOutPoint B.empty maxBound] [TxOut 0 script] [] 0 + firstBlock : _ = allBlocks + big = Block firstBlock.header [tx] + withTestNodeBlocks [big] net "big-block" $ \TestNode {..} -> do + p <- waitForPeer nodeEvents + pbs <- getBlocks net 10 p [headerHash big.header] + let scriptSizes = + [[B.length o.script | o <- t.outputs] | b <- concat pbs, t <- b.txs] + scriptSizes `shouldBe` [[3000000]] + it "builds a version message with the given height and time" $ do + let local = NetworkAddress nodeNetwork (sockToHostAddress (SockAddrInet 0 0)) + remote = NetworkAddress 0 (sockToHostAddress (SockAddrInet 8333 0x08080808)) + v = buildVersion net 7 650000 local remote 1700000000 + v.version `shouldBe` 70012 + v.startHeight `shouldBe` 650000 + v.timestamp `shouldBe` 1700000000 describe "untrusted peers" $ do it "imports a full batch of 2000 headers" $ withTestNodeOpts @@ -212,6 +232,20 @@ $ \TestNode {..} -> do p <- waitForPeer nodeEvents waitForDisconnect nodeEvents p + it "disconnects a peer that announces a tx message larger than 2 MiB" $ do + -- Only the header is sent, with a length of 2 MiB plus one byte: + -- 2 × 1024 × 1024 + 1 = 2097153. The node must refuse it there, + -- without waiting for the payload. + let oversized = + runPut . put $ + MessageHeader net.magic MCTx 2097153 (checkSum32 B.empty) + withTestNodeOpts + (defOpts allBlocks) {react = reactAfterVerAck [Left oversized]} + net + "oversized-tx" + $ \TestNode {..} -> do + p <- waitForPeer nodeEvents + waitForDisconnect nodeEvents p it "disconnects a peer that sends a second verack" $ withTestNodeOpts (defOpts allBlocks) {react = reactAfterVerAck [Right MVerAck]} @@ -290,6 +324,29 @@ atomically $ readTVar getHeadersCount >>= checkSTM . (>= 1) threadDelay (1000 * 1000) readTVarIO getHeadersCount `shouldReturn` 1 + it "reports the headers as synced when the best header has the minimum chain work" $ do + -- Every regtest header has a work of 2. Genesis and one header on top + -- of it have 2 + 2 = 4, which is the minimum here. + fresh <- freshHeader net + let net4 = net {minimumChainWork = 4} + withTestNodeBlocks [Block fresh []] net4 "min-work-reached" $ + \TestNode {..} -> do + receiveMatch nodeEvents $ \case + ChainEvent (ChainBestBlock bn) | bn.height == 1 -> Just () + _ -> Nothing + chainSync testChain + chainIsSynced testChain `shouldReturn` True + it "does not report the headers as synced below the minimum chain work" $ do + -- Same chain with a work of 2 + 2 = 4, one short of a minimum of 5. + fresh <- freshHeader net + let net5 = net {minimumChainWork = 5} + withTestNodeBlocks [Block fresh []] net5 "min-work-missing" $ + \TestNode {..} -> do + receiveMatch nodeEvents $ \case + ChainEvent (ChainBestBlock bn) | bn.height == 1 -> Just () + _ -> Nothing + chainSync testChain + chainIsSynced testChain `shouldReturn` False it "syncs some headers" $ withTestNode net "connect-sync" $ \TestNode {..} -> do let bh = @@ -352,6 +409,19 @@ manyHeaders net n = MHeaders . Headers $ map (,VarInt 0) (appendBlocks net 0 net.genesisHeader n) + +-- | Valid header on top of genesis that is dated now. The node only counts +-- its headers as synced when the best one is less than two hours old, and +-- the headers of the other fixtures are years old. +freshHeader :: Network -> IO BlockHeader +freshHeader net = do + now <- round <$> getPOSIXTime + let genesis = net.genesisHeader + return $ + mineBlock + net + 0 + genesis {version = 4, prev = headerHash genesis, timestamp = now} waitForPeer :: (MonadIO m) => Inbox NodeEvent -> m Peer waitForPeer inbox =