haskoin-node 0.9.2 → 0.9.3
raw patch · 4 files changed
+49/−69 lines, 4 files
Files
- CHANGELOG.md +6/−0
- haskoin-node.cabal +2/−2
- src/Network/Haskoin/Node/Chain.hs +39/−64
- src/Network/Haskoin/Node/Manager.hs +2/−3
CHANGELOG.md view
@@ -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). +## 0.9.3+### Change+- Correct display of milliseconds in log.+- Correct bug when receiving headers from unknown peer.+- Simplify chain syncing code.+ ## 0.9.2 ### Change - Peer dies immediately when receiving a bad message.
haskoin-node.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 3b8d3fcf4859baa5368744ff4c28930ed05d2a9865d2bd9d890b666fbceb84db+-- hash: 87835bb33cb3181042456c86fd4dd7aecf2dbef52909e2afbeec9a22289693a0 name: haskoin-node-version: 0.9.2+version: 0.9.3 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/Chain.hs view
@@ -25,23 +25,19 @@ import Control.Monad.Logger import Control.Monad.Reader import Control.Monad.Trans.Maybe-import Data.List-import Data.Maybe import Data.String.Conversions-import Data.Text (Text) import Data.Time.Clock.POSIX import Network.Haskoin.Block import Network.Haskoin.Network import Network.Haskoin.Node.Chain.Logic import Network.Haskoin.Node.Common-import Network.Socket (SockAddr) import NQE import System.Random import UnliftIO import UnliftIO.Concurrent type MonadChain m- = (MonadLoggerIO m, MonadChainLogic ChainConfig (Peer, SockAddr) m)+ = (MonadLoggerIO m, MonadChainLogic ChainConfig Peer m) -- | Launch process to synchronize block headers in current thread. chain ::@@ -84,34 +80,30 @@ processHeaders :: MonadChain m => Peer -> [BlockHeader] -> m ()-processHeaders p hs = void . runMaybeT $ do- a <- peerAddr p >>= \case- Just a -> return a- Nothing -> MaybeT $ return Nothing- let s = peerString (Just a)- net <- chainConfNetwork <$> asks myReader- $(logDebugS) "Chain" $- "Importing " <> cs (show (length hs)) <> " headers from peer " <> s- now <- round <$> liftIO getPOSIXTime- importHeaders net now hs >>= \case- Left e -> do- $(logErrorS) "Chain" $- "Could not connect headers sent by peer " <> s <> ": " <>- cs (show e)- e `killPeer` p- Right done -> do- setLastReceived now- best <- getBestBlockHeader- chainEvent $ ChainBestBlock best- if done- then do- $(logDebugS) "Chain" $- "Finished importing headers from peer: " <> s- MSendHeaders `sendMessage` p- finishPeer (p, a)- syncNewPeer- syncNotif- else syncPeer p a+processHeaders p hs =+ void . runMaybeT $ do+ net <- chainConfNetwork <$> asks myReader+ $(logDebugS) "Chain" $+ "Importing " <> cs (show (length hs)) <> " headers"+ now <- round <$> liftIO getPOSIXTime+ importHeaders net now hs >>= \case+ Left e -> do+ $(logErrorS) "Chain" "Could not connect received headers"+ e `killPeer` p+ Right done -> do+ setLastReceived now+ best <- getBestBlockHeader+ chainEvent $ ChainBestBlock best+ if done+ then do+ $(logDebugS)+ "Chain"+ "Finished importing headers from peer"+ MSendHeaders `sendMessage` p+ finishPeer p+ syncNewPeer+ syncNotif+ else syncPeer p syncNewPeer :: MonadChain m => m () syncNewPeer = do@@ -122,44 +114,38 @@ nextPeer >>= \case Nothing -> $(logInfoS) "Chain" "Finished syncing against all peers"- Just (p, a) -> syncPeer p a- Just (_, a) ->- $(logDebugS) "Chain" $- "Already syncing against peer " <> peerString (Just a)+ Just p -> syncPeer p+ Just _ -> $(logDebugS) "Chain" "Already syncing against a peer" syncNotif :: MonadChain m => m () syncNotif = round <$> liftIO getPOSIXTime >>= notifySynced >>= \x -> when x $ getBestBlockHeader >>= chainEvent . ChainSynced -syncPeer :: MonadChain m => Peer -> SockAddr -> m ()-syncPeer p a = do- $(logInfoS) "Chain" $ "Syncing against peer " <> peerString (Just a)+syncPeer :: MonadChain m => Peer -> m ()+syncPeer p = do+ $(logInfoS) "Chain" "Syncing against selected peer" bb <- chainSyncingPeer >>= \case- Just ChainSync {chainSyncPeer = (p', _), chainHighest = Just g}+ Just ChainSync {chainSyncPeer = p', chainHighest = Just g} | p == p' -> return g _ -> getBestBlockHeader now <- round <$> liftIO getPOSIXTime- gh <- syncHeaders now bb (p, a)+ gh <- syncHeaders now bb p MGetHeaders gh `sendMessage` p chainMessage :: MonadChain m => ChainMessage -> m () chainMessage (ChainGetBest reply) = getBestBlockHeader >>= atomically . reply chainMessage (ChainHeaders p hs) = do- s <- peerString <$> peerAddr p- $(logDebugS) "Chain" $- "Processing " <> cs (show (length hs)) <> " headers from peer " <> s+ $(logDebugS) "Chain" $ "Processing " <> cs (show (length hs)) <> " headers" processHeaders p hs chainMessage (ChainPeerConnected p a) = do- let s = peerString (Just a)- $(logDebugS) "Chain" $ "Adding new peer to sync queue: " <> s- addPeer (p, a)+ $(logDebugS) "Chain" $ "Adding new peer to sync queue: " <> cs (show a)+ addPeer p syncNewPeer chainMessage (ChainPeerDisconnected p a) = do- let s = peerString (Just a)- $(logWarnS) "Chain" $ "Removing a peer from sync queue: " <> s- finishPeer (p, a)+ $(logWarnS) "Chain" $ "Removing a peer from sync queue: " <> cs (show a)+ finishPeer p syncNewPeer chainMessage (ChainGetAncestor h n reply) = getAncestor h n >>= atomically . reply@@ -174,10 +160,9 @@ now <- round <$> liftIO getPOSIXTime chainSyncingPeer >>= \case Nothing -> return ()- Just ChainSync {chainSyncPeer = (p, a), chainTimestamp = t}+ Just ChainSync {chainSyncPeer = p, chainTimestamp = t} | now - t > fromIntegral to -> do- let s = peerString (Just a)- $(logErrorS) "Chain" $ "Syncing peer timed out: " <> s+ $(logErrorS) "Chain" "Syncing peer timed out" PeerTimeout `killPeer` p | otherwise -> return () @@ -189,13 +174,3 @@ threadDelay =<< liftIO (randomRIO (250 * 1000, 1000 * 1000)) ChainPing `send` ch--peerAddr :: MonadChain m => Peer -> m (Maybe SockAddr)-peerAddr p =- asks chainState >>= readTVarIO >>= \s ->- let ps = newPeers s <> maybeToList (chainSyncPeer <$> chainSyncing s)- in return $ snd <$> find ((== p) . fst) ps--peerString :: Maybe SockAddr -> Text-peerString Nothing = "[unknown]"-peerString (Just a) = cs $ show a
src/Network/Haskoin/Node/Manager.hs view
@@ -189,11 +189,10 @@ "Forwarding pong " <> cs (show n) <> " from " <> s forwardMessage p msg Just d -> do- let ms = d * 1000+ let ms = fromRational . toRational $ d * 1000 :: Double $(logDebugS) "Manager" $ "Ping " <> cs (show n) <> " to " <> s <> " took " <>- cs (show ms) <>- " milliseconds"+ cs (show ms) managerMessage (ManagerPeerMessage p (MPing (Ping n))) = do b <- asks onlinePeers s <- atomically $ peerString b p