haskoin-node 1.4.2 → 1.4.3

raw patch · 5 files changed

+25/−17 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• haskoin-node.cabal +1/−1
• src/Haskoin/Node/Chain.hs +3/−3
• src/Haskoin/Node/Peer.hs +11/−9
• src/Haskoin/Node/PeerMgr.hs +4/−4

@@ -4,6 +4,12 @@ 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). +## [1.4.3] - 2026-08-13++### Fixed++- Fix regression with peer disconnection.+ ## [1.4.2] - 2026-08-13  ### Fixed

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-node-version:        1.4.2+version:        1.4.3 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

@@ -391,7 +391,7 @@           bb <- get_last           atomically . modifyTVar ch.state $ \s ->             s {syncing = set_best bb <$> s.syncing}-          return (Just (length hs == 2000))+          return (Just (length hs < 2000))   where     set_best bb ChainSync {..} = ChainSync {best = bb, ..}     timestamp = floor (utcTimeToPOSIXSeconds now)@@ -514,11 +514,11 @@     False ->       $(logDebugS)         "Chain"-        ("Removed peer from queue: " <> p.label)+        ("Removed peer " <> p.label <> " from queue")     True -> do       $(logDebugS)         "Chain"-        ("Releasing syncing peer: " <> p.label)+        ("Releasing syncing peer " <> p.label)       setFree p   where     remove_peer =

@@ -116,7 +116,7 @@   withRunInIO $ \run -> connect (run . peer_session p)   where     go = do-      $(logDebugS) "Peer" $ label <> " awaiting event..."+      $(logDebugS) "Peer " $ label <> " awaiting event..."       msg <- receive inbox       dispatchMessage cfg msg >>= bool (return ()) go     peer_session p ad = do@@ -149,14 +149,16 @@  -- | Internal conduit to parse messages coming from peer. inPeerConduit :: (MonadLoggerIO m) => PeerConfig -> ConduitT ByteString Message m ()-inPeerConduit pc@PeerConfig {label, net} = do-  $(logDebugS) "Peer" (label <> ": awaiting message...")+inPeerConduit pc@PeerConfig {label, net} = forever $ do+  $(logDebugS) "Peer" (label <> " awaiting message...")   x <- takeCE 24 .| foldC   when (B.null x) $ do-    $(logWarnS) "Peer" (label <> " sent empty header")+    $(logErrorS) "Peer" (label <> " sent empty message header")+    error "Peer sent empty message header"   case decode x of     Left e -> do-      $(logWarnS) "Peer" (label <> " sent invalid header")+      $(logErrorS) "Peer" (label <> " sent invalid message header")+      error "Peer sent invalid message header"     Right (MessageHeader _ cmd len _)       | len > 32 * 2 ^ (20 :: Int) ->           $(logWarnS) "Peer" $@@ -169,16 +171,16 @@           $(logDebugS) "Peer" (label <> " sent cmd " <> cs (show cmd))           y <- takeCE (fromIntegral len) .| foldC           case runGet (getMessage net) $ x `B.append` y of-            Left e ->+            Left e -> do               $(logErrorS)                 "Peer"-                (label <> ": sent invalid payload for cmd " <> cs (show cmd))+                (label <> " sent invalid payload for cmd " <> cs (show cmd))+              error "Peer sent invalid payload"             Right msg -> do               $(logDebugS)                 "Peer"-                (label <> " sent full message for cmd " <> cs (show cmd))+                (label <> " sent payload for cmd " <> cs (show cmd))               yield msg-              inPeerConduit pc  -- | Outgoing peer conduit to serialize and send messages. outPeerConduit :: (Monad m) => Network -> ConduitT Message ByteString m ()

@@ -211,7 +211,7 @@     Nothing -> do       $(logWarnS)         "PeerMgr"-        ("Version rejected for peer " <> p.label <> ": " <> cs (show v))+        ("Version rejected for peer " <> p.label)       killPeer p dispatch mgr (PeerVerAck p) = do   atomically (setPeerVerAck mgr.peers p) >>= \case@@ -301,16 +301,16 @@ processPeerOffline :: (MonadLoggerIO m) => PeerMgr -> Child -> m () processPeerOffline mgr a = do   atomically (findPeerAsync mgr.peers a) >>= \case-    Nothing -> $(logWarnS) "PeerMgr" "Disconnected unknown peer"+    Nothing -> $(logErrorS) "PeerMgr" "Disconnected unknown peer"     Just o -> do       if o.online         then do-          $(logWarnS)+          $(logErrorS)             "PeerMgr"             ("Disconnected peer " <> o.mailbox.label)           managerEvent mgr (PeerDisconnected o.mailbox)         else-          $(logWarnS)+          $(logErrorS)             "PeerMgr"             ("Could not connect to peer " <> o.mailbox.label)       atomically (removePeer mgr.peers o.mailbox)