diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -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 diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -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 diff --git a/haskoin-store.cabal b/haskoin-store.cabal --- a/haskoin-store.cabal +++ b/haskoin-store.cabal @@ -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 diff --git a/src/Haskoin/Store.hs b/src/Haskoin/Store.hs --- a/src/Haskoin/Store.hs +++ b/src/Haskoin/Store.hs @@ -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) diff --git a/src/Network/Haskoin/Store/Data.hs b/src/Network/Haskoin/Store/Data.hs --- a/src/Network/Haskoin/Store/Data.hs +++ b/src/Network/Haskoin/Store/Data.hs @@ -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 diff --git a/src/Network/Haskoin/Store/Data/HashMap.hs b/src/Network/Haskoin/Store/Data/HashMap.hs --- a/src/Network/Haskoin/Store/Data/HashMap.hs +++ b/src/Network/Haskoin/Store/Data/HashMap.hs @@ -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 diff --git a/src/Network/Haskoin/Store/Data/ImportDB.hs b/src/Network/Haskoin/Store/Data/ImportDB.hs --- a/src/Network/Haskoin/Store/Data/ImportDB.hs +++ b/src/Network/Haskoin/Store/Data/ImportDB.hs @@ -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 } } diff --git a/src/Network/Haskoin/Store/Data/KeyValue.hs b/src/Network/Haskoin/Store/Data/KeyValue.hs --- a/src/Network/Haskoin/Store/Data/KeyValue.hs +++ b/src/Network/Haskoin/Store/Data/KeyValue.hs @@ -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) diff --git a/src/Network/Haskoin/Store/Data/RocksDB.hs b/src/Network/Haskoin/Store/Data/RocksDB.hs --- a/src/Network/Haskoin/Store/Data/RocksDB.hs +++ b/src/Network/Haskoin/Store/Data/RocksDB.hs @@ -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 :: diff --git a/src/Network/Haskoin/Store/Logic.hs b/src/Network/Haskoin/Store/Logic.hs --- a/src/Network/Haskoin/Store/Logic.hs +++ b/src/Network/Haskoin/Store/Logic.hs @@ -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