haskoin-node 0.9.8 → 0.9.9

raw patch · 5 files changed

+67/−16 lines, 5 files

Files

• CHANGELOG.md +4/−0
• haskoin-node.cabal +2/−2
• src/Network/Haskoin/Node/Chain.hs +41/−9
• src/Network/Haskoin/Node/Manager.hs +16/−4
• src/Network/Haskoin/Node/Peer.hs +4/−1

@@ -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.9+### Added+- Increase debugging information.+ ## 0.9.8 ### Changed - Increase version of haskoin-core to 0.9.0.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 65356f705bfa6d70c54e5ab415fc6dcee69d8acb4ab8948a67205d20102c9c82+-- hash: 0278071e411da1cacdc3c6fc2b5f0d0b228116f74a470344cb4551f878e05c8e  name:           haskoin-node-version:        0.9.8+version:        0.9.9 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

@@ -154,7 +154,8 @@     MGetHeaders gh `sendMessage` p  chainMessage :: MonadChain m => ChainMessage -> m ()-chainMessage (ChainGetBest reply) =+chainMessage (ChainGetBest reply) = do+    $(logDebugS) "Chain" "Responding to request for best block"     getBestBlockHeader >>= atomically . reply chainMessage (ChainHeaders p hs) = do     $(logDebugS) "Chain" $ "Processing " <> cs (show (length hs)) <> " headers"@@ -167,14 +168,45 @@     $(logWarnS) "Chain" $ "Removing a peer from sync queue: " <> cs (show a)     finishPeer p     syncNewPeer-chainMessage (ChainGetAncestor h n reply) =-    getAncestor h n >>= atomically . reply-chainMessage (ChainGetSplit r l reply) =-    splitPoint r l >>= atomically . reply-chainMessage (ChainGetBlock h reply) =-    getBlockHeader h >>= atomically . reply-chainMessage (ChainIsSynced reply) =-    isSynced >>= atomically . reply+chainMessage (ChainGetAncestor h n reply) = do+    $(logDebugS) "Chain" $+        "Responding to request for ancestor at height " <> cs (show h) <>+        " to block: " <>+        blockHashToHex (headerHash (nodeHeader n))+    a <- getAncestor h n+    atomically $ reply a+    case a of+        Just b ->+            $(logDebugS) "Chain" $+            "Ancestor is: " <> blockHashToHex (headerHash (nodeHeader b))+        Nothing -> $(logDebugS) "Chain" "Ancestor not found"+chainMessage (ChainGetSplit l r reply) = do+    $(logDebugS) "Chain" $+        "Responding to request for split point between blocks " <>+        blockHashToHex (headerHash (nodeHeader l)) <>+        " & " <>+        blockHashToHex (headerHash (nodeHeader r))+    s <- splitPoint l r+    atomically $ reply s+    $(logDebugS) "Chain" $+        "Split block is: " <> blockHashToHex (headerHash (nodeHeader s))+chainMessage (ChainGetBlock h reply) = do+    $(logDebugS) "Chain" $+        "Responding to request for block: " <> blockHashToHex h+    m <- getBlockHeader h+    atomically $ reply m+    case m of+        Nothing ->+            $(logDebugS) "Chain" $ "Block not found: " <> blockHashToHex h+        Just b ->+            $(logDebugS) "Chain" $+            "Block found at height " <> cs (show (nodeHeight b))+chainMessage (ChainIsSynced reply) = do+    s <- isSynced+    if s+        then $(logDebugS) "Chain" "Chain is in sync"+        else $(logDebugS) "Chain" "Chain is NOT in sync"+    atomically $ reply s chainMessage ChainPing = do     $(logDebugS) "Chain" "Housekeeping..."     ChainConfig {chainConfTimeout = to} <- asks myReader

@@ -271,7 +271,9 @@         "Forwarding message " <> cs cmd <> " from peer " <> s     forwardMessage p m -managerMessage (ManagerBestBlock h) = putBestBlock h+managerMessage (ManagerBestBlock h) = do+    $(logDebugS) "Manager" $ "Setting best block at height " <> cs (show h)+    putBestBlock h  managerMessage ManagerConnect = do     l <- length <$> getConnectedPeers@@ -289,12 +291,22 @@     $(logWarnS) "Manager" "Purging connected peers and peer database"     purgePeers -managerMessage (ManagerGetPeers reply) =-    getConnectedPeers >>= atomically . reply+managerMessage (ManagerGetPeers reply) = do+    $(logDebugS) "Manager" "Responding to request for connected peers"+    ps <- getConnectedPeers+    $(logDebugS) "Manager" $+        "There are " <> cs (show (length ps)) <> " connected peers"+    atomically $ reply ps  managerMessage (ManagerGetOnlinePeer p reply) = do+    $(logDebugS) "Manager" "Responding to request for particular peer"     b <- asks onlinePeers-    atomically $ findPeer b p >>= reply+    m <- atomically $ findPeer b p >>= \o -> reply o >> return o+    case m of+        Nothing -> $(logDebugS) "Manager" "Requested peer not found"+        Just o ->+            $(logDebugS) "Manager" $+            "Peer found at address: " <> cs (show (onlinePeerAddress o))  managerMessage (ManagerCheckPeer p) = checkPeer p 

@@ -67,7 +67,10 @@     $(logDebugS) (peerString (peerConfAddress cfg)) $         "Outgoing: " <> cs (commandToString (msgType msg))     yield msg-dispatchMessage cfg (GetPublisher reply) =+dispatchMessage cfg (GetPublisher reply) = do+    $(logDebugS)+        (peerString (peerConfAddress cfg))+        "Replying to publisher request"     atomically $ reply (peerConfListen cfg) dispatchMessage cfg (KillPeer e) = do     $(logErrorS) s $ "Killing peer via mailbox request: " <> cs (show e)