haskoin-node 0.15.0 → 0.16.0
raw patch · 5 files changed
+87/−57 lines, 5 filesdep ~haskoin-coredep ~rocksdb-haskell-jpruppdep ~rocksdb-query
Dependency ranges changed: haskoin-core, rocksdb-haskell-jprupp, rocksdb-query
Files
- CHANGELOG.md +4/−0
- haskoin-node.cabal +8/−8
- src/Haskoin/Node.hs +14/−11
- src/Haskoin/Node/Chain.hs +54/−35
- test/Haskoin/NodeSpec.hs +7/−3
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.16.0+### Changed+- Add support for column families.+ ## 0.15.0 ### Changed - Use new Haskell bindings for RocksDB.
haskoin-node.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 8910b7a1cab081e2bc9808f152235026188f3dccc612d569cfa102a5fe7fa709+-- hash: b80c691ed899f492d1f0f3165f9f4a78f85253ba1a6bd61a3b4705075572ccae name: haskoin-node-version: 0.15.0+version: 0.16.0 synopsis: P2P library for Bitcoin and Bitcoin Cash description: Please see the README on GitHub at <https://github.com/haskoin/haskoin-node#readme> category: Bitcoin, Finance, Network@@ -45,15 +45,15 @@ , containers , data-default , hashable- , haskoin-core >=0.14.1+ , haskoin-core >=0.15.0 , monad-logger , mtl , network , nqe >=0.6.3 , random , resourcet- , rocksdb-haskell-jprupp- , rocksdb-query >=0.3.1+ , rocksdb-haskell-jprupp >=2.1.2+ , rocksdb-query >=0.4.2 , string-conversions , text , time@@ -81,7 +81,7 @@ , containers , data-default , hashable- , haskoin-core >=0.14.1+ , haskoin-core >=0.15.0 , haskoin-node , hspec , monad-logger@@ -90,8 +90,8 @@ , nqe >=0.6.3 , random , resourcet- , rocksdb-haskell-jprupp- , rocksdb-query >=0.3.1+ , rocksdb-haskell-jprupp >=2.1.2+ , rocksdb-query >=0.4.2 , safe , string-conversions , text
src/Haskoin/Node.hs view
@@ -19,7 +19,7 @@ runTCPClient) import Data.String.Conversions (cs) import Data.Time.Clock (NominalDiffTime)-import Database.RocksDB (DB)+import Database.RocksDB (ColumnFamily, DB) import Haskoin (Addr (..), BlockNode (..), Headers (..), Message (..), Network, NetworkAddress, Ping (..), Pong (..))@@ -36,25 +36,27 @@ -- | General node configuration. data NodeConfig = NodeConfig- { nodeConfMaxPeers :: !Int+ { nodeConfMaxPeers :: !Int -- ^ maximum number of connected peers allowed- , nodeConfDB :: !DB+ , nodeConfDB :: !DB -- ^ database handler- , nodeConfPeers :: ![HostPort]+ , nodeConfColumnFamily :: !(Maybe ColumnFamily)+ -- ^ database column family+ , nodeConfPeers :: ![HostPort] -- ^ static list of peers to connect to- , nodeConfDiscover :: !Bool+ , nodeConfDiscover :: !Bool -- ^ activate peer discovery- , nodeConfNetAddr :: !NetworkAddress+ , nodeConfNetAddr :: !NetworkAddress -- ^ network address for the local host- , nodeConfNet :: !Network+ , nodeConfNet :: !Network -- ^ network constants- , nodeConfEvents :: !(Publisher NodeEvent)+ , nodeConfEvents :: !(Publisher NodeEvent) -- ^ node events are sent to this publisher- , nodeConfTimeout :: !NominalDiffTime+ , nodeConfTimeout :: !NominalDiffTime -- ^ timeout in seconds- , nodeConfPeerMaxLife :: !NominalDiffTime+ , nodeConfPeerMaxLife :: !NominalDiffTime -- ^ peer disconnect after seconds- , nodeConfConnect :: !(SockAddr -> WithConnection)+ , nodeConfConnect :: !(SockAddr -> WithConnection) } data Node = Node { nodeManager :: !PeerManager@@ -166,6 +168,7 @@ chain_config ch_pub = ChainConfig { chainConfDB = nodeConfDB cfg+ , chainConfColumnFamily = nodeConfColumnFamily cfg , chainConfNetwork = nodeConfNet cfg , chainConfEvents = ch_pub , chainConfTimeout = nodeConfTimeout cfg
src/Haskoin/Node/Chain.hs view
@@ -29,7 +29,7 @@ import Control.Monad.Except (runExceptT, throwError) import Control.Monad.Logger (MonadLoggerIO, logDebugS, logErrorS, logInfoS)-import Control.Monad.Reader (MonadReader, ReaderT, ask, asks,+import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT) import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)@@ -45,10 +45,11 @@ import Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds) import Data.Word (Word32)-import Database.RocksDB (DB)+import Database.RocksDB (ColumnFamily, DB) import qualified Database.RocksDB as R-import Database.RocksDB.Query (Key, KeyValue, insert, insertOp,- retrieve, writeBatch)+import Database.RocksDB.Query (Key, KeyValue, insert, insertCF,+ insertOp, insertOpCF,+ retrieveCommon, writeBatch) import Haskoin (BlockHash, BlockHeader (..), BlockHeaders (..), BlockHeight, BlockNode (..), GetHeaders (..),@@ -77,13 +78,15 @@ -- | Configuration for chain syncing process. data ChainConfig = ChainConfig- { chainConfDB :: !DB+ { chainConfDB :: !DB -- ^ database handle- , chainConfNetwork :: !Network+ , chainConfColumnFamily :: !(Maybe ColumnFamily)+ -- ^ column family+ , chainConfNetwork :: !Network -- ^ network constants- , chainConfEvents :: !(Publisher ChainEvent)+ , chainConfEvents :: !(Publisher ChainEvent) -- ^ send header chain events here- , chainConfTimeout :: !NominalDiffTime+ , chainConfTimeout :: !NominalDiffTime -- ^ timeout in seconds } @@ -166,35 +169,43 @@ return BestBlockKey put BestBlockKey = putWord8 0x91 -instance (Monad m, MonadIO m, MonadReader DB m) =>+instance (Monad m, MonadIO m, MonadReader ChainConfig m) => BlockHeaders m where addBlockHeader bn = do- db <- ask- insert db (BlockHeaderKey h) bn+ db <- asks chainConfDB+ asks chainConfColumnFamily >>= \case+ Nothing -> insert db (BlockHeaderKey h) bn+ Just cf -> insertCF db cf (BlockHeaderKey h) bn where h = headerHash (nodeHeader bn) getBlockHeader bh = do- db <- ask- retrieve db (BlockHeaderKey bh)+ db <- asks chainConfDB+ mcf <- asks chainConfColumnFamily+ retrieveCommon db mcf (BlockHeaderKey bh) getBestBlockHeader = do- db <- ask- retrieve db BestBlockKey >>= \case+ db <- asks chainConfDB+ mcf <- asks chainConfColumnFamily+ retrieveCommon db mcf BestBlockKey >>= \case Nothing -> error "Could not get best block from database" Just b -> return b setBestBlockHeader bn = do- db <- ask- insert db BestBlockKey bn+ db <- asks chainConfDB+ asks chainConfColumnFamily >>= \case+ Nothing -> insert db BestBlockKey bn+ Just cf -> insertCF db cf BestBlockKey bn addBlockHeaders bns = do- db <- ask- writeBatch db (map f bns)+ db <- asks chainConfDB+ mcf <- asks chainConfColumnFamily+ writeBatch db (map (f mcf) bns) where h bn = headerHash (nodeHeader bn)- f bn = insertOp (BlockHeaderKey (h bn)) bn+ f Nothing bn = insertOp (BlockHeaderKey (h bn)) bn+ f (Just cf) bn = insertOpCF cf (BlockHeaderKey (h bn)) bn -withBlockHeaders :: MonadChain m => ReaderT DB m a -> m a+withBlockHeaders :: MonadChain m => ReaderT ChainConfig m a -> m a withBlockHeaders f = do- db <- asks (chainConfDB . myConfig)- runReaderT f db+ cfg <- asks myConfig+ runReaderT f cfg -- | Launch process to synchronize block headers in current thread. withChain ::@@ -365,11 +376,14 @@ initChainDB :: MonadChain m => m () initChainDB = do db <- asks (chainConfDB . myConfig)+ mcf <- asks (chainConfColumnFamily . myConfig) net <- asks (chainConfNetwork . myConfig)- ver <- retrieve db ChainDataVersionKey+ ver <- retrieveCommon db mcf ChainDataVersionKey when (ver /= Just dataVersion) $ purgeChainDB >>= writeBatch db- insert db ChainDataVersionKey dataVersion- retrieve db BestBlockKey >>= \b ->+ case mcf of+ Nothing -> insert db ChainDataVersionKey dataVersion+ Just cf -> insertCF db cf ChainDataVersionKey dataVersion+ retrieveCommon db mcf BestBlockKey >>= \b -> when (isNothing (b :: Maybe BlockNode)) $ withBlockHeaders $ do addBlockHeader (genesisNode net)@@ -380,17 +394,22 @@ purgeChainDB :: MonadChain m => m [R.BatchOp] purgeChainDB = do db <- asks (chainConfDB . myConfig)- R.withIter db $ \it -> do+ mcf <- asks (chainConfColumnFamily . myConfig)+ f db mcf $ \it -> do R.iterSeek it $ B.singleton 0x90- recurse_delete it db+ recurse_delete it db mcf where- recurse_delete it db =+ f db Nothing = R.withIter db+ f db (Just cf) = R.withIterCF db cf+ recurse_delete it db mcf = R.iterKey it >>= \case Just k | B.head k == 0x90 || B.head k == 0x91 -> do- R.delete db k+ case mcf of+ Nothing -> R.delete db k+ Just cf -> R.deleteCF db cf k R.iterNext it- (R.Del k :) <$> recurse_delete it db+ (R.Del k :) <$> recurse_delete it db mcf _ -> return [] -- | Import a bunch of continuous headers. Returns 'True' if the number of@@ -576,12 +595,12 @@ chainGetBlock :: MonadIO m => BlockHash -> Chain -> m (Maybe BlockNode) chainGetBlock bh ch =- runReaderT (getBlockHeader bh) (chainConfDB (myConfig (chainReader ch)))+ runReaderT (getBlockHeader bh) (myConfig (chainReader ch)) -- | Get best block header from chain process. chainGetBest :: MonadIO m => Chain -> m BlockNode chainGetBest ch =- runReaderT getBestBlockHeader (chainConfDB (myConfig (chainReader ch)))+ runReaderT getBestBlockHeader (myConfig (chainReader ch)) -- | Get ancestor of 'BlockNode' at 'BlockHeight' from chain process. chainGetAncestor :: MonadIO m@@ -590,7 +609,7 @@ -> Chain -> m (Maybe BlockNode) chainGetAncestor h bn ch =- runReaderT (getAncestor h bn) (chainConfDB (myConfig (chainReader ch)))+ runReaderT (getAncestor h bn) (myConfig (chainReader ch)) -- | Get parents of 'BlockNode' starting at 'BlockHeight' from chain process. chainGetParents :: MonadIO m@@ -616,7 +635,7 @@ -> Chain -> m BlockNode chainGetSplitBlock l r ch =- runReaderT (splitPoint l r) (chainConfDB (myConfig (chainReader ch)))+ runReaderT (splitPoint l r) (myConfig (chainReader ch)) -- | Notify chain that a new peer is connected. chainPeerConnected :: MonadIO m
test/Haskoin/NodeSpec.hs view
@@ -184,16 +184,17 @@ runNoLoggingT $ withSystemTempDirectory ("haskoin-node-test-" <> str <> "-") $ \w -> withPublisher $ \pub ->- R.withDB w def{R.createIfMissing = True, R.errorIfExists = True} $ \db -> do+ R.withDBCF w cfg cols $ \db -> do let ad = NetworkAddress nodeNetwork (sockToHostAddress (SockAddrInet 0 0)) na = NetworkAddress 0 (sockToHostAddress (SockAddrInet 0 0))- cfg = NodeConfig+ cfg' = NodeConfig { nodeConfMaxPeers = 20 , nodeConfDB = db+ , nodeConfColumnFamily = Just (head (R.columnFamilies db)) , nodeConfPeers = [("127.0.0.1", 17486)] , nodeConfDiscover = False , nodeConfNetAddr = na@@ -203,13 +204,16 @@ , nodeConfPeerMaxLife = 48 * 3600 , nodeConfConnect = dummyPeerConnect net ad }- withNode cfg $ \(Node mgr ch) ->+ withNode cfg' $ \(Node mgr ch) -> withSubscription pub $ \sub -> lift $ f TestNode { testMgr = mgr , testChain = ch , nodeEvents = sub }+ where+ cfg = def{R.createIfMissing = True, R.errorIfExists = True}+ cols = [("node", def)] allBlocks :: [Block] allBlocks =