haskoin-node 0.11.0 → 0.11.1
raw patch · 4 files changed
+34/−22 lines, 4 files
Files
- CHANGELOG.md +4/−0
- haskoin-node.cabal +2/−2
- src/Haskoin/Node/Chain.hs +4/−1
- src/Haskoin/Node/Manager.hs +24/−19
CHANGELOG.md view
@@ -4,6 +4,10 @@ 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). +## 0.11.1+### Changed+- Improve logging.+ ## 0.11.0 ### Changed - Set peer too old time
haskoin-node.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 6dc1d4286dbcecd8021a84acc3975eb1852dc959b3dd668ce220c44b57cbbf05+-- hash: eab6c845bac88d53afa9cd3e263936a78d0bc0f75e47e7ccbb593b58371626f3 name: haskoin-node-version: 0.11.0+version: 0.11.1 synopsis: Haskoin Node P2P library for Bitcoin and Bitcoin Cash description: Bitcoin and Bitcoin Cash peer-to-peer protocol library featuring headers-first synchronisation. category: Bitcoin, Finance, Network
src/Haskoin/Node/Chain.hs view
@@ -192,7 +192,10 @@ | now - t > fromIntegral to -> do mgr <- asks (chainConfManager . myReader) p' <- managerPeerText p mgr- $(logErrorS) "Chain" $ "Syncing peer timed out: " <> p'+ $(logErrorS) "Chain" $+ "Syncing peer timed out after " <> cs (show (now - t)) <>+ " seconds: " <>+ p' PeerTimeout `killPeer` p | otherwise -> return ()
src/Haskoin/Node/Manager.hs view
@@ -154,7 +154,7 @@ logConnectedPeers = do m <- asks (peerManagerMaxPeers . myConfig) l <- length <$> getConnectedPeers- $(logInfoS) "Manager" $+ $(logInfoS) "PeerManager" $ "Peers connected: " <> cs (show l) <> "/" <> cs (show m) getOnlinePeers :: MonadManager m => m [OnlinePeer]@@ -181,7 +181,7 @@ Right () -> do MVerAck `sendMessage` p Left x -> do- $(logErrorS) "Manager" $+ $(logErrorS) "PeerManager" $ "Version rejected for peer " <> s <> ": " <> cs (show x) killPeer x p @@ -191,7 +191,7 @@ atomically (setPeerVerAck b p) >>= \case Just o -> when (onlinePeerConnected o) $ announcePeer p Nothing -> do- $(logErrorS) "Manager" $ "Received verack from unknown peer: " <> s+ $(logErrorS) "PeerManager" $ "Received verack from unknown peer: " <> s killPeer UnknownPeer p managerMessage (PeerManagerPeerMessage p (MAddr (Addr nas))) =@@ -200,10 +200,15 @@ let sas = map (hostToSockAddr . naAddress . snd) nas b <- asks onlinePeers s <- atomically $ peerString b p- $(logInfoS) "Manager" $- "Received " <> cs (show (length sas)) <> " new peers from peer " <>- s- forM_ sas newPeer+ forM_ (zip [(1 :: Int) ..] sas) $ \(i, a) -> do+ $(logDebugS) "PeerManager" $+ "Received peer address " <> cs (show i) <> "/" <>+ cs (show (length sas)) <>+ ": " <>+ cs (show a) <>+ " from peer " <>+ s+ newPeer a managerMessage (PeerManagerPeerMessage p m@(MPong (Pong n))) = do now <- liftIO getCurrentTime@@ -257,7 +262,7 @@ Just t -> do now <- round <$> liftIO getPOSIXTime when (now - t > fromIntegral to) $ do- $(logErrorS) "Manager" $+ $(logErrorS) "PeerManager" $ "Peer " <> s <> " did not respond ping on time" killPeer PeerTimeout p @@ -265,7 +270,7 @@ pingPeer p = do b <- asks onlinePeers atomically (findPeer b p) >>= \case- Nothing -> $(logDebugS) "Manager" $ "Will not ping unknown peer"+ Nothing -> $(logDebugS) "PeerManager" $ "Will not ping unknown peer" Just o | onlinePeerConnected o -> do n <- liftIO randomIO@@ -291,17 +296,17 @@ atomically $ removePeer b p logConnectedPeers where- log_unknown Nothing = $(logErrorS) "Manager" "Disconnected unknown peer"+ log_unknown Nothing = $(logErrorS) "PeerManager" "Disconnected unknown peer" log_unknown (Just x) =- $(logErrorS) "Manager" $ "Unknown peer died: " <> cs (show x)+ $(logErrorS) "PeerManager" $ "Unknown peer died: " <> cs (show x) log_disconnected s Nothing =- $(logWarnS) "Manager" $ "Disconnected peer: " <> s+ $(logWarnS) "PeerManager" $ "Disconnected peer: " <> s log_disconnected s (Just x) =- $(logErrorS) "Manager" $ "Peer " <> s <> " died: " <> cs (show x)+ $(logErrorS) "PeerManager" $ "Peer " <> s <> " died: " <> cs (show x) log_not_connect s Nothing =- $(logWarnS) "Manager" $ "Could not connect to peer " <> s+ $(logWarnS) "PeerManager" $ "Could not connect to peer " <> s log_not_connect s (Just x) =- $(logErrorS) "Manager" $+ $(logErrorS) "PeerManager" $ "Could not connect to peer " <> s <> ": " <> cs (show x) announcePeer :: MonadManager m => Peer -> m ()@@ -311,12 +316,12 @@ mgr <- asks myMailbox atomically (findPeer b p) >>= \case Just OnlinePeer {onlinePeerAddress = a, onlinePeerConnected = True} -> do- $(logInfoS) "Manager" $ "Handshake completed for peer " <> s+ $(logInfoS) "PeerManager" $ "Connected to peer " <> s managerEvent $ PeerConnected p a logConnectedPeers managerCheck p mgr Just OnlinePeer {onlinePeerConnected = False} -> return ()- Nothing -> $(logErrorS) "Manager" "Will not announce unknown peer"+ Nothing -> $(logErrorS) "PeerManager" "Not announcing disconnected peer" getNewPeer :: (MonadUnliftIO m, MonadManager m) => m (Maybe SockAddr) getNewPeer = runMaybeT $ lift loadPeers >> go@@ -340,10 +345,10 @@ os <- asks onlinePeers atomically (findPeerAddress os sa) >>= \case Just _ ->- $(logErrorS) "Manager" $+ $(logErrorS) "PeerManager" $ "Attempted to connect to peer twice: " <> cs (show sa) Nothing -> do- $(logInfoS) "Manager" $ "Connecting to " <> cs (show sa)+ $(logInfoS) "PeerManager" $ "Connecting to " <> cs (show sa) PeerManagerConfig { peerManagerNetAddr = ad , peerManagerNetwork = net } <- asks myConfig