haskoin-node 0.9.17 → 0.9.18
raw patch · 4 files changed
+35/−32 lines, 4 files
Files
- CHANGELOG.md +4/−0
- haskoin-node.cabal +2/−2
- src/Network/Haskoin/Node/Common.hs +1/−1
- src/Network/Haskoin/Node/Manager.hs +28/−29
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.18+### Added+- More aggressive peer discovery.+ ## 0.9.17 ### Added - Peers are disconnected automatically after awhile.
haskoin-node.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8669769b56f62758da5356e662ad42d29c33cc14cc5463ffcd0b81166f56777f+-- hash: c482469edd83b9fc0df9149423d5cd86941fd9fad71987399c485a1da222deb6 name: haskoin-node-version: 0.9.17+version: 0.9.18 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/Common.hs view
@@ -276,7 +276,7 @@ | KillPeer !PeerException | SendMessage !Message --- | Resolve a host and port to a list of 'SockAddr'. May make use DNS resolver.+-- | Resolve a host and port to a list of 'SockAddr'. May do DNS lookups. toSockAddr :: MonadUnliftIO m => HostPort -> m [SockAddr] toSockAddr (host, port) = go `catch` e where
src/Network/Haskoin/Node/Manager.hs view
@@ -132,36 +132,35 @@ getBestBlock = asks myBestBlock >>= readTVarIO getNetwork :: MonadManager m => m Network-getNetwork = mgrConfNetwork <$> asks myConfig+getNetwork = asks (mgrConfNetwork . myConfig) loadPeers :: (MonadUnliftIO m, MonadManager m) => m () loadPeers = do- os <- readTVarIO =<< asks onlinePeers- ks <- readTVarIO =<< asks knownPeers- if null os && Set.null ks- then do- loadStaticPeers- d <- mgrConfDiscover <$> asks myConfig- when d loadNetSeeds- else $(logDebugS) "Manager" "Peers already available, not initialising"+ loadStaticPeers+ loadNetSeeds loadStaticPeers :: (MonadUnliftIO m, MonadManager m) => m () loadStaticPeers = do $(logDebugS) "Manager" "Loading static peers"- xs <- mgrConfPeers <$> asks myConfig+ xs <- asks (mgrConfPeers . myConfig) mapM_ newPeer =<< concat <$> mapM toSockAddr xs loadNetSeeds :: (MonadUnliftIO m, MonadManager m) => m ()-loadNetSeeds = do- net <- getNetwork- $(logDebugS) "Manager" "Loading network seeds"- ss <- concat <$> mapM toSockAddr (networkSeeds net)- $(logDebugS) "Manager" $ "Adding " <> cs (show (length ss)) <> " seed peers"- mapM_ newPeer ss+loadNetSeeds =+ asks (mgrConfDiscover . myConfig) >>= \discover ->+ if discover+ then do+ net <- getNetwork+ $(logDebugS) "Manager" "Loading network seeds"+ ss <- concat <$> mapM toSockAddr (networkSeeds net)+ $(logDebugS) "Manager" $+ "Adding " <> cs (show (length ss)) <> " seed peers"+ mapM_ newPeer ss+ else $(logDebugS) "Manager" "Peer discovery disabled" logConnectedPeers :: MonadManager m => m () logConnectedPeers = do- m <- mgrConfMaxPeers <$> asks myConfig+ m <- asks (mgrConfMaxPeers . myConfig) l <- length <$> getConnectedPeers $(logInfoS) "Manager" $ "Peers connected: " <> cs (show l) <> "/" <> cs (show m)@@ -176,7 +175,7 @@ forwardMessage p = managerEvent . PeerMessage p managerEvent :: MonadManager m => PeerEvent -> m ()-managerEvent e = mgrConfEvents <$> asks myConfig >>= \l -> atomically $ l e+managerEvent e = asks (mgrConfEvents . myConfig) >>= \l -> atomically $ l e managerMessage :: (MonadUnliftIO m, MonadManager m) => ManagerMessage -> m () managerMessage (ManagerPeerMessage p (MVersion v)) = do@@ -215,14 +214,14 @@ let n = length nas $(logDebugS) "Manager" $ "Received " <> cs (show n) <> " addresses from peer " <> s- mgrConfDiscover <$> asks myConfig >>= \case- True -> do- let sas = map (hostToSockAddr . naAddress . snd) nas- forM_ sas newPeer- False ->- $(logDebugS)- "Manager"- "Ignoring received peers (discovery disabled)"+ asks (mgrConfDiscover . myConfig) >>= \discover ->+ if discover+ then do+ let sas = map (hostToSockAddr . naAddress . snd) nas+ forM_ sas newPeer+ else $(logDebugS)+ "Manager"+ "Ignoring new peers since peer discovery disabled" managerMessage (ManagerPeerMessage p m@(MPong (Pong n))) = do now <- liftIO getCurrentTime@@ -259,13 +258,13 @@ managerMessage ManagerConnect = do l <- length <$> getConnectedPeers- x <- mgrConfMaxPeers <$> asks myConfig+ x <- asks (mgrConfMaxPeers . myConfig) if l < x then getNewPeer >>= \case Nothing ->- $(logDebugS) "Manager" "No peers available to connect"+ $(logDebugS) "Manager" "No other peers available to connect" Just sa -> connectPeer sa- else $(logDebugS) "Manager" "Enough peers connected."+ else $(logDebugS) "Manager" "Enough peers connected" managerMessage (ManagerPeerDied a e) = processPeerOffline a e