haskoin-node 2.2.0 → 2.3.0

raw patch · 6 files changed

+144/−47 lines, 6 filesdep ~haskoin-corePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskoin-core

API changes (from Hackage documentation)

Files

• CHANGELOG.md +32/−0
• haskoin-node.cabal +3/−3
• src/Haskoin/Node/Chain.hs +12/−5
• src/Haskoin/Node/Peer.hs +20/−35
• src/Haskoin/Node/PeerMgr.hs +6/−3
• test/Haskoin/NodeSpec.hs +71/−1

@@ -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

@@ -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 <https://github.com/jprupp/haskoin-node#readme> 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

@@ -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

@@ -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 ()

@@ -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     } 

@@ -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 =