haskoin-node 0.10.1 → 0.11.0

raw patch · 6 files changed

+50/−28 lines, 6 files

Files

• CHANGELOG.md +4/−0
• haskoin-node.cabal +2/−2
• src/Haskoin/Node.hs +2/−1
• src/Haskoin/Node/Common.hs +16/−9
• src/Haskoin/Node/Manager.hs +21/−12
• test/Haskoin/NodeSpec.hs +5/−4

@@ -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.0+### Changed+- Set peer too old time+ ## 0.10.1 ### Changed - Disconnect old peers after 48 hours instead of 30 minutes.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: bb0aedb8f50d4a112826da8a55f006880d92273524df56e40c563a57be6747dd+-- hash: 6dc1d4286dbcecd8021a84acc3975eb1852dc959b3dd668ce220c44b57cbbf05  name:           haskoin-node-version:        0.10.1+version:        0.11.0 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

@@ -99,7 +99,7 @@     -> m () node cfg mgr_inbox ch_inbox = do     let mgr_config =-            ManagerConfig+            PeerManagerConfig                 { peerManagerMaxPeers = nodeConfMaxPeers cfg                 , peerManagerPeers = nodeConfPeers cfg                 , peerManagerDiscover = nodeConfDiscover cfg@@ -107,6 +107,7 @@                 , peerManagerNetwork = nodeConfNet cfg                 , peerManagerEvents = mgr_events                 , peerManagerTimeout = nodeConfTimeout cfg+                , peerManagerTooOld = nodeConfPeerOld cfg                 }     withAsync (peerManager mgr_config mgr_inbox) $ \mgr_async -> do         link mgr_async

@@ -79,6 +79,8 @@       -- ^ random nonce sent during handshake     , onlinePeerPing        :: !(Maybe (UTCTime, Word64))       -- ^ last sent ping time and nonce+    , onlinePeerLastMessage :: !Word64+      -- ^ last message received by peer     , onlinePeerPings       :: ![NominalDiffTime]       -- ^ last few ping rountrip duration     , onlinePeerConnectTime :: !Word64@@ -122,25 +124,30 @@       -- ^ node events are sent to this publisher     , nodeConfTimeout  :: !Int       -- ^ timeout in seconds+    , nodeConfPeerOld  :: !Int+      -- ^ peer disconnect after seconds     }  -- | Peer manager configuration.-data PeerManagerConfig = ManagerConfig-    { peerManagerMaxPeers :: !Int+data PeerManagerConfig =+    PeerManagerConfig+        { peerManagerMaxPeers :: !Int       -- ^ maximum number of peers to connect to-    , peerManagerPeers    :: ![HostPort]+        , peerManagerPeers    :: ![HostPort]       -- ^ static list of peers to connect to-    , peerManagerDiscover :: !Bool+        , peerManagerDiscover :: !Bool       -- ^ activate peer discovery-    , peerManagerNetAddr  :: !NetworkAddress+        , peerManagerNetAddr  :: !NetworkAddress       -- ^ network address for the local host-    , peerManagerNetwork  :: !Network+        , peerManagerNetwork  :: !Network       -- ^ network constants-    , peerManagerEvents   :: !(Listen PeerEvent)+        , peerManagerEvents   :: !(Listen PeerEvent)       -- ^ send manager and peer messages to this mailbox-    , peerManagerTimeout  :: !Int+        , peerManagerTimeout  :: !Int       -- ^ timeout in seconds-    }+        , peerManagerTooOld   :: !Int+      -- ^ disconnect peers after connected for so long+        }  -- | Messages that can be sent to the peer manager. data PeerManagerMessage

@@ -114,6 +114,12 @@         withConnectLoop mgr $             forever $ do                 m <- receive inbox+                case m of+                    PeerManagerPeerMessage p _ -> do+                        now <- round <$> liftIO getPOSIXTime+                        o <- asks onlinePeers+                        atomically $ setLastMessage o now p+                    _ -> return ()                 managerMessage m     f (a, mex) = PeerManagerPeerDied a mex `sendSTM` mgr @@ -235,7 +241,8 @@  checkPeer :: MonadManager m => Peer -> m () checkPeer p = do-    ManagerConfig {peerManagerTimeout = to} <- asks myConfig+    PeerManagerConfig {peerManagerTimeout = to, peerManagerTooOld = old} <-+        asks myConfig     b <- asks onlinePeers     s <- atomically $ peerString b p     atomically (findPeer b p) >>= \case@@ -243,13 +250,13 @@         Just o -> do             now <- round <$> liftIO getPOSIXTime             when-                (onlinePeerConnectTime o < now - 48 * 3600)+                (onlinePeerConnectTime o < now - fromIntegral old)                 (killPeer PeerTooOld p)-    atomically (lastPing b p) >>= \case+    atomically (lastMessage b p) >>= \case         Nothing -> pingPeer p         Just t -> do-            now <- liftIO getCurrentTime-            when (diffUTCTime now t > fromIntegral to) $ do+            now <- round <$> liftIO getPOSIXTime+            when (now - t > fromIntegral to) $ do                 $(logErrorS) "Manager" $                     "Peer " <> s <> " did not respond ping on time"                 killPeer PeerTimeout p@@ -337,8 +344,9 @@             "Attempted to connect to peer twice: " <> cs (show sa)         Nothing -> do             $(logInfoS) "Manager" $ "Connecting to " <> cs (show sa)-            ManagerConfig {peerManagerNetAddr = ad, peerManagerNetwork = net} <--                asks myConfig+            PeerManagerConfig { peerManagerNetAddr = ad+                              , peerManagerNetwork = net+                              } <- asks myConfig             mgr <- asks myMailbox             sup <- asks mySupervisor             nonce <- liftIO randomIO@@ -430,12 +438,12 @@                     }         return diff +setLastMessage :: TVar [OnlinePeer] -> Word64 -> Peer -> STM ()+setLastMessage b t p = modifyPeer b p $ \o -> o {onlinePeerLastMessage = t}+ -- | Return time of last ping sent to peer, if any.-lastPing :: TVar [OnlinePeer] -> Peer -> STM (Maybe UTCTime)-lastPing b p =-    findPeer b p >>= \case-        Just OnlinePeer {onlinePeerPing = Just (time, _)} -> return (Just time)-        _ -> return Nothing+lastMessage :: TVar [OnlinePeer] -> Peer -> STM (Maybe Word64)+lastMessage b p = fmap onlinePeerLastMessage <$> findPeer b p  -- | Set nonce and time of last ping sent to peer. setPeerPing :: TVar [OnlinePeer] -> Word64 -> UTCTime -> Peer -> STM ()@@ -506,6 +514,7 @@                 , onlinePeerPings = []                 , onlinePeerPing = Nothing                 , onlinePeerConnectTime = t+                , onlinePeerLastMessage = t                 }     insertPeer b op     return op

@@ -18,9 +18,9 @@                                        btcTest, buildMerkleRoot,                                        getGenesisHeader, headerHash,                                        sockToHostAddress, txHash)-import           Haskoin.Node         (Chain, ChainEvent (..), PeerManager,-                                       NodeConfig (..), NodeEvent (..),-                                       OnlinePeer (..), Peer, PeerEvent (..),+import           Haskoin.Node         (Chain, ChainEvent (..), NodeConfig (..),+                                       NodeEvent (..), OnlinePeer (..), Peer,+                                       PeerEvent (..), PeerManager,                                        chainGetAncestor, chainGetBest,                                        chainGetParents, managerGetPeer,                                        peerGetBlocks, peerGetTxs, withNode)@@ -149,7 +149,8 @@                     , nodeConfNetAddr = NetworkAddress 0 (sockToHostAddress (SockAddrInet 0 0))                     , nodeConfNet = net                     , nodeConfEvents = (`sendSTM` node_inbox)-                    , nodeConfTimeout = 10+                    , nodeConfTimeout = 120+                    , nodeConfPeerOld = 48 * 3600                     }         withNode cfg $ \(mgr, ch) ->             lift $