haskoin-node 0.9.13 → 0.9.14
raw patch · 5 files changed
+7/−146 lines, 5 files
Files
- CHANGELOG.md +4/−0
- haskoin-node.cabal +2/−3
- src/Haskoin/Node.hs +0/−1
- src/Network/Haskoin/Node/Common.hs +0/−6
- src/Network/Haskoin/Node/Manager.hs +1/−136
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.14+### Removed+- No longer support storing peers in db as performance tradeoff doesn't justify it.+ ## 0.9.13 ### Changed - Really store peers in db.
haskoin-node.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: f8a2a4b86df35455f4862711720d20e083528be4a92e36c46a19ebb8d5501952+-- hash: f6f4cc1aa459333150ae2851ff4d584f487003e3ab00e26860d2a37cd896e044 name: haskoin-node-version: 0.9.13+version: 0.9.14 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@@ -37,7 +37,6 @@ Paths_haskoin_node hs-source-dirs: src- ghc-options: -O2 build-depends: base >=4.9 && <5 , bytestring
src/Haskoin/Node.hs view
@@ -83,7 +83,6 @@ let mgr_config = ManagerConfig { mgrConfMaxPeers = nodeConfMaxPeers cfg- , mgrConfDB = nodeConfDB cfg , mgrConfPeers = nodeConfPeers cfg , mgrConfDiscover = nodeConfDiscover cfg , mgrConfNetAddr = nodeConfNetAddr cfg
src/Network/Haskoin/Node/Common.hs view
@@ -109,8 +109,6 @@ data ManagerConfig = ManagerConfig { mgrConfMaxPeers :: !Int -- ^ maximum number of peers to connect to- , mgrConfDB :: !DB- -- ^ database handler to store peer information , mgrConfPeers :: ![HostPort] -- ^ static list of peers to connect to , mgrConfDiscover :: !Bool@@ -133,8 +131,6 @@ -- ^ get all connected peers | ManagerGetOnlinePeer !Peer !(Listen (Maybe OnlinePeer)) -- ^ get a peer information- | ManagerPurgePeers- -- ^ delete all known peers | ManagerCheckPeer !Peer -- ^ check this peer | ManagerPeerMessage !Peer !Message@@ -234,8 +230,6 @@ -- ^ peer has no segwit support | PeerTimeout -- ^ request to peer timed out- | PurgingPeer- -- ^ peers are being purged | UnknownPeer -- ^ peer is unknown deriving (Eq, Show)
src/Network/Haskoin/Node/Manager.hs view
@@ -40,9 +40,6 @@ import Data.Time.Clock import Data.Time.Clock.POSIX import Data.Word-import Database.RocksDB (DB)-import qualified Database.RocksDB as R-import Database.RocksDB.Query as R import Haskoin import Network.Haskoin.Node.Common import Network.Haskoin.Node.Peer@@ -92,9 +89,7 @@ mgr = inboxToMailbox inbox discover = mgrConfDiscover cfg go = do- db <- getManagerDB $(logDebugS) "Manager" "Initializing..."- initPeerDB db discover putBestBlock <=< receiveMatch inbox $ \case ManagerBestBlock b -> Just b _ -> Nothing@@ -125,7 +120,7 @@ then do loadStaticPeers d <- mgrConfDiscover <$> asks myConfig- when d $ loadPeersFromDB >> loadNetSeeds+ when d loadNetSeeds else $(logDebugS) "Manager" "Peers already available, not initialising" loadStaticPeers :: (MonadUnliftIO m, MonadManager m) => m ()@@ -134,30 +129,6 @@ xs <- mgrConfPeers <$> asks myConfig mapM_ newPeer =<< concat <$> mapM toSockAddr xs -loadPeersFromDB :: (MonadUnliftIO m, MonadManager m) => m ()-loadPeersFromDB = do- $(logDebugS) "Manager" "Loading peers from database"- db <- getManagerDB- xs <- matchingAsList db R.defaultReadOptions PeerAddressBase- let f (PeerAddress x, ()) = x- f _ = undefined- ys = map f xs- $(logInfoS) "Manager" $- "Loaded " <> cs (show (length ys)) <> " peers from database"- mapM_ newPeer ys--storePeersInDB :: (MonadUnliftIO m, MonadManager m) => m ()-storePeersInDB = do- db <- getManagerDB- os <- readTVarIO =<< asks onlinePeers- ks <- readTVarIO =<< asks knownPeers- let ps = map onlinePeerAddress os <> Set.toList ks- xs = map ((`insertOp` ()) . PeerAddress) ps- unless (null xs) $ do- $(logInfoS) "Manager" $- "Storing " <> cs (show (length xs)) <> " peers in database"- writeBatch db =<< (++ xs) <$> purgePeerDB db- loadNetSeeds :: (MonadUnliftIO m, MonadManager m) => m () loadNetSeeds = do net <- getNetwork@@ -173,22 +144,12 @@ $(logInfoS) "Manager" $ "Peers connected: " <> cs (show l) <> "/" <> cs (show m) -getManagerDB :: MonadManager m => m DB-getManagerDB = mgrConfDB <$> asks myConfig- getOnlinePeers :: MonadManager m => m [OnlinePeer] getOnlinePeers = asks onlinePeers >>= readTVarIO getConnectedPeers :: MonadManager m => m [OnlinePeer] getConnectedPeers = filter onlinePeerConnected <$> getOnlinePeers -purgePeers :: (MonadUnliftIO m, MonadManager m) => m ()-purgePeers = do- db <- getManagerDB- ops <- getOnlinePeers- forM_ ops $ \OnlinePeer {onlinePeerMailbox = p} -> killPeer PurgingPeer p- writeBatch db =<< purgePeerDB db- forwardMessage :: MonadManager m => Peer -> Message -> m () forwardMessage p = managerEvent . PeerMessage p @@ -236,7 +197,6 @@ True -> do let sas = map (naAddress . snd) nas forM_ sas newPeer- storePeersInDB False -> $(logDebugS) "Manager"@@ -287,10 +247,6 @@ managerMessage (ManagerPeerDied a e) = processPeerOffline a e -managerMessage ManagerPurgePeers = do- $(logWarnS) "Manager" "Purging connected peers and peer database"- purgePeers- managerMessage (ManagerGetPeers reply) = do $(logDebugS) "Manager" "Responding to request for connected peers" ps <- getConnectedPeers@@ -482,40 +438,6 @@ versionPeerDB :: Word32 versionPeerDB = 5 --- | Peer address key in database.-data PeerAddress- = PeerAddress {- getPeerAddress :: !SockAddr- -- ^ peer network address and port- }- | PeerAddressBase- deriving (Eq, Ord, Show)---- | Database version key.-data PeerDataVersionKey = PeerDataVersionKey- deriving (Eq, Ord, Show)--instance Serialize PeerDataVersionKey where- get = do- guard . (== 0x82) =<< S.getWord8- return PeerDataVersionKey- put PeerDataVersionKey = S.putWord8 0x82--instance R.Key PeerDataVersionKey-instance KeyValue PeerDataVersionKey Word32--instance Serialize PeerAddress where- get = do- guard . (== 0x81) =<< S.getWord8- PeerAddress <$> decodeSockAddr- put PeerAddress {getPeerAddress = a} = do- S.putWord8 0x81- encodeSockAddr a- put PeerAddressBase = S.putWord8 0x81--instance R.Key PeerAddress-instance KeyValue PeerAddress ()- -- | Add a peer. newPeer :: (MonadIO m, MonadManager m) => SockAddr -> m () newPeer sa = do@@ -524,66 +446,9 @@ i <- atomically $ findPeerAddress o sa when (isNothing i) $ atomically . modifyTVar b $ Set.insert sa --- | Initialize peer database, purging it of conflicting records if version--- doesn't match current one, or if peer discovery is disabled.-initPeerDB :: MonadUnliftIO m => DB -> Bool -> m ()-initPeerDB db discover = do- ver <- retrieve db def PeerDataVersionKey- when (ver /= Just versionPeerDB || not discover) $- writeBatch db =<< purgePeerDB db- R.insert db PeerDataVersionKey versionPeerDB---- | Purge peer records from database.-purgePeerDB :: MonadUnliftIO m => DB -> m [R.BatchOp]-purgePeerDB db = (++) <$> purge_byte 0x81 <*> purge_byte 0x83- where- purge_byte byte =- U.runResourceT . R.withIterator db def $ \it -> do- R.iterSeek it $ B.singleton byte- recurse_delete it byte- recurse_delete it byte =- R.iterKey it >>= \case- Just k- | B.head k == byte -> do- R.iterNext it- (R.Del k :) <$> recurse_delete it byte- _ -> return []- -- | Get static network seeds. networkSeeds :: Network -> [HostPort] networkSeeds net = map (, getDefaultPort net) (getSeeds net)---- | Serialize a network address/port.-encodeSockAddr :: SockAddr -> Put-encodeSockAddr (SockAddrInet6 p _ (a, b, c, d) _) = do- S.putWord32be a- S.putWord32be b- S.putWord32be c- S.putWord32be d- S.putWord16be (fromIntegral p)-encodeSockAddr (SockAddrInet p a) = do- S.putWord32be 0x00000000- S.putWord32be 0x00000000- S.putWord32be 0x0000ffff- S.putWord32host a- S.putWord16be (fromIntegral p)-encodeSockAddr x = error $ "Could not encode address: " <> show x---- | Deserialize a network address/port.-decodeSockAddr :: Get SockAddr-decodeSockAddr = do- a <- S.getWord32be- b <- S.getWord32be- c <- S.getWord32be- if a == 0x00000000 && b == 0x00000000 && c == 0x0000ffff- then do- d <- S.getWord32host- p <- S.getWord16be- return $ SockAddrInet (fromIntegral p) d- else do- d <- S.getWord32be- p <- S.getWord16be- return $ SockAddrInet6 (fromIntegral p) 0 (a, b, c, d) 0 -- | Report receiving a pong from a connected peer. Will store ping roundtrip -- time in a window of latest eleven. Peers are returned by the manager in order