haskoin-node 0.8.0 → 0.8.1
raw patch · 6 files changed
+40/−46 lines, 6 files
Files
- CHANGELOG.md +5/−0
- haskoin-node.cabal +2/−2
- src/Network/Haskoin/Node/Chain.hs +9/−7
- src/Network/Haskoin/Node/Chain/Logic.hs +21/−30
- src/Network/Haskoin/Node/Common.hs +1/−6
- src/Network/Haskoin/Node/Manager.hs +2/−1
CHANGELOG.md view
@@ -4,6 +4,11 @@ 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.8.1+### Changed+- Corrected documentation for `killPeer` function.+- Leave time out of logic code.+ ## 0.8.0 ### Changed - Peers are now killed directly instead of through peer manager.
haskoin-node.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d879776c79752d2d022596929d75ee07b56399d5897bb97d530ca7c01b73016e+-- hash: fd286cff325b89ae33fca22561638234dcb7be4013930df6672c4eeb90282950 name: haskoin-node-version: 0.8.0+version: 0.8.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/Network/Haskoin/Node/Chain.hs view
@@ -29,7 +29,7 @@ import Data.Maybe import Data.String.Conversions import Data.Text (Text)-import Data.Time.Clock+import Data.Time.Clock.POSIX import Network.Haskoin.Block import Network.Haskoin.Network import Network.Haskoin.Node.Chain.Logic@@ -92,14 +92,15 @@ net <- chainConfNetwork <$> asks myReader $(logDebugS) "Chain" $ "Importing " <> cs (show (length hs)) <> " headers from peer " <> s- importHeaders net hs >>= \case+ 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+ setLastReceived now best <- getBestBlockHeader chainEvent $ ChainBestBlock best if done@@ -128,14 +129,15 @@ syncNotif :: MonadChain m => m () syncNotif =- notifySynced >>= \x ->+ 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) bb <- getBestBlockHeader- gh <- syncHeaders bb (p, a)+ now <- round <$> liftIO getPOSIXTime+ gh <- syncHeaders now bb (p, a) MGetHeaders gh `sendMessage` p chainMessage :: MonadChain m => ChainMessage -> m ()@@ -166,11 +168,11 @@ isSynced >>= atomically . reply chainMessage ChainPing = do ChainConfig {chainConfTimeout = to} <- asks myReader- now <- liftIO getCurrentTime+ now <- round <$> liftIO getPOSIXTime lastMessage >>= \case Nothing -> return () Just ((p, a), t)- | diffUTCTime now t > fromIntegral to -> do+ | now - t > fromIntegral to -> do let s = peerString (Just a) $(logErrorS) "Chain" $ "Syncing peer timed out: " <> s PeerTimeout `killPeer` p
src/Network/Haskoin/Node/Chain/Logic.hs view
@@ -29,8 +29,6 @@ import Data.List import Data.Maybe import Data.Serialize as S-import Data.Time.Clock-import Data.Time.Clock.POSIX import Data.Word import Database.RocksDB (DB) import qualified Database.RocksDB as R@@ -59,7 +57,7 @@ -- | Mutable state for the header chain process. data ChainState p = ChainState- { syncingPeer :: !(Maybe (p, UTCTime))+ { syncingPeer :: !(Maybe (p, Timestamp)) -- ^ peer to sync against and time of last received message , newPeers :: ![p] -- ^ queue of peers to sync against@@ -164,18 +162,17 @@ importHeaders :: (MonadIO m, BlockHeaders m) => Network+ -> Timestamp -> [BlockHeader] -> m (Either PeerException Bool)-importHeaders net hs =- runExceptT $ do- now <- fromIntegral <$> computeTime- lift (connectBlocks net now hs) >>= \case- Right _ ->- case length hs of- 2000 -> return False- _ -> return True- Left _ ->- throwError PeerSentBadHeaders+importHeaders net now hs =+ runExceptT $+ lift (connectBlocks net now hs) >>= \case+ Right _ ->+ case length hs of+ 2000 -> return False+ _ -> return True+ Left _ -> throwError PeerSentBadHeaders -- | Check if best block header is in sync with the rest of the block chain by -- comparing the best block with the current time, verifying that there are no@@ -184,16 +181,12 @@ -- whether to notify other processes that the header chain has been synced. The -- state of the chain will be flipped to synced when this function returns -- 'True'.-notifySynced :: (MonadIO m, MonadChainLogic a p m) => m Bool-notifySynced =+notifySynced :: (MonadIO m, MonadChainLogic a p m) => Timestamp -> m Bool+notifySynced now = fmap isJust $ runMaybeT $ do bb <- getBestBlockHeader- now <- liftIO getCurrentTime- let bt =- posixSecondsToUTCTime . realToFrac . blockTimestamp $- nodeHeader bb- guard (diffUTCTime now bt < 2 * 60 * 60)+ guard (now - blockTimestamp (nodeHeader bb) < 2 * 60 * 60) st <- asks chainState MaybeT . atomically . runMaybeT $ do s <- lift $ readTVar st@@ -211,12 +204,12 @@ -- locator to send to that peer for syncing. syncHeaders :: (Eq p, MonadChainLogic a p m, MonadIO m)- => BlockNode+ => Timestamp+ -> BlockNode -> p -> m GetHeaders-syncHeaders bb p = do+syncHeaders now bb p = do st <- asks chainState- now <- liftIO getCurrentTime atomically . modifyTVar st $ \s -> s {syncingPeer = Just (p, now), newPeers = delete p (newPeers s)} loc <- blockLocator bb@@ -229,10 +222,9 @@ } -- | Set the time of last received data to now if a syncing peer is active.-setLastReceived :: (MonadChainLogic a p m, MonadIO m) => m ()-setLastReceived = do+setLastReceived :: (MonadChainLogic a p m, MonadIO m) => Timestamp -> m ()+setLastReceived now = do st <- asks chainState- now <- liftIO getCurrentTime atomically . modifyTVar st $ \s -> s {syncingPeer = second (const now) <$> syncingPeer s} @@ -247,9 +239,8 @@ getSyncingPeer = fmap fst . syncingPeer <$> (readTVarIO =<< asks chainState) -- | Set syncing peer to the pone provided.-setSyncingPeer :: (MonadChainLogic a p m, MonadIO m) => p -> m ()-setSyncingPeer p = do- now <- liftIO getCurrentTime+setSyncingPeer :: (MonadChainLogic a p m, MonadIO m) => Timestamp -> p -> m ()+setSyncingPeer now p = asks chainState >>= \v -> atomically . modifyTVar v $ \s -> s {syncingPeer = Just (p, now)} @@ -280,5 +271,5 @@ } -- | Return the syncing peer and time of last communication received, if any.-lastMessage :: (MonadChainLogic a p m, MonadIO m) => m (Maybe (p, UTCTime))+lastMessage :: (MonadChainLogic a p m, MonadIO m) => m (Maybe (p, Timestamp)) lastMessage = syncingPeer <$> (readTVarIO =<< asks chainState)
src/Network/Haskoin/Node/Common.hs view
@@ -23,7 +23,6 @@ import Data.Maybe import Data.String.Conversions import Data.Time.Clock-import Data.Time.Clock.POSIX import Data.Word import Database.RocksDB (DB) import Network.Haskoin.Block@@ -292,10 +291,6 @@ e :: Monad m => SomeException -> m (Maybe a) e _ = return Nothing --- | Integer current time in seconds from 1970-01-01T00:00Z.-computeTime :: MonadIO m => m Word64-computeTime = round <$> liftIO getPOSIXTime- -- | Our protocol version. myVersion :: Word32 myVersion = 70012@@ -313,7 +308,7 @@ managerGetPeer :: MonadIO m => Peer -> Manager -> m (Maybe OnlinePeer) managerGetPeer p mgr = ManagerGetOnlinePeer p `query` mgr --- | Ask manager to kill a peer with the provided exception.+-- | Kill a peer with the provided exception. killPeer :: MonadIO m => PeerException -> Peer -> m () killPeer e p = KillPeer e `send` p
src/Network/Haskoin/Node/Manager.hs view
@@ -29,6 +29,7 @@ import Control.Monad.Trans.Maybe import Data.String.Conversions import Data.Time.Clock+import Data.Time.Clock.POSIX import Database.RocksDB (DB) import Network.Haskoin.Block import Network.Haskoin.Constants@@ -329,7 +330,7 @@ sup <- asks mySupervisor nonce <- liftIO randomIO bb <- getBestBlock- now <- computeTime+ now <- round <$> liftIO getPOSIXTime let rmt = NetworkAddress (srv net) sa ver = buildVersion net nonce bb ad rmt now (inbox, p) <- newMailbox