haskoin-store 0.18.4 → 0.18.5
raw patch · 8 files changed
+80/−47 lines, 8 filesdep ~haskoin-core
Dependency ranges changed: haskoin-core
Files
- CHANGELOG.md +8/−0
- haskoin-store.cabal +5/−5
- src/Network/Haskoin/Store/Block.hs +2/−0
- src/Network/Haskoin/Store/Data.hs +1/−1
- src/Network/Haskoin/Store/Data/ImportDB.hs +4/−4
- src/Network/Haskoin/Store/Data/Memory.hs +4/−6
- src/Network/Haskoin/Store/Logic.hs +2/−1
- src/Network/Haskoin/Store/Web.hs +54/−30
CHANGELOG.md view
@@ -4,6 +4,14 @@ 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.18.5+### Added+- Compatibility with SegWit on extended public key endpoints.++### Changed+- Fix syncing peer not reset after timeout.+- Use simpler monad for streaming data.+ ## 0.18.4 ### Changed - Bump Haskoin Node to fix peers not stored and excessively verbose logging.
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 147705cd3c7e602c2cb04e9aa8a4423c39019f464ef5bbdb97f7cb34f5c30205+-- hash: 4d53e327a8c580ccce1a66b1432e4aa13042697403d4dd56a2fb99137d2e2213 name: haskoin-store-version: 0.18.4+version: 0.18.5 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Store blocks, transactions, and balances for Bitcoin or Bitcoin Cash, and make that information via REST API. category: Bitcoin, Finance, Network@@ -54,7 +54,7 @@ , containers , data-default , hashable- , haskoin-core+ , haskoin-core >=0.9.5 , haskoin-node , http-types , monad-logger@@ -94,7 +94,7 @@ , data-default , filepath , hashable- , haskoin-core+ , haskoin-core >=0.9.5 , haskoin-node , haskoin-store , http-types@@ -138,7 +138,7 @@ , containers , data-default , hashable- , haskoin-core+ , haskoin-core >=0.9.5 , haskoin-node , haskoin-store , hspec
src/Network/Haskoin/Store/Block.hs view
@@ -308,7 +308,9 @@ if n > t + 60 then do $(logErrorS) "Block" "Peer timeout"+ resetPeer killPeer PeerTimeout p+ syncMe else $(logDebugS) "Block" "Peer timeout not reached" processDisconnect ::
src/Network/Haskoin/Store/Data.hs view
@@ -83,7 +83,7 @@ setInit :: m () setBest :: BlockHash -> m () insertBlock :: BlockData -> m ()- insertAtHeight :: BlockHash -> BlockHeight -> m ()+ setBlocksAtHeight :: [BlockHash] -> BlockHeight -> m () insertTx :: TxData -> m () insertSpender :: OutPoint -> Spender -> m () deleteSpender :: OutPoint -> m ()
src/Network/Haskoin/Store/Data/ImportDB.hs view
@@ -192,9 +192,9 @@ insertBlockI b ImportDB {importHashMap = hm} = withBlockMem hm $ insertBlock b -insertAtHeightI :: MonadIO m => BlockHash -> BlockHeight -> ImportDB -> m ()-insertAtHeightI b h ImportDB {importHashMap = hm} =- withBlockMem hm $ insertAtHeight b h+setBlocksAtHeightI :: MonadIO m => [BlockHash] -> BlockHeight -> ImportDB -> m ()+setBlocksAtHeightI hs g ImportDB {importHashMap = hm} =+ withBlockMem hm $ setBlocksAtHeight hs g insertTxI :: MonadIO m => TxData -> ImportDB -> m () insertTxI t ImportDB {importHashMap = hm} =@@ -347,7 +347,7 @@ setInit = R.ask >>= setInitI setBest h = R.ask >>= setBestI h insertBlock b = R.ask >>= insertBlockI b- insertAtHeight b h = R.ask >>= insertAtHeightI b h+ setBlocksAtHeight hs g = R.ask >>= setBlocksAtHeightI hs g insertTx t = R.ask >>= insertTxI t insertSpender p s = R.ask >>= insertSpenderI p s deleteSpender p = R.ask >>= deleteSpenderI p
src/Network/Haskoin/Store/Data/Memory.hs view
@@ -160,10 +160,8 @@ insertBlockH bd db = db {hBlock = M.insert (headerHash (blockDataHeader bd)) bd (hBlock db)} -insertAtHeightH :: BlockHash -> BlockHeight -> BlockMem -> BlockMem-insertAtHeightH h g db = db {hHeight = M.insertWith f g [h] (hHeight db)}- where- f xs ys = nub $ xs <> ys+setBlocksAtHeightH :: [BlockHash] -> BlockHeight -> BlockMem -> BlockMem+setBlocksAtHeightH hs g db = db {hHeight = M.insert g hs (hHeight db)} insertTxH :: TxData -> BlockMem -> BlockMem insertTxH tx db = db {hTx = M.insert (txHash (txData tx)) tx (hTx db)}@@ -348,9 +346,9 @@ insertBlock b = do v <- R.ask atomically $ modifyTVar v (insertBlockH b)- insertAtHeight h g = do+ setBlocksAtHeight h g = do v <- R.ask- atomically $ modifyTVar v (insertAtHeightH h g)+ atomically $ modifyTVar v (setBlocksAtHeightH h g) insertTx t = do v <- R.ask atomically $ modifyTVar v (insertTxH t)
src/Network/Haskoin/Store/Logic.hs view
@@ -268,7 +268,8 @@ , blockDataFees = cb_out_val - subsidy (nodeHeight n) , blockDataOutputs = ts_out_val }- insertAtHeight (headerHash (nodeHeader n)) (nodeHeight n)+ bs <- getBlocksAtHeight (nodeHeight n)+ setBlocksAtHeight (nub (headerHash (nodeHeader n) : bs)) (nodeHeight n) setBest (headerHash (nodeHeader n)) $(logDebugS) "Block" "Importing or confirming block transactions..." mapM_ (uncurry (import_or_confirm mp)) (sortTxs (blockTxns b))
src/Network/Haskoin/Store/Web.hs view
@@ -64,6 +64,8 @@ type WebT m = ActionT Except (ReaderT LayeredDB m) +type DeriveAddrs = XPubKey -> KeyIndex -> [(Address, PubKey, KeyIndex)]+ type Offset = Word32 type Limit = Word32 @@ -240,9 +242,9 @@ n <- parseNoTx proto <- setupBin hs <- getBlocksAtHeight height- runner <- lift askRunInIO+ db <- askDB stream $ \io flush' -> do- runner . runConduit $+ runStream db . runConduit $ yieldMany hs .| concatMapMC getBlock .| mapC (pruneTx n) .| streamAny net proto io flush'@@ -254,9 +256,9 @@ n <- parseNoTx proto <- setupBin bs <- concat <$> mapM getBlocksAtHeight (nub heights)- runner <- lift askRunInIO+ db <- askDB stream $ \io flush' -> do- runner . runConduit $+ runStream db . runConduit $ yieldMany (nub heights) .| concatMapMC getBlocksAtHeight .| concatMapMC getBlock .| mapC (pruneTx n) .|@@ -268,11 +270,11 @@ cors n <- parseNoTx proto <- setupBin- runner <- lift askRunInIO+ db <- askDB getBestBlock >>= \case Just h -> stream $ \io flush' -> do- runner . runConduit $ f n h 100 .| streamAny net proto io+ runStream db . runConduit $ f n h 100 .| streamAny net proto io flush' Nothing -> raise ThingNotFound where@@ -293,9 +295,9 @@ blocks <- param "blocks" n <- parseNoTx proto <- setupBin- runner <- lift askRunInIO+ db <- askDB stream $ \io flush' -> do- runner . runConduit $+ runStream db . runConduit $ yieldMany (nub blocks) .| concatMapMC getBlock .| mapC (pruneTx n) .| streamAny net proto io flush'@@ -340,9 +342,9 @@ cors txids <- param "txids" proto <- setupBin- runner <- lift askRunInIO+ db <- askDB stream $ \io flush' -> do- runner . runConduit $+ runStream db . runConduit $ yieldMany (nub txids) .| concatMapMC getTransaction .| streamAny net proto io flush'@@ -353,11 +355,11 @@ cors h <- param "block" proto <- setupBin- runner <- lift askRunInIO+ db <- askDB getBlock h >>= \case Just b -> stream $ \io flush' -> do- runner . runConduit $+ runStream db . runConduit $ yieldMany (blockDataTxs b) .| concatMapMC getTransaction .| streamAny net proto io flush'@@ -369,9 +371,9 @@ cors txids <- param "txids" proto <- setupBin- runner <- lift askRunInIO+ db <- askDB stream $ \io flush' -> do- runner . runConduit $+ runStream db . runConduit $ yieldMany (nub txids) .| concatMapMC getTransaction .| mapC transactionData .| streamAny net proto io@@ -383,11 +385,11 @@ cors h <- param "block" proto <- setupBin- runner <- lift askRunInIO+ db <- askDB getBlock h >>= \case Just b -> stream $ \io flush' -> do- runner . runConduit $+ runStream db . runConduit $ yieldMany (blockDataTxs b) .| concatMapMC getTransaction .| mapC transactionData .| streamAny net proto io@@ -502,23 +504,27 @@ , balanceTotalReceived = 0 } f _ (Just b) = b- runner <- lift askRunInIO+ db <- askDB stream $ \io flush' -> do- runner . runConduit $+ runStream db . runConduit $ yieldMany as .| mapMC (\a -> f a <$> getBalance a) .| streamAny net proto io flush' scottyXpubBalances ::- (MonadUnliftIO m, MonadLoggerIO m) => Network -> MaxLimits -> WebT m ()+ (MonadUnliftIO m, MonadLoggerIO m)+ => Network+ -> MaxLimits+ -> WebT m () scottyXpubBalances net max_limits = do cors xpub <- parseXpub net proto <- setupBin+ derive <- parseDeriveAddrs net db <- askDB stream $ \io flush' -> do runStream db . runConduit $- xpubBals max_limits xpub .| streamAny net proto io+ xpubBals max_limits derive xpub .| streamAny net proto io flush' scottyXpubTxs ::@@ -532,11 +538,12 @@ x <- parseXpub net s <- getStart l <- getLimit limits full+ derive <- parseDeriveAddrs net proto <- setupBin db <- askDB as <- liftIO . runStream db . runConduit $- xpubBals limits x .| mapC (balanceAddress . xPubBal) .| sinkList+ xpubBals limits derive x .| mapC (balanceAddress . xPubBal) .| sinkList stream $ \io flush' -> do runStream db . runConduit $ f proto l s as io flush'@@ -553,10 +560,11 @@ proto <- setupBin s <- getStart l <- getLimit limits False+ derive <- parseDeriveAddrs net db <- askDB stream $ \io flush' -> do runStream db . runConduit $- xpubUnspentLimit net limits l s x .| streamAny net proto io+ xpubUnspentLimit net limits l s derive x .| streamAny net proto io flush' scottyXpubSummary ::@@ -564,9 +572,10 @@ scottyXpubSummary net max_limits = do cors x <- parseXpub net+ derive <- parseDeriveAddrs net proto <- setupBin db <- askDB- res <- liftIO . runStream db $ xpubSummary max_limits x+ res <- liftIO . runStream db $ xpubSummary max_limits derive x protoSerial net proto res scottyPostTx ::@@ -786,6 +795,16 @@ Nothing -> next Just x -> return x +parseDeriveAddrs :: (Monad m, ScottyError e) => Network -> ActionT e m DeriveAddrs+parseDeriveAddrs net+ | getSegWit net = do+ t <- param "derive" `rescue` const (return "standard")+ return $ case (t :: Text) of+ "segwit" -> deriveWitnessAddrs+ "compat" -> deriveCompatWitnessAddrs+ _ -> deriveAddrs+ | otherwise = return deriveAddrs+ parseNoTx :: (Monad m, ScottyError e) => ActionT e m Bool parseNoTx = param "notx" `rescue` const (return False) @@ -900,9 +919,10 @@ xpubBals :: (MonadResource m, MonadUnliftIO m, StoreRead m) => MaxLimits+ -> DeriveAddrs -> XPubKey -> ConduitT i XPubBal m ()-xpubBals limits xpub = go 0 >> go 1+xpubBals limits derive xpub = go 0 >> go 1 where go m = yieldMany (addrs m) .| mapMC (uncurry bal) .| gap (maxLimitGap limits)@@ -911,7 +931,7 @@ Nothing -> return Nothing Just b' -> return $ Just XPubBal {xPubBalPath = p, xPubBal = b'} addrs m =- map (\(a, _, n') -> (a, [m, n'])) (deriveAddrs (pubSubKey xpub m) 0)+ map (\(a, _, n') -> (a, [m, n'])) (derive (pubSubKey xpub m) 0) gap n = let r 0 = return () r i =@@ -930,9 +950,11 @@ => Network -> MaxLimits -> Maybe BlockRef+ -> DeriveAddrs -> XPubKey -> ConduitT i XPubUnspent m ()-xpubUnspent net max_limits start xpub = xpubBals max_limits xpub .| go+xpubUnspent net max_limits start derive xpub =+ xpubBals max_limits derive xpub .| go where go = awaitForever $ \XPubBal {xPubBalPath = p, xPubBal = b} ->@@ -949,18 +971,20 @@ -> MaxLimits -> Maybe Limit -> Maybe BlockRef+ -> DeriveAddrs -> XPubKey -> ConduitT i XPubUnspent m ()-xpubUnspentLimit net max_limits limit start xpub =- xpubUnspent net max_limits start xpub .| applyLimit limit+xpubUnspentLimit net max_limits limit start derive xpub =+ xpubUnspent net max_limits start derive xpub .| applyLimit limit xpubSummary :: (MonadResource m, MonadUnliftIO m, StoreStream m, StoreRead m) => MaxLimits+ -> DeriveAddrs -> XPubKey -> m XPubSummary-xpubSummary max_limits x = do- bs <- runConduit $ xpubBals max_limits x .| sinkList+xpubSummary max_limits derive x = do+ bs <- runConduit $ xpubBals max_limits derive x .| sinkList let f XPubBal {xPubBalPath = p, xPubBal = Balance {balanceAddress = a}} = (a, p) pm = H.fromList $ map f bs