haskoin-store 0.4.0 → 0.4.1
raw patch · 7 files changed
+237/−81 lines, 7 files
Files
- CHANGELOG.md +5/−0
- README.md +1/−10
- app/Main.hs +34/−24
- haskoin-store.cabal +2/−2
- src/Haskoin/Store.hs +104/−0
- src/Network/Haskoin/Store/Data.hs +74/−8
- src/Network/Haskoin/Store/Logic.hs +17/−37
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.4.1+### Changed+- Fix bug when deleting coinbase transactions.+- Extended public key API support.+ ## 0.4.0 ### Changed - Generate events for mempool transactions.
README.md view
@@ -2,6 +2,7 @@ Full blockchain index & store featuring: +- Bitcoin Cash & Bitcoin SegWit support. - Address index. - Mempool. - Persistent storage using RocksDB.@@ -24,13 +25,3 @@ ## API Documentation * [Swagger API Documentation](https://btc.haskoin.com/).---## Addresses & Balances--For every address Haskoin Store has a balance object that contains basic statistics about the address. These statistics are described below.--* `confirmed` balance is that which is in the blockchain. Will always be positive or zero.-* `unconfirmed` balance represent aggregate changes done by mempool transactions. Can be negative if the transactions currently in the mempool are expected to reduce the balance when all of them make it into the blockchain.-* `outputs` is the count of outputs that send funds to this address. It is just a count and not a monetary value.-* `utxo` is the count of outputs that send funds to this address that remain unspent, taking the mempool into account: if spent in the mempool it will *not* count as unspent.
app/Main.hs view
@@ -16,7 +16,6 @@ import Data.ByteString.Builder import qualified Data.ByteString.Lazy.Char8 as C import Data.Char-import Data.Foldable import Data.Function import Data.List import Data.Maybe@@ -366,6 +365,35 @@ let d = (db, defaultReadOptions {useSnapshot = Just s}) mapM (getBalance d) addresses S.json $ map (balanceToJSON net) res+ S.get "/xpub/:xpub/balances" $ do+ xpub <- parse_xpub+ res <-+ withSnapshot db $ \s -> do+ let d = (db, defaultReadOptions {useSnapshot = Just s})+ runResourceT $ xpubBals d xpub+ S.json $ map (xPubBalToJSON net) res+ S.get "/xpub/:xpub/transactions" $ do+ xpub <- parse_xpub+ setHeader "Content-Type" "application/json"+ stream $ \io flush' ->+ withSnapshot db $ \s ->+ runResourceT . runConduit $+ xpubTxs (db, defaultReadOptions {useSnapshot = Just s}) xpub .|+ jsonListConduit (xPubTxToEncoding net) .|+ streamConduit io >>+ liftIO flush'+ S.get "/xpub/:xpub/unspent" $ do+ xpub <- parse_xpub+ setHeader "Content-Type" "application/json"+ stream $ \io flush' ->+ withSnapshot db $ \s ->+ runResourceT . runConduit $+ xpubUnspent+ (db, defaultReadOptions {useSnapshot = Just s})+ xpub .|+ jsonListConduit (xPubUnspentToEncoding net) .|+ streamConduit io >>+ liftIO flush' S.post "/transactions" $ do hex_tx <- C.filter (not . isSpace) <$> body bin_tx <-@@ -413,33 +441,15 @@ let as = mapMaybe (stringToAddr net) addresses unless (length as == length addresses) next return as+ parse_xpub = do+ t <- param "xpub"+ case xPubImport net t of+ Nothing -> next+ Just x -> return x net = configNetwork conf runner f l = do u <- askUnliftIO unliftIO u (runLoggingT l f)---- Snatched from:--- https://github.com/cblp/conduit-merge/blob/master/src/Data/Conduit/Merge.hs-mergeSourcesBy ::- (Foldable f, Monad m)- => (a -> a -> Ordering)- -> f (ConduitT () a m ())- -> ConduitT i a m ()-mergeSourcesBy f = mergeSealed . fmap sealConduitT . toList- where- mergeSealed sources = do- prefetchedSources <- lift $ traverse ($$++ await) sources- go [(a, s) | (s, Just a) <- prefetchedSources]- go [] = pure ()- go sources = do- let (a, src1):sources1 = sortBy (f `on` fst) sources- yield a- (src2, mb) <- lift $ src1 $$++ await- let sources2 =- case mb of- Nothing -> sources1- Just b -> (b, src2) : sources1- go sources2 jsonListConduit :: Monad m => (a -> Encoding) -> ConduitT a Builder m () jsonListConduit f =
haskoin-store.cabal view
@@ -2,10 +2,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 074c9fad62ed21c9c8caa339b60a8922c460e86895ca2968a25f38a8a9275421+-- hash: b407eb4e2b80720f1736beab7f8217e106b9cea576b4f209b23e33648e0600aa name: haskoin-store-version: 0.4.0+version: 0.4.1 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
src/Haskoin/Store.hs view
@@ -16,6 +16,9 @@ , BlockRef(..) , Unspent(..) , AddressTx(..)+ , XPubTx(..)+ , XPubBal(..)+ , XPubUnspent(..) , Balance(..) , PeerInformation(..) , withStore@@ -29,6 +32,9 @@ , getAddressUnspents , getAddressTxs , getPeersInformation+ , xpubTxs+ , xpubBals+ , xpubUnspent , publishTx , transactionData , isCoinbase@@ -45,11 +51,23 @@ , balanceToEncoding , addressTxToJSON , addressTxToEncoding+ , xPubTxToJSON+ , xPubTxToEncoding+ , xPubBalToJSON+ , xPubBalToEncoding+ , xPubUnspentToJSON+ , xPubUnspentToEncoding+ , mergeSourcesBy ) where +import Conduit import Control.Monad.Except import Control.Monad.Logger+import Data.Foldable+import Data.Function+import Data.List import Data.Maybe+import Data.Word import Haskoin import Haskoin.Node import Network.Haskoin.Store.Block@@ -181,3 +199,89 @@ , peerServices = sv , peerRelay = rl }++xpubAddrs ::+ (Monad m, StoreStream i m)+ => i+ -> XPubKey+ -> m [(Address, SoftPath)]+xpubAddrs i k = (<>) <$> go 0 0 <*> go 1 0+ where+ go m n = do+ let g a = not <$> runConduit (getAddressTxs i a .| nullC)+ t <- or <$> mapM (g . fst) (as m n)+ if t+ then (as m n <>) <$> go m (n + 100)+ else return []+ as m n =+ map+ (\(a, _, n) -> (a, Deriv :/ m :/ n))+ (take 100 (deriveAddrs (pubSubKey k m) n))++xpubTxs ::+ (Monad m, StoreStream i m)+ => i+ -> XPubKey+ -> ConduitT () XPubTx m ()+xpubTxs i xpub = do+ as <- lift $ xpubAddrs i xpub+ let cds = map (uncurry cnd) as+ mergeSourcesBy (compare `on` (addressTxBlock . xPubTx)) cds+ where+ cnd a p = getAddressTxs i a .| mapC (f p)+ f p t = XPubTx {xPubTxKey = xpub, xPubTxPath = p, xPubTx = t}++xpubBals ::+ (Monad m, StoreStream i m, StoreRead i m) => i -> XPubKey -> m [XPubBal]+xpubBals i xpub = do+ as <- xpubAddrs i xpub+ fmap catMaybes $+ forM as $ \(a, p) ->+ getBalance i a >>= \b ->+ return $+ if balanceCount b == 0+ then Nothing+ else Just+ XPubBal+ { xPubBalKey = xpub+ , xPubBalPath = p+ , xPubBal = b+ }++xpubUnspent ::+ (Monad m, StoreStream i m, StoreRead i m)+ => i+ -> XPubKey+ -> ConduitT () XPubUnspent m ()+xpubUnspent i xpub = do+ as <- lift $ xpubAddrs i xpub+ let cds = map (uncurry cnd) as+ mergeSourcesBy (compare `on` (unspentBlock . xPubUnspent)) cds+ where+ cnd a p = getAddressUnspents i a .| mapC (f p)+ f p t =+ XPubUnspent+ {xPubUnspentKey = xpub, xPubUnspentPath = p, xPubUnspent = t}++-- Snatched from:+-- https://github.com/cblp/conduit-merge/blob/master/src/Data/Conduit/Merge.hs+mergeSourcesBy ::+ (Foldable f, Monad m)+ => (a -> a -> Ordering)+ -> f (ConduitT () a m ())+ -> ConduitT i a m ()+mergeSourcesBy f = mergeSealed . fmap sealConduitT . toList+ where+ mergeSealed sources = do+ prefetchedSources <- lift $ traverse ($$++ await) sources+ go [(a, s) | (s, Just a) <- prefetchedSources]+ go [] = pure ()+ go sources = do+ let (a, src1):sources1 = sortBy (f `on` fst) sources+ yield a+ (src2, mb) <- lift $ src1 $$++ await+ let sources2 =+ case mb of+ Nothing -> sources1+ Just b -> (b, src2) : sources1+ go sources2
src/Network/Haskoin/Store/Data.hs view
@@ -325,21 +325,21 @@ -- | Detailed transaction information. data Transaction = Transaction- { transactionBlock :: !BlockRef+ { transactionBlock :: !BlockRef -- ^ block information for this transaction- , transactionVersion :: !Word32+ , transactionVersion :: !Word32 -- ^ transaction version- , transactionLockTime :: !Word32+ , transactionLockTime :: !Word32 -- ^ lock time- , transactionFee :: !Word64+ , transactionFee :: !Word64 -- ^ transaction fees paid to miners in satoshi- , transactionInputs :: ![Input]+ , transactionInputs :: ![Input] -- ^ transaction inputs- , transactionOutputs :: ![Output]+ , transactionOutputs :: ![Output] -- ^ transaction outputs- , transactionDeleted :: !Bool+ , transactionDeleted :: !Bool -- ^ this transaction has been deleted and is no longer valid- , transactionRBF :: !Bool+ , transactionRBF :: !Bool -- ^ this transaction can be replaced in the mempool } deriving (Show, Eq, Ord, Generic, Hashable, Serialize) @@ -409,3 +409,69 @@ instance ToJSON PeerInformation where toJSON = object . peerInformationPairs toEncoding = pairs . mconcat . peerInformationPairs++-- | Address transaction from an extended public key.+data XPubTx = XPubTx+ { xPubTxKey :: !XPubKey+ , xPubTxPath :: !SoftPath+ , xPubTx :: !AddressTx+ } deriving (Show, Eq, Generic)++-- | JSON serialization for 'XPubTx'.+xPubTxPairs :: A.KeyValue kv => Network -> XPubTx -> [kv]+xPubTxPairs net XPubTx {xPubTxKey = k, xPubTxPath = p, xPubTx = tx} =+ [ "key" .= xPubExport net k+ , "path" .= pathToStr p+ , "tx" .= addressTxToJSON net tx+ ]++xPubTxToJSON :: Network -> XPubTx -> Value+xPubTxToJSON net = object . xPubTxPairs net++xPubTxToEncoding :: Network -> XPubTx -> Encoding+xPubTxToEncoding net = pairs . mconcat . xPubTxPairs net++-- | Address balances for an extended public key.+data XPubBal = XPubBal+ { xPubBalKey :: !XPubKey+ , xPubBalPath :: !SoftPath+ , xPubBal :: !Balance+ } deriving (Show, Eq, Generic)++-- | JSON serialization for 'XPubBal'.+xPubBalPairs :: A.KeyValue kv => Network -> XPubBal -> [kv]+xPubBalPairs net XPubBal {xPubBalKey = k, xPubBalPath = p, xPubBal = b} =+ [ "key" .= xPubExport net k+ , "path" .= pathToStr p+ , "balance" .= balanceToJSON net b+ ]++xPubBalToJSON :: Network -> XPubBal -> Value+xPubBalToJSON net = object . xPubBalPairs net++xPubBalToEncoding :: Network -> XPubBal -> Encoding+xPubBalToEncoding net = pairs . mconcat . xPubBalPairs net++-- | Unspent transaction for extended public key.+data XPubUnspent = XPubUnspent+ { xPubUnspentKey :: !XPubKey+ , xPubUnspentPath :: !SoftPath+ , xPubUnspent :: !Unspent+ } deriving (Show, Eq, Generic)++-- | JSON serialization for 'XPubUnspent'.+xPubUnspentPairs :: A.KeyValue kv => Network -> XPubUnspent -> [kv]+xPubUnspentPairs net XPubUnspent { xPubUnspentKey = k+ , xPubUnspentPath = p+ , xPubUnspent = u+ } =+ [ "key" .= xPubExport net k+ , "path" .= pathToStr p+ , "unspent" .= unspentToJSON net u+ ]++xPubUnspentToJSON :: Network -> XPubUnspent -> Value+xPubUnspentToJSON net = object . xPubUnspentPairs net++xPubUnspentToEncoding :: Network -> XPubUnspent -> Encoding+xPubUnspentToEncoding net = pairs . mconcat . xPubUnspentPairs net
src/Network/Haskoin/Store/Logic.hs view
@@ -1,8 +1,9 @@-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-} module Network.Haskoin.Store.Logic where +import Conduit import Control.Monad import Control.Monad.Except import qualified Data.ByteString as B@@ -73,7 +74,7 @@ getTxOutput (outPointIndex op) t let ds = map spenderHash (mapMaybe outputSpender us) if null ds- then importTx net i (MemRef now) tx+ then importTx i (MemRef now) tx else g ds g ds = do rbf <-@@ -84,8 +85,8 @@ then r ds else n r ds = do- forM_ ds (recursiveDeleteTx net i)- importTx net i (MemRef now) tx+ forM_ ds (deleteTx i False)+ importTx i (MemRef now) tx n = insertDeletedMempoolTx i tx now isrbf th = transactionRBF <$> getImportTx i th @@ -147,12 +148,12 @@ setBest i (headerHash (nodeHeader n)) txs <- concat <$> mapM (getRecursiveTx i . txHash) (tail (blockTxns b)) mapM_ (deleteTx i False . txHash . transactionData) (reverse txs)- zipWithM_ (\x t -> importTx net i (br x) t) [0 ..] (blockTxns b)+ zipWithM_ (\x t -> importTx i (br x) t) [0 ..] (blockTxns b) forM_ txs $ \tr -> do let tx = transactionData tr when (tx `notElem` blockTxns b) $ case transactionBlock tr of- MemRef t -> newMempoolTx net i tx t+ MemRef t -> newMempoolTx net i tx t BlockRef {} -> throwError (TxConfirmed (txHash tx)) where br pos = BlockRef {blockRefHeight = nodeHeight n, blockRefPos = pos}@@ -162,12 +163,11 @@ , StoreRead i m , StoreWrite i m )- => Network- -> i+ => i -> BlockRef -> Tx -> m ()-importTx net i br tx =+importTx i br tx = getTransaction i th >>= \case Just t | not (transactionDeleted t) -> return ()@@ -189,7 +189,7 @@ throwError (InsufficientFunds th) when (confirmed br && any (isJust . outputSpender) us) $ do let ds = map spenderHash (mapMaybe outputSpender us)- mapM_ (recursiveDeleteTx net i) ds+ mapM_ (deleteTx i False) ds when (not (confirmed br) && any (isJust . outputSpender) us) $ throwError (TxDoubleSpend th) zipWithM_@@ -267,26 +267,6 @@ (mapMaybe outputSpender (transactionOutputs t))) concat <$> mapM (getRecursiveTx i) ss --recursiveDeleteTx ::- (MonadError ImportException m, StoreRead i m, StoreWrite i m)- => Network- -> i- -> TxHash- -> m ()-recursiveDeleteTx net i th =- getTransaction i th >>= \case- Nothing -> throwError (TxNotFound th)- Just tx- | not (transactionDeleted tx) -> do- let ss =- map- spenderHash- (mapMaybe outputSpender (transactionOutputs tx))- forM_ ss (recursiveDeleteTx net i)- deleteTx i True th- | otherwise -> throwError (TxDeleted th)- deleteTx :: (MonadError ImportException m, StoreRead i m, StoreWrite i m) => i@@ -301,15 +281,15 @@ if mo && confirmed (transactionBlock t) then throwError (TxConfirmed h) else go t- | otherwise -> throwError (TxDeleted h)+ | otherwise -> return () where go t = do- when (any (isJust . outputSpender) (transactionOutputs t)) $- throwError (TxOutputsSpent h)+ forM_ (mapMaybe outputSpender (transactionOutputs t)) $ \s ->+ deleteTx i False (spenderHash s) forM_ (take (length (transactionOutputs t)) [0 ..]) $ \n -> deleteOutput i (OutPoint h n)- forM_ (map inputPoint (transactionInputs t)) $ \op ->- unspendOutput i op (transactionBlock t)+ let ps = filter (/= nullOutPoint) (map inputPoint (transactionInputs t))+ forM_ ps $ \op -> unspendOutput i op (transactionBlock t) unless (confirmed (transactionBlock t)) $ deleteMempoolTx i h (memRefTime (transactionBlock t)) insertTx i t {transactionDeleted = True}