haskoin-node 0.9.4 → 0.9.5
raw patch · 4 files changed
+31/−17 lines, 4 files
Files
- CHANGELOG.md +4/−0
- haskoin-node.cabal +2/−2
- src/Network/Haskoin/Node/Manager.hs +24/−15
- test/Haskoin/NodeSpec.hs +1/−0
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.9.5+### Change+- Do not record new peers in database when peer discovery is disabled.+ ## 0.9.4 ### Change - Don't spam best block events.
haskoin-node.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 15e06b1e42eec51a6c352bcfede82426a0c116a31250e4f4c359a571045bfb43+-- hash: de83a76e2e9d853065c60347d1ed2c080fe552cf04ca51797f0e873974581ea0 name: haskoin-node-version: 0.9.4+version: 0.9.5 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/Network/Haskoin/Node/Manager.hs view
@@ -161,6 +161,7 @@ $(logErrorS) "Manager" $ "Version rejected for peer " <> s <> ": " <> cs (show x) killPeer x p+ managerMessage (ManagerPeerMessage p MVerAck) = do b <- asks onlinePeers s <- atomically $ peerString b p@@ -171,14 +172,18 @@ Nothing -> do $(logErrorS) "Manager" $ "Received verack from unknown peer: " <> s killPeer UnknownPeer p-managerMessage (ManagerPeerMessage p (MAddr (Addr nas))) = do- db <- getManagerDB- b <- asks onlinePeers- s <- atomically $ peerString b p- $(logInfoS) "Manager" $- "Received " <> cs (show (length nas)) <> " peers from " <> s- let sas = map (naAddress . snd) nas- forM_ sas $ newPeerDB db netPeerScore++managerMessage (ManagerPeerMessage p (MAddr (Addr nas))) =+ mgrConfDiscover <$> asks myConfig >>= \d ->+ when d $ do+ db <- getManagerDB+ b <- asks onlinePeers+ s <- atomically $ peerString b p+ $(logInfoS) "Manager" $+ "Received " <> cs (show (length nas)) <> " peers from " <> s+ let sas = map (naAddress . snd) nas+ forM_ sas $ newPeerDB db netPeerScore+ managerMessage (ManagerPeerMessage p msg@(MPong (Pong n))) = do now <- liftIO getCurrentTime b <- asks onlinePeers@@ -191,14 +196,15 @@ Just d -> do let ms = fromRational . toRational $ d * 1000 :: Double $(logDebugS) "Manager" $- "Ping " <> cs (show n) <> " to " <> s <> " took " <>- cs (show ms)+ "Ping roundtrip to " <> s <> ": " <> cs (show ms) <> " ms"+ managerMessage (ManagerPeerMessage p (MPing (Ping n))) = do b <- asks onlinePeers s <- atomically $ peerString b p $(logDebugS) "Manager" $ "Responding to ping " <> cs (show n) <> " from " <> s MPong (Pong n) `sendMessage` p+ managerMessage (ManagerPeerMessage p msg) = do b <- asks onlinePeers s <- atomically $ peerString b p@@ -206,7 +212,9 @@ $(logDebugS) "Manager" $ "Forwarding message " <> cs cmd <> " from peer " <> s forwardMessage p msg+ managerMessage (ManagerBestBlock h) = putBestBlock h+ managerMessage ManagerConnect = do l <- length <$> getConnectedPeers x <- mgrConfMaxPeers <$> asks myConfig@@ -214,15 +222,20 @@ getNewPeer >>= \case Nothing -> return () Just sa -> connectPeer sa+ managerMessage (ManagerPeerDied a e) = processPeerOffline a e+ managerMessage ManagerPurgePeers = do $(logWarnS) "Manager" "Purging connected peers and peer database" purgePeers+ managerMessage (ManagerGetPeers reply) = getConnectedPeers >>= atomically . reply+ managerMessage (ManagerGetOnlinePeer p reply) = do b <- asks onlinePeers atomically $ findPeer b p >>= reply+ managerMessage (ManagerCheckPeer p) = checkPeer p checkPeer :: MonadManager m => Peer -> m ()@@ -313,13 +326,9 @@ getNewPeer = do ManagerConfig {mgrConfDB = db} <- asks myConfig exclude <- map onlinePeerAddress <$> getOnlinePeers- m <-- runMaybeT $+ runMaybeT $ MaybeT (getNewPeerDB db exclude) <|> MaybeT (populatePeerDB >> getNewPeerDB db exclude)- case m of- Just a -> return $ Just a- Nothing -> return Nothing connectPeer :: (MonadUnliftIO m, MonadManager m) => SockAddr -> m () connectPeer sa = do
test/Haskoin/NodeSpec.hs view
@@ -122,6 +122,7 @@ w R.defaultOptions { R.createIfMissing = True+ , R.errorIfExists = True , R.compression = R.SnappyCompression } let cfg =