haskoin-store 0.14.7 → 0.14.8
raw patch · 5 files changed
+350/−85 lines, 5 files
Files
- CHANGELOG.md +7/−0
- app/Main.hs +71/−70
- haskoin-store.cabal +2/−2
- src/Haskoin/Store.hs +194/−6
- src/Network/Haskoin/Store/Data.hs +76/−7
CHANGELOG.md view
@@ -4,6 +4,13 @@ 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.14.8+### Added+- Endpoint for xpub summaries.+- Endpoints for full transactions.+- Ability to query by offset/limit.+- More API documentation.+ ## 0.14.7 ### Added - Debug information for `publishTx`.
app/Main.hs view
@@ -284,20 +284,11 @@ S.raw $ serialAny net proto res S.get "/mempool" $ do cors- (mlimit, mbr) <- parse_limits- mpu <-- case mbr of- Just BlockRef {} ->- raise $- UserError "mempool transactions do not have height"- Just (MemRef t) -> return $ Just t- Nothing -> return Nothing+ (l, s) <- parse_limits proto <- setupBin stream $ \io flush' -> runResourceT . withBlockDB defaultReadOptions db $ do- runConduit $- getMempool mpu .| mapC snd .| apply_limit mlimit .|- streamAny net proto io+ runConduit $ getMempoolLimit l s .| streamAny net proto io liftIO flush' S.get "/transaction/:txid" $ do cors@@ -356,53 +347,63 @@ S.raw . L.concat $ map (Serialize.encodeLazy . transactionData) res S.get "/address/:address/transactions" $ do cors- address <- parse_address- (mlimit, mbr) <- parse_limits+ a <- parse_address+ (l, s) <- parse_limits proto <- setupBin stream $ \io flush' -> runResourceT . withBlockDB defaultReadOptions db $ do runConduit $- getAddressTxs address mbr .| apply_limit mlimit .|- streamAny net proto io+ getAddressTxsLimit l s a .| streamAny net proto io liftIO flush'+ S.get "/address/:address/transactions/full" $ do+ cors+ a <- parse_address+ (l, s) <- parse_limits+ proto <- setupBin+ stream $ \io flush' ->+ runResourceT . withBlockDB defaultReadOptions db $ do+ runConduit $+ getAddressTxsFull l s a .| streamAny net proto io+ liftIO flush' S.get "/address/transactions" $ do cors- addresses <- parse_addresses- (mlimit, mbr) <- parse_limits+ as <- parse_addresses+ (l, s) <- parse_limits proto <- setupBin stream $ \io flush' -> runResourceT . withBlockDB defaultReadOptions db $ do runConduit $- mergeSourcesBy- (flip compare `on` blockTxBlock)- (map (`getAddressTxs` mbr) addresses) .|- dedup .|- apply_limit mlimit .|- streamAny net proto io+ getAddressesTxsLimit l s as .| streamAny net proto io liftIO flush'+ S.get "/address/transactions/full" $ do+ cors+ as <- parse_addresses+ (l, s) <- parse_limits+ proto <- setupBin+ stream $ \io flush' ->+ runResourceT . withBlockDB defaultReadOptions db $ do+ runConduit $+ getAddressesTxsFull l s as .| streamAny net proto io+ liftIO flush' S.get "/address/:address/unspent" $ do cors- address <- parse_address- (mlimit, mbr) <- parse_limits+ a <- parse_address+ (l, s) <- parse_limits proto <- setupBin stream $ \io flush' -> runResourceT . withBlockDB defaultReadOptions db $ do runConduit $- getAddressUnspents address mbr .| apply_limit mlimit .|- streamAny net proto io+ getAddressUnspentsLimit l s a .| streamAny net proto io liftIO flush' S.get "/address/unspent" $ do cors- addresses <- parse_addresses- (mlimit, mbr) <- parse_limits+ as <- parse_addresses+ (l, s) <- parse_limits proto <- setupBin stream $ \io flush' -> runResourceT . withBlockDB defaultReadOptions db $ do runConduit $- mergeSourcesBy- (flip compare `on` unspentBlock)- (map (`getAddressUnspents` mbr) addresses) .|- apply_limit mlimit .|+ getAddressesUnspentsLimit l s as .| streamAny net proto io liftIO flush' S.get "/address/:address/balance" $ do@@ -450,26 +451,43 @@ S.raw $ serialAny net proto res S.get "/xpub/:xpub/transactions" $ do cors+ x <- parse_xpub+ (l, s) <- parse_limits+ proto <- setupBin+ bs <- withBlockDB defaultReadOptions db $ xpubBals x+ stream $ \io flush' ->+ runResourceT . withBlockDB defaultReadOptions db $ do+ runConduit $ xpubTxsLimit l s bs .| streamAny net proto io+ liftIO flush'+ S.get "/xpub/:xpub/transactions/full" $ do+ cors xpub <- parse_xpub- (mlimit, mbr) <- parse_limits+ (l, s) <- parse_limits proto <- setupBin+ bs <- withBlockDB defaultReadOptions db $ xpubBals xpub stream $ \io flush' -> runResourceT . withBlockDB defaultReadOptions db $ do- runConduit $- xpubTxs mbr xpub .| dedup .| apply_limit mlimit .|- streamAny net proto io+ runConduit $ xpubTxsFull l s bs .| streamAny net proto io liftIO flush' S.get "/xpub/:xpub/unspent" $ do cors- xpub <- parse_xpub+ x <- parse_xpub proto <- setupBin- (mlimit, mbr) <- parse_limits+ (l, s) <- parse_limits stream $ \io flush' -> runResourceT . withBlockDB defaultReadOptions db $ do runConduit $- xpubUnspent mbr xpub .| apply_limit mlimit .|- streamAny net proto io+ xpubUnspentLimit l s x .| streamAny net proto io liftIO flush'+ S.get "/xpub/:xpub" $ do+ cors+ x <- parse_xpub+ (l, s) <- parse_limits+ proto <- setupBin+ res <-+ lift . runResourceT $+ withBlockDB defaultReadOptions db $ xpubSummary l s x+ S.raw $ serialAny net proto res S.post "/transactions" $ do cors proto <- setupBin@@ -483,7 +501,8 @@ lift (publishTx net pub st db tx) >>= \case Right () -> do S.raw $ serialAny net proto (TxId (txHash tx))- lift $ $(logDebugS) "Main" $+ lift $+ $(logDebugS) "Main" $ "Success publishing tx " <> txHashToHex (txHash tx) Left e -> do case e of@@ -493,7 +512,8 @@ PubNotFound -> status status500 PubReject _ -> status status400 S.raw $ serialAny net proto (UserError (show e))- lift $ $(logErrorS) "Main" $+ lift $+ $(logErrorS) "Main" $ "Error publishing tx " <> txHashToHex (txHash tx) <> ": " <> cs (show e)@@ -543,35 +563,16 @@ let b = do height <- param "height" pos <- param "pos" `rescue` const (return maxBound)- return $ BlockRef height pos+ return $ StartBlock height pos m = do time <- param "time"- return $ MemRef (PreciseUnixTime time)- mlimit <- fmap Just (param "limit") `rescue` const (return Nothing)- case mlimit of- Just l- | l < 0 -> raise $ UserError "limit cannot be negative"- _ -> return ()- mbr <- Just <$> b <|> Just <$> m <|> return Nothing- 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+ return $ StartMem (PreciseUnixTime time)+ o = do+ o <- param "offset" `rescue` const (return 0)+ return $ StartOffset o+ l <- (Just <$> param "limit") `rescue` const (return Nothing)+ s <- b <|> m <|> o+ return (l, s) 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: 3151dea78baf97f4ea210484402ef8e6b12a1b131e8820f8832e6372e28ac36f+-- hash: 807e40f322a2b27c961a0296734a984a32c4f1fa0b9a3613acc3c1661f085a9a name: haskoin-store-version: 0.14.7+version: 0.14.8 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
@@ -6,6 +6,7 @@ {-# LANGUAGE MultiWayIf #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TupleSections #-} module Haskoin.Store ( Store(..) , BlockStore@@ -32,6 +33,7 @@ , BinSerial(..) , Except(..) , TxId(..)+ , StartFrom(..) , withStore , store , getBestBlock@@ -45,12 +47,23 @@ , toTransaction , getBalance , getMempool+ , getMempoolLimit , getAddressUnspents+ , getAddressUnspentsLimit+ , getAddressesUnspentsLimit , getAddressTxs+ , getAddressTxsFull+ , getAddressTxsLimit+ , getAddressesTxsFull+ , getAddressesTxsLimit , getPeersInformation , xpubTxs+ , xpubTxsLimit+ , xpubTxsFull , xpubBals , xpubUnspent+ , xpubUnspentLimit+ , xpubSummary , publishTx , transactionData , isCoinbase@@ -71,10 +84,12 @@ import Control.Monad.Trans.Maybe import Data.Foldable import Data.Function+import qualified Data.HashMap.Strict as H import Data.List import Data.Maybe import Data.Serialize (decode) import qualified Data.Text as T+import Data.Word (Word32) import Database.RocksDB as R import Haskoin import Haskoin.Node@@ -361,15 +376,32 @@ xpubTxs :: (Monad m, BalanceRead m, StoreStream m) => Maybe BlockRef- -> XPubKey+ -> [XPubBal] -> ConduitT () BlockTx m ()-xpubTxs mbr xpub = do- bals <- lift $ xpubBals xpub+xpubTxs m bs = do xs <-- forM bals $ \XPubBal {xPubBal = b} ->- return $ getAddressTxs (balanceAddress b) mbr- mergeSourcesBy (flip compare `on` blockTxBlock) xs+ forM bs $ \XPubBal {xPubBal = b} ->+ return $ getAddressTxs (balanceAddress b) m+ mergeSourcesBy (flip compare `on` blockTxBlock) xs .| dedup +xpubTxsLimit ::+ (Monad m, BalanceRead m, StoreStream m)+ => Maybe Word32+ -> StartFrom+ -> [XPubBal]+ -> ConduitT () BlockTx m ()+xpubTxsLimit l s bs = do+ xpubTxs (mbr s) bs .| (offset s >> limit l)++xpubTxsFull ::+ (Monad m, BalanceRead m, StoreStream m, StoreRead m)+ => Maybe Word32+ -> StartFrom+ -> [XPubBal]+ -> ConduitT () Transaction m ()+xpubTxsFull l s bs =+ xpubTxsLimit l s bs .| concatMapMC (getTransaction . blockTxHash)+ xpubUnspent :: (Monad m, StoreStream m, BalanceRead m, StoreRead m) => Maybe BlockRef@@ -384,6 +416,54 @@ where f p t = XPubUnspent {xPubUnspentPath = p, xPubUnspent = t} +xpubUnspentLimit ::+ (Monad m, StoreStream m, BalanceRead m, StoreRead m)+ => Maybe Word32+ -> StartFrom+ -> XPubKey+ -> ConduitT () XPubUnspent m ()+xpubUnspentLimit l s x =+ xpubUnspent (mbr s) x .| (offset s >> limit l)++xpubSummary ::+ (Monad m, StoreStream m, BalanceRead m, StoreRead m)+ => Maybe Word32+ -> StartFrom+ -> XPubKey+ -> m XPubSummary+xpubSummary l s x = do+ bs <- xpubBals x+ let f XPubBal {xPubBalPath = p, xPubBal = Balance {balanceAddress = a}} =+ (a, p)+ pm = H.fromList $ map f bs+ txs <- runConduit $ xpubTxsFull l s bs .| sinkList+ let as =+ nub+ [ a+ | t <- txs+ , let is = transactionInputs t+ , let os = transactionOutputs t+ , let ais =+ mapMaybe+ (eitherToMaybe . scriptToAddressBS . inputPkScript)+ is+ , let aos =+ mapMaybe+ (eitherToMaybe . scriptToAddressBS . outputScript)+ os+ , a <- ais ++ aos+ ]+ ps = H.fromList $ mapMaybe (\a -> (a, ) <$> H.lookup a pm) as+ return+ XPubSummary+ { xPubSummaryReceived =+ sum (map (balanceTotalReceived . xPubBal) bs)+ , xPubSummaryConfirmed = sum (map (balanceAmount . xPubBal) bs)+ , xPubSummaryZero = sum (map (balanceZero . xPubBal) bs)+ , xPubSummaryPaths = ps+ , xPubSummaryTxs = txs+ }+ -- | Check if any of the ancestors of this transaction is a coinbase after the -- specified height. Returns 'Nothing' if answer cannot be computed before -- hitting limits.@@ -441,3 +521,111 @@ Nothing -> sources1 Just b -> (b, src2) : sources1 go sources2++getMempoolLimit ::+ (Monad m, StoreStream m)+ => Maybe Word32+ -> StartFrom+ -> ConduitT () TxHash m ()+getMempoolLimit _ StartBlock {} = return ()+getMempoolLimit l (StartMem t) =+ getMempool (Just t) .| mapC snd .| limit l+getMempoolLimit l s =+ getMempool Nothing .| mapC snd .| (offset s >> limit l)++getAddressTxsLimit ::+ (Monad m, StoreStream m)+ => Maybe Word32+ -> StartFrom+ -> Address+ -> ConduitT () BlockTx m ()+getAddressTxsLimit l s a =+ getAddressTxs a (mbr s) .| (offset s >> limit l)++getAddressTxsFull ::+ (Monad m, StoreStream m, StoreRead m)+ => Maybe Word32+ -> StartFrom+ -> Address+ -> ConduitT () Transaction m ()+getAddressTxsFull l s a =+ getAddressTxsLimit l s a .| concatMapMC (getTransaction . blockTxHash)++getAddressesTxsLimit ::+ (Monad m, StoreStream m)+ => Maybe Word32+ -> StartFrom+ -> [Address]+ -> ConduitT () BlockTx m ()+getAddressesTxsLimit l s as =+ mergeSourcesBy+ (flip compare `on` blockTxBlock)+ (map (`getAddressTxs` mbr s) as) .|+ dedup .|+ (offset s >> limit l)++getAddressesTxsFull ::+ (Monad m, StoreStream m, StoreRead m)+ => Maybe Word32+ -> StartFrom+ -> [Address]+ -> ConduitT () Transaction m ()+getAddressesTxsFull l s as =+ mergeSourcesBy+ (flip compare `on` blockTxBlock)+ (map (`getAddressTxs` mbr s) as) .|+ dedup .|+ (offset s >> limit l) .|+ concatMapMC (getTransaction . blockTxHash)++getAddressUnspentsLimit ::+ (Monad m, StoreStream m)+ => Maybe Word32+ -> StartFrom+ -> Address+ -> ConduitT () Unspent m ()+getAddressUnspentsLimit l s a =+ getAddressUnspents a (mbr s) .| (offset s >> limit l)++getAddressesUnspentsLimit ::+ (Monad m, StoreStream m)+ => Maybe Word32+ -> StartFrom+ -> [Address]+ -> ConduitT () Unspent m ()+getAddressesUnspentsLimit l s as =+ mergeSourcesBy+ (flip compare `on` unspentBlock)+ (map (`getAddressUnspents` mbr s) as) .|+ (offset s >> limit l)++offset :: Monad m => StartFrom -> ConduitT i i m ()+offset (StartOffset o) = dropC (fromIntegral o)+offset _ = return ()++limit :: Monad m => Maybe Word32 -> ConduitT i i m ()+limit Nothing = mapC id+limit (Just n) = takeC (fromIntegral n)++mbr :: StartFrom -> Maybe BlockRef+mbr (StartBlock h p) = Just (BlockRef h p)+mbr (StartMem t) = Just (MemRef t)+mbr (StartOffset _) = Nothing++dedup :: (Eq i, Monad m) => ConduitT i i m ()+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
src/Network/Haskoin/Store/Data.hs view
@@ -7,6 +7,7 @@ import Conduit import Control.Applicative+import Control.Arrow (first) import Control.Monad import Control.Monad.Trans.Maybe import Data.Aeson as A@@ -16,6 +17,8 @@ import Data.ByteString.Short (ShortByteString) import qualified Data.ByteString.Short as B.Short import Data.Hashable+import Data.HashMap.Strict (HashMap)+import qualified Data.HashMap.Strict as H import Data.Int import qualified Data.IntMap as I import Data.IntMap.Strict (IntMap)@@ -125,6 +128,12 @@ instance BinSerial TxHash where binSerial _ = put +instance BinSerial Address where+ binSerial net a =+ case addrToString net a of+ Nothing -> put B.empty+ Just x -> put $ T.encodeUtf8 x+ class BinSerial a where binSerial :: Network -> Putter a @@ -257,7 +266,7 @@ , balanceTxCount = c , balanceTotalReceived = t } = do- put $ T.encodeUtf8 <$> (addrToString net a)+ binSerial net a putWord64be v putWord64be z putWord64be u@@ -478,12 +487,14 @@ putWord32be $ inputSequence i put $ inputSigScript i put $ inputWitness i- put $- case i of- StoreCoinbase {} -> Nothing- StoreInput {inputPkScript = s} ->- fmap T.encodeUtf8 <$> addrToString net =<<- eitherToMaybe (scriptToAddressBS s)+ let a =+ case i of+ StoreCoinbase {} -> Nothing+ StoreInput {inputPkScript = s} ->+ eitherToMaybe (scriptToAddressBS s)+ case a of+ Nothing -> put B.empty+ Just x -> binSerial net x putWord64be $ case i of StoreCoinbase {} -> 0@@ -812,6 +823,58 @@ put p binSerial net u +data XPubSummary =+ XPubSummary+ { xPubSummaryReceived :: !Word64+ , xPubSummaryConfirmed :: !Word64+ , xPubSummaryZero :: !Word64+ , xPubSummaryPaths :: !(HashMap Address [KeyIndex])+ , xPubSummaryTxs :: ![Transaction]+ }+ deriving (Eq, Show, Generic)++xPubSummaryPairs :: A.KeyValue kv => Network -> XPubSummary -> [kv]+xPubSummaryPairs net XPubSummary { xPubSummaryReceived = r+ , xPubSummaryConfirmed = c+ , xPubSummaryZero = z+ , xPubSummaryPaths = ps+ , xPubSummaryTxs = ts+ } =+ [ "balance" .=+ object ["received" .= r, "confirmed" .= c, "unconfirmed" .= z]+ , "paths" .= object (mapMaybe (uncurry f) (H.toList ps))+ , "txs" .= map (transactionToJSON net) ts+ ]+ where+ f a p = (.= p) <$> addrToString net a++xPubSummaryToJSON :: Network -> XPubSummary -> Value+xPubSummaryToJSON net = object . xPubSummaryPairs net++xPubSummaryToEncoding :: Network -> XPubSummary -> Encoding+xPubSummaryToEncoding net = pairs . mconcat . xPubSummaryPairs net++instance JsonSerial XPubSummary where+ jsonSerial = xPubSummaryToEncoding+ jsonValue = xPubSummaryToJSON++instance BinSerial XPubSummary where+ binSerial net XPubSummary { xPubSummaryReceived = r+ , xPubSummaryConfirmed = c+ , xPubSummaryZero = z+ , xPubSummaryPaths = ps+ , xPubSummaryTxs = ts+ } = do+ put r+ put c+ put z+ putWord64be (fromIntegral $ H.size ps)+ forM_ (H.toList ps) $ \(a, p) -> do+ binSerial net a+ put p+ putWord64be (fromIntegral $ length ts)+ forM_ ts $ binSerial net+ data HealthCheck = HealthCheck { healthHeaderBest :: !(Maybe BlockHash) , healthHeaderHeight :: !(Maybe BlockHeight)@@ -936,3 +999,9 @@ instance BinSerial TxId where binSerial _ (TxId th) = put th++data StartFrom+ = StartBlock !Word32 !Word32+ | StartMem !PreciseUnixTime+ | StartOffset !Word32+ deriving (Show, Eq, Generic)