haskoin-store 0.9.3 → 0.10.0
raw patch · 10 files changed
+123/−134 lines, 10 files
Files
- README.md +5/−6
- app/Main.hs +22/−4
- haskoin-store.cabal +2/−2
- src/Haskoin/Store.hs +5/−12
- src/Network/Haskoin/Store/Data.hs +13/−37
- src/Network/Haskoin/Store/Data/HashMap.hs +18/−18
- src/Network/Haskoin/Store/Data/ImportDB.hs +10/−10
- src/Network/Haskoin/Store/Data/KeyValue.hs +14/−11
- src/Network/Haskoin/Store/Data/RocksDB.hs +2/−2
- src/Network/Haskoin/Store/Logic.hs +32/−32
README.md view
@@ -2,15 +2,14 @@ Full blockchain index & store featuring: -- Bitcoin Cash & Bitcoin SegWit support.-- Address index.-- Mempool.+- Bitcoin Cash (BCH) & Bitcoin SegWit (BTC) support.+- Address balance, transaction, and UTXO index.+- Mempool support (SPV).+- XPub balance, transaction, and UTXO support. - Persistent storage using RocksDB. - RESTful endpoints for blockchain data.-- Concurrent design.-- No blocking on database access.+- Concurrent non-blocking transactional design. - Guaranteed consistency within a request.-- Atomic updates to prevent corruption. ## Install
app/Main.hs view
@@ -384,7 +384,7 @@ address mbr .| apply_limit mlimit .|- jsonListConduit (addressTxToEncoding net) .|+ jsonListConduit toEncoding .| streamConduit io >> liftIO flush' S.get "/address/transactions" $ do@@ -396,7 +396,7 @@ withSnapshot db $ \s -> runResourceT . runConduit $ mergeSourcesBy- (compare `on` addressTxBlock)+ (compare `on` blockTxBlock) (map (\a -> getAddressTxs ( db@@ -405,8 +405,9 @@ a mbr) addresses) .|+ dedup .| apply_limit mlimit .|- jsonListConduit (addressTxToEncoding net) .|+ jsonListConduit toEncoding .| streamConduit io >> liftIO flush' S.get "/address/:address/unspent" $ do@@ -504,8 +505,9 @@ (db, defaultReadOptions {useSnapshot = Just s}) mbr xpub .|+ dedup .| apply_limit mlimit .|- jsonListConduit (xPubTxToEncoding net) .|+ jsonListConduit toEncoding .| streamConduit io >> liftIO flush' S.get "/xpub/:xpub/unspent" $ do@@ -595,6 +597,22 @@ return (mlimit, mbr) apply_limit Nothing = mapC id apply_limit (Just l) = takeC l+ dedup =+ let dd Nothing =+ await >>= \case+ Just x -> do+ yield x+ dd (Just x)+ Nothing -> return ()+ dd (Just x) =+ await >>= \case+ Just y+ | x == y -> dd (Just x)+ | otherwise -> do+ yield y+ dd (Just y)+ Nothing -> return ()+ in dd Nothing parse_address = do address <- param "address" case stringToAddr net address of
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: d7d39d99b4d45e36ca08428bcb15a41a1a9067b45e51c01b3a7fd96413b9eab7+-- hash: 7f1d67d87786e3d207534c1ab8af4ee52a7b327ba26511cb15e04c90ade3131d name: haskoin-store-version: 0.9.3+version: 0.10.0 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,8 +16,7 @@ , Spender(..) , BlockRef(..) , Unspent(..)- , AddressTx(..)- , XPubTx(..)+ , BlockTx(..) , XPubBal(..) , XPubUnspent(..) , Balance(..)@@ -59,10 +58,6 @@ , unspentToEncoding , balanceToJSON , balanceToEncoding- , addressTxToJSON- , addressTxToEncoding- , xPubTxToJSON- , xPubTxToEncoding , xPubBalToJSON , xPubBalToEncoding , xPubUnspentToJSON@@ -270,15 +265,13 @@ => i -> Maybe BlockRef -> XPubKey- -> ConduitT () XPubTx m ()+ -> ConduitT () BlockTx m () xpubTxs i mbr xpub = do bals <- lift $ xpubBals i xpub xs <-- forM bals $ \XPubBal {xPubBalPath = p, xPubBal = b} ->- return $ getAddressTxs i (balanceAddress b) mbr .| mapC (f p)- mergeSourcesBy (flip compare `on` (addressTxBlock . xPubTx)) xs- where- f p t = XPubTx {xPubTxPath = p, xPubTx = t}+ forM bals $ \XPubBal {xPubBal = b} ->+ return $ getAddressTxs i (balanceAddress b) mbr+ mergeSourcesBy (flip compare `on` blockTxBlock) xs xpubUnspent :: (Monad m, StoreStream i m, BalanceRead i m, StoreRead i m)
src/Network/Haskoin/Store/Data.hs view
@@ -74,7 +74,7 @@ getAddressUnspents :: r -> Address -> Maybe BlockRef -> ConduitT () Unspent m () getAddressTxs ::- r -> Address -> Maybe BlockRef -> ConduitT () AddressTx m ()+ r -> Address -> Maybe BlockRef -> ConduitT () BlockTx m () class StoreWrite w m where setInit :: w -> m ()@@ -84,8 +84,8 @@ insertTx :: w -> TxData -> m () insertSpender :: w -> OutPoint -> Spender -> m () deleteSpender :: w -> OutPoint -> m ()- insertAddrTx :: w -> AddressTx -> m ()- removeAddrTx :: w -> AddressTx -> m ()+ insertAddrTx :: w -> Address -> BlockTx -> m ()+ removeAddrTx :: w -> Address -> BlockTx -> m () insertAddrUnspent :: w -> Address -> Unspent -> m () removeAddrUnspent :: w -> Address -> Unspent -> m () insertMempoolTx :: w -> TxHash -> PreciseUnixTime -> m ()@@ -156,28 +156,23 @@ toEncoding = pairs . mconcat . blockRefPairs -- | Transaction in relation to an address.-data AddressTx = AddressTx- { addressTxAddress :: !Address- -- ^ transaction address- , addressTxBlock :: !BlockRef+data BlockTx = BlockTx+ { blockTxBlock :: !BlockRef -- ^ block information- , addressTxHash :: !TxHash+ , blockTxHash :: !TxHash -- ^ transaction hash } deriving (Show, Eq, Ord, Generic, Serialize, Hashable) -- | JSON serialization for 'AddressTx'.-addressTxPairs :: A.KeyValue kv => Network -> AddressTx -> [kv]-addressTxPairs net atx =- [ "address" .= addrToJSON net (addressTxAddress atx)- , "txid" .= addressTxHash atx- , "block" .= addressTxBlock atx+blockTxPairs :: A.KeyValue kv => BlockTx -> [kv]+blockTxPairs btx =+ [ "txid" .= blockTxHash btx+ , "block" .= blockTxBlock btx ] -addressTxToJSON :: Network -> AddressTx -> Value-addressTxToJSON net = object . addressTxPairs net--addressTxToEncoding :: Network -> AddressTx -> Encoding-addressTxToEncoding net = pairs . mconcat . addressTxPairs net+instance ToJSON BlockTx where+ toJSON = object . blockTxPairs+ toEncoding = pairs . mconcat . blockTxPairs -- | Address balance information. data Balance = Balance@@ -598,25 +593,6 @@ instance ToJSON PeerInformation where toJSON = object . peerInformationPairs toEncoding = pairs . mconcat . peerInformationPairs---- | Address transaction from an extended public key.-data XPubTx = XPubTx- { xPubTxPath :: ![KeyIndex]- , xPubTx :: !AddressTx- } deriving (Show, Eq, Generic)---- | JSON serialization for 'XPubTx'.-xPubTxPairs :: A.KeyValue kv => Network -> XPubTx -> [kv]-xPubTxPairs net XPubTx {xPubTxPath = p, xPubTx = tx} =- [ "path" .= 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
src/Network/Haskoin/Store/Data/HashMap.hs view
@@ -107,7 +107,7 @@ hMempool db in yieldMany [(u, h) | (u, hs) <- ls, h <- hs] -getAddressTxsH :: HashMapDB -> Address -> Maybe BlockRef -> [AddressTx]+getAddressTxsH :: HashMapDB -> Address -> Maybe BlockRef -> [BlockTx] getAddressTxsH db a mbr = dropWhile h . sortBy (flip compare) . catMaybes . concatMap (uncurry f) . M.toList $@@ -116,10 +116,10 @@ f b hm = map (uncurry (g b)) $ M.toList hm g b h' True = Just- AddressTx- {addressTxAddress = a, addressTxBlock = b, addressTxHash = h'}+ BlockTx+ {blockTxBlock = b, blockTxHash = h'} g _ _ False = Nothing- h AddressTx {addressTxBlock = b} =+ h BlockTx {blockTxBlock = b} = case mbr of Nothing -> False Just br -> b > br@@ -198,24 +198,24 @@ , balValTotalReceived = balanceTotalReceived b } -insertAddrTxH :: AddressTx -> HashMapDB -> HashMapDB-insertAddrTxH a db =+insertAddrTxH :: Address -> BlockTx -> HashMapDB -> HashMapDB+insertAddrTxH a btx db = let s = M.singleton- (addressTxAddress a)+ a (M.singleton- (addressTxBlock a)- (M.singleton (addressTxHash a) True))+ (blockTxBlock btx)+ (M.singleton (blockTxHash btx) True)) in db {hAddrTx = M.unionWith (M.unionWith M.union) s (hAddrTx db)} -removeAddrTxH :: AddressTx -> HashMapDB -> HashMapDB-removeAddrTxH a db =+removeAddrTxH :: Address -> BlockTx -> HashMapDB -> HashMapDB+removeAddrTxH a btx db = let s = M.singleton- (addressTxAddress a)+ a (M.singleton- (addressTxBlock a)- (M.singleton (addressTxHash a) False))+ (blockTxBlock btx)+ (M.singleton (blockTxHash btx) False)) in db {hAddrTx = M.unionWith (M.unionWith M.union) s (hAddrTx db)} insertAddrUnspentH :: Address -> Unspent -> HashMapDB -> HashMapDB@@ -334,8 +334,8 @@ insertTx f = f . insertTxH insertSpender f p = f . insertSpenderH p deleteSpender f = f . deleteSpenderH- insertAddrTx f = f . insertAddrTxH- removeAddrTx f = f . removeAddrTxH+ insertAddrTx f a = f . insertAddrTxH a+ removeAddrTx f a = f . removeAddrTxH a insertAddrUnspent f a = f . insertAddrUnspentH a removeAddrUnspent f a = f . removeAddrUnspentH a insertMempoolTx f h = f . insertMempoolTxH h@@ -353,8 +353,8 @@ insertTx v = atomically . insertTx (modifyTVar v) insertSpender v p = atomically . insertSpender (modifyTVar v) p deleteSpender v = atomically . deleteSpender (modifyTVar v)- insertAddrTx v = atomically . insertAddrTx (modifyTVar v)- removeAddrTx v = atomically . removeAddrTx (modifyTVar v)+ insertAddrTx v a = atomically . insertAddrTx (modifyTVar v) a+ removeAddrTx v a = atomically . removeAddrTx (modifyTVar v) a insertAddrUnspent v a = atomically . insertAddrUnspent (modifyTVar v) a removeAddrUnspent v a = atomically . removeAddrUnspent (modifyTVar v) a insertMempoolTx v h = atomically . insertMempoolTx (modifyTVar v) h
src/Network/Haskoin/Store/Data/ImportDB.hs view
@@ -107,22 +107,22 @@ h a b t True = insertOp (AddrTxKey- { addrTxKey =- AddressTx- { addressTxAddress = a- , addressTxBlock = b- , addressTxHash = t+ { addrTxKeyA = a+ , addrTxKeyT =+ BlockTx+ { blockTxBlock = b+ , blockTxHash = t } }) () h a b t False = deleteOp AddrTxKey- { addrTxKey =- AddressTx- { addressTxAddress = a- , addressTxBlock = b- , addressTxHash = t+ { addrTxKeyA = a+ , addrTxKeyT =+ BlockTx+ { blockTxBlock = b+ , blockTxHash = t } }
src/Network/Haskoin/Store/Data/KeyValue.hs view
@@ -20,7 +20,9 @@ -- | Database key for an address transaction. data AddrTxKey- = AddrTxKey { addrTxKey :: !AddressTx }+ = AddrTxKey { addrTxKeyA :: !Address+ , addrTxKeyT :: !BlockTx+ } -- ^ key for a transaction affecting an address | AddrTxKeyA { addrTxKeyA :: !Address } -- ^ short key that matches all entries@@ -32,10 +34,11 @@ instance Serialize AddrTxKey -- 0x05 · Address · BlockRef · TxHash where- put AddrTxKey {addrTxKey = AddressTx { addressTxAddress = a- , addressTxBlock = b- , addressTxHash = t- }} = do+ put AddrTxKey { addrTxKeyA = a+ , addrTxKeyT = BlockTx { blockTxBlock = b+ , blockTxHash = t+ }+ } = do putWord8 0x05 put a put b@@ -56,11 +59,11 @@ t <- get return AddrTxKey- { addrTxKey =- AddressTx- { addressTxAddress = a- , addressTxBlock = b- , addressTxHash = t+ { addrTxKeyA = a+ , addrTxKeyT =+ BlockTx+ { blockTxBlock = b+ , blockTxHash = t } } @@ -186,7 +189,7 @@ -- | Mempool transaction database key. data MemKey = MemKey { memTime :: !PreciseUnixTime- , memKey :: !TxHash }+ , memKey :: !TxHash } | MemKeyT { memTime :: !PreciseUnixTime } | MemKeyS deriving (Show, Read, Eq, Ord, Generic, Hashable)
src/Network/Haskoin/Store/Data/RocksDB.hs view
@@ -100,14 +100,14 @@ -> ReadOptions -> Address -> Maybe BlockRef- -> ConduitT () AddressTx m ()+ -> ConduitT () BlockTx m () getAddressTxsDB db opts a mbr = x .| mapC (uncurry f) where x = case mbr of Nothing -> matching db opts (AddrTxKeyA a) Just br -> matchingSkip db opts (AddrTxKeyA a) (AddrTxKeyB a br)- f AddrTxKey {addrTxKey = t} () = t+ f AddrTxKey {addrTxKeyT = t} () = t f _ _ = undefined getAddressUnspentsDB ::
src/Network/Haskoin/Store/Logic.hs view
@@ -445,17 +445,17 @@ Right a -> do removeAddrTx i- AddressTx- { addressTxAddress = a- , addressTxBlock = txDataBlock t- , addressTxHash = txHash tx+ a+ BlockTx+ { blockTxBlock = txDataBlock t+ , blockTxHash = txHash tx } insertAddrTx i- AddressTx- { addressTxAddress = a- , addressTxBlock = br- , addressTxHash = txHash tx+ a+ BlockTx+ { blockTxBlock = br+ , blockTxHash = txHash tx } forM_ (zip [0 ..] (txOut tx)) $ \(n, o) -> do let op = OutPoint (txHash tx) n@@ -475,17 +475,17 @@ Right a -> do removeAddrTx i- AddressTx- { addressTxAddress = a- , addressTxBlock = txDataBlock t- , addressTxHash = txHash tx+ a+ BlockTx+ { blockTxBlock = txDataBlock t+ , blockTxHash = txHash tx } insertAddrTx i- AddressTx- { addressTxAddress = a- , addressTxBlock = br- , addressTxHash = txHash tx+ a+ BlockTx+ { blockTxBlock = br+ , blockTxHash = txHash tx } when (isNothing s) $ do removeAddrUnspent@@ -655,10 +655,10 @@ insertAddrUnspent i a u insertAddrTx i- AddressTx- { addressTxAddress = a- , addressTxHash = outPointHash op- , addressTxBlock = br+ a+ BlockTx+ { blockTxHash = outPointHash op+ , blockTxBlock = br } increaseBalance i (confirmed br) True a (outValue to) where@@ -702,10 +702,10 @@ } removeAddrTx i- AddressTx- { addressTxAddress = a- , addressTxHash = outPointHash op- , addressTxBlock = transactionBlock t+ a+ BlockTx+ { blockTxHash = outPointHash op+ , blockTxBlock = transactionBlock t } reduceBalance net@@ -789,10 +789,10 @@ removeAddrUnspent i a u insertAddrTx i- AddressTx- { addressTxAddress = a- , addressTxHash = th- , addressTxBlock = br+ a+ BlockTx+ { blockTxHash = th+ , blockTxBlock = br } delUnspent i (unspentPoint u) @@ -837,10 +837,10 @@ insertAddrUnspent i a u removeAddrTx i- AddressTx- { addressTxAddress = a- , addressTxHash = spenderHash s- , addressTxBlock = transactionBlock x+ a+ BlockTx+ { blockTxHash = spenderHash s+ , blockTxBlock = transactionBlock x } increaseBalance i