haskoin-store 0.27.0 → 0.28.0
raw patch · 8 files changed
+328/−409 lines, 8 filesdep ~haskoin-store-data
Dependency ranges changed: haskoin-store-data
Files
- haskoin-store.cabal +5/−5
- src/Haskoin/Store.hs +6/−11
- src/Haskoin/Store/BlockStore.hs +4/−6
- src/Haskoin/Store/Cache.hs +115/−116
- src/Haskoin/Store/Common.hs +68/−57
- src/Haskoin/Store/Database/Memory.hs +10/−81
- src/Haskoin/Store/Database/Reader.hs +49/−35
- src/Haskoin/Store/Web.hs +71/−98
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 05cb5cdade7814a9d00229d0a0ad2fb0c69fbde6a4b8660b01ebd6f5be7eed36+-- hash: 697b02b2afcb3a3cf353fa248771abc9f0fb2e0d6fb0825e3fa37bced3622695 name: haskoin-store-version: 0.27.0+version: 0.28.0 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Store and index Bitcoin or Bitcoin Cash blocks, transactions, balances and unspent outputs. All data is available via REST API in JSON or binary format.@@ -57,7 +57,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.3 , haskoin-node >=0.13.0- , haskoin-store-data ==0.27.0+ , haskoin-store-data ==0.28.0 , hedis >=0.12.13 , http-types >=0.12.3 , monad-logger >=0.3.32@@ -99,7 +99,7 @@ , haskoin-core >=0.13.3 , haskoin-node >=0.13.0 , haskoin-store- , haskoin-store-data ==0.27.0+ , haskoin-store-data ==0.28.0 , monad-logger >=0.3.32 , mtl >=2.2.2 , nqe >=0.6.1@@ -149,7 +149,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.3 , haskoin-node >=0.13.0- , haskoin-store-data ==0.27.0+ , haskoin-store-data ==0.28.0 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store.hs view
@@ -3,32 +3,27 @@ , StoreConfig(..) , StoreEvent(..) , withStore- , module Haskoin.Store.BlockStore , module Haskoin.Store.Web , module Haskoin.Store.Database.Reader , module Haskoin.Store.Data- -- * Cache- , CacheConfig (..)+ , CacheConfig(..) , CacheT- , CacheError (..)+ , CacheError(..) , withCache , connectRedis , isInCache , evictFromCache- -- * Store Reader- , StoreRead (..)- , Limit- , Offset-+ , StoreRead(..)+ , Limits(..)+ , Start(..) -- * Useful Fuctions , getTransaction , blockAtOrBefore- -- * Other Data- , PubExcept (..)+ , PubExcept(..) ) where import Haskoin.Store.BlockStore
src/Haskoin/Store/BlockStore.hs view
@@ -190,12 +190,10 @@ getUnspent = runRocksDB . getUnspent getBalance = runRocksDB . getBalance getMempool = runRocksDB getMempool- getAddressesTxs addrs start limit =- runRocksDB (getAddressesTxs addrs start limit)- getAddressesUnspents addrs start limit =- runRocksDB (getAddressesUnspents addrs start limit)- getAddressUnspents a s = runRocksDB . getAddressUnspents a s- getAddressTxs a s = runRocksDB . getAddressTxs a s+ getAddressesTxs as = runRocksDB . getAddressesTxs as+ getAddressesUnspents as = runRocksDB . getAddressesUnspents as+ getAddressUnspents a = runRocksDB . getAddressUnspents a+ getAddressTxs a = runRocksDB . getAddressTxs a -- | Run block store process. blockStore ::
src/Haskoin/Store/Cache.hs view
@@ -35,6 +35,7 @@ import Data.Bits (shift, (.&.), (.|.)) import Data.ByteString (ByteString) import qualified Data.ByteString.Short as BSS+import Data.Default (def) import Data.Either (lefts, rights) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap@@ -69,9 +70,10 @@ xPubWitnessAddr) import Haskoin.Node (Chain, chainBlockMain, chainGetAncestor, chainGetBlock)-import Haskoin.Store.Common (Limit, Offset, StoreRead (..),- sortTxs, xPubBals, xPubBalsTxs,- xPubBalsUnspents, xPubTxs)+import Haskoin.Store.Common (Limits (..), Start (..),+ StoreRead (..), sortTxs, xPubBals,+ xPubBalsTxs, xPubBalsUnspents,+ xPubTxs) import Haskoin.Store.Data (Balance (..), BlockData (..), BlockRef (..), BlockTx (..), DeriveType (..), Prev (..),@@ -131,24 +133,24 @@ getSpender = lift . getSpender getBalance = lift . getBalance getBalances = lift . getBalances- getAddressesTxs addrs start = lift . getAddressesTxs addrs start- getAddressTxs addr start = lift . getAddressTxs addr start+ getAddressesTxs addrs = lift . getAddressesTxs addrs+ getAddressTxs addr = lift . getAddressTxs addr getUnspent = lift . getUnspent- getAddressUnspents addr start = lift . getAddressUnspents addr start- getAddressesUnspents addrs start = lift . getAddressesUnspents addrs start+ getAddressUnspents addr = lift . getAddressUnspents addr+ getAddressesUnspents addrs = lift . getAddressesUnspents addrs getMempool = lift getMempool xPubBals xpub = ask >>= \case Nothing -> lift (xPubBals xpub) Just cfg -> lift (runReaderT (getXPubBalances xpub) cfg)- xPubUnspents xpub start offset limit =+ xPubUnspents xpub limits = ask >>= \case- Nothing -> lift (xPubUnspents xpub start offset limit)- Just cfg -> lift (runReaderT (getXPubUnspents xpub start offset limit) cfg)- xPubTxs xpub start offset limit =+ Nothing -> lift (xPubUnspents xpub limits)+ Just cfg -> lift (runReaderT (getXPubUnspents xpub limits) cfg)+ xPubTxs xpub limits = ask >>= \case- Nothing -> lift (xPubTxs xpub start offset limit)- Just cfg -> lift (runReaderT (getXPubTxs xpub start offset limit) cfg)+ Nothing -> lift (xPubTxs xpub limits)+ Just cfg -> lift (runReaderT (getXPubTxs xpub limits) cfg) getMaxGap = lift getMaxGap getInitialGap = lift getInitialGap @@ -167,16 +169,14 @@ getXPubTxs :: (MonadUnliftIO m, MonadLoggerIO m, StoreRead m) => XPubSpec- -> Maybe BlockRef- -> Offset- -> Maybe Limit+ -> Limits -> CacheX m [BlockTx]-getXPubTxs xpub start offset limit = do+getXPubTxs xpub limits = do xpubtxt <- xpubText xpub $(logDebugS) "Cache" $ "Getting xpub txs for " <> xpubtxt isXPubCached xpub >>= \case True -> do- txs <- cacheGetXPubTxs xpub start offset limit+ txs <- cacheGetXPubTxs xpub limits $(logDebugS) "Cache" $ "Returning " <> cs (show (length txs)) <> " transactions for cached xpub: " <>@@ -189,20 +189,18 @@ then do $(logDebugS) "Cache" $ "Successfully cached xpub " <> xpubtxt- cacheGetXPubTxs xpub start offset limit+ cacheGetXPubTxs xpub limits else do $(logDebugS) "Cache" $ "Using DB to return txs for xpub " <> xpubtxt- lift $ xPubBalsTxs bals start offset limit+ lift $ xPubBalsTxs bals limits getXPubUnspents :: (MonadUnliftIO m, MonadLoggerIO m, StoreRead m) => XPubSpec- -> Maybe BlockRef- -> Offset- -> Maybe Limit+ -> Limits -> CacheX m [XPubUnspent]-getXPubUnspents xpub start offset limit = do+getXPubUnspents xpub limits = do xpubtxt <- xpubText xpub $(logDebugS) "Cache" $ "Getting utxo for xpub " <> xpubtxt isXPubCached xpub >>= \case@@ -219,10 +217,10 @@ else do $(logDebugS) "Cache" $ "Using DB to return utxo for xpub " <> xpubtxt- lift $ xPubBalsUnspents bals start offset limit+ lift $ xPubBalsUnspents bals limits where process bals = do- ops <- map snd <$> cacheGetXPubUnspents xpub start offset limit+ ops <- map snd <$> cacheGetXPubUnspents xpub limits uns <- catMaybes <$> lift (mapM getUnspent ops) let addrmap = Map.fromList $@@ -284,28 +282,60 @@ return bals cacheGetXPubTxs ::- MonadLoggerIO m+ (StoreRead m, MonadLoggerIO m) => XPubSpec- -> Maybe BlockRef- -> Offset- -> Maybe Limit+ -> Limits -> CacheX m [BlockTx]-cacheGetXPubTxs xpub start offset limit = do- txs <- runRedis $ redisGetXPubTxs xpub start offset limit+cacheGetXPubTxs xpub limits = do+ score <-+ case start limits of+ Nothing -> return Nothing+ Just (AtTx th) ->+ lift (getTxData th) >>= \case+ Just TxData {txDataBlock = b@BlockRef {}} ->+ return (Just (blockRefScore b))+ _ -> return Nothing+ Just (AtBlock h) ->+ return (Just (blockRefScore (BlockRef h maxBound)))+ xs <-+ runRedis $+ getFromSortedSet+ (txSetPfx <> encode xpub)+ score+ (offset limits)+ (limit limits) touchKeys [xpub]- return txs+ return $ map (uncurry f) xs+ where+ f t s = BlockTx {blockTxHash = t, blockTxBlock = scoreBlockRef s} cacheGetXPubUnspents ::- MonadLoggerIO m+ (StoreRead m, MonadLoggerIO m) => XPubSpec- -> Maybe BlockRef- -> Offset- -> Maybe Limit+ -> Limits -> CacheX m [(BlockRef, OutPoint)]-cacheGetXPubUnspents xpub start offset limit = do- uns <- runRedis $ redisGetXPubUnspents xpub start offset limit+cacheGetXPubUnspents xpub limits = do+ score <-+ case start limits of+ Nothing -> return Nothing+ Just (AtTx th) ->+ lift (getTxData th) >>= \case+ Just TxData {txDataBlock = b@BlockRef {}} ->+ return (Just (blockRefScore b))+ _ -> return Nothing+ Just (AtBlock h) ->+ return (Just (blockRefScore (BlockRef h maxBound)))+ xs <-+ runRedis $+ getFromSortedSet+ (utxoPfx <> encode xpub)+ score+ (offset limits)+ (limit limits) touchKeys [xpub]- return uns+ return $ map (uncurry f) xs+ where+ f o s = (scoreBlockRef s, o) redisGetXPubBalances :: (Functor f, RedisCtx m f) => XPubSpec -> m (f [XPubBal]) redisGetXPubBalances xpub =@@ -314,42 +344,6 @@ where f p b = XPubBal {xPubBalPath = p, xPubBal = b} -redisGetXPubTxs ::- (Applicative f, RedisCtx m f)- => XPubSpec- -> Maybe BlockRef- -> Offset- -> Maybe Limit- -> m (f [BlockTx])-redisGetXPubTxs xpub start offset limit = do- xs <-- getFromSortedSet- (txSetPfx <> encode xpub)- (blockRefScore <$> start)- (fromIntegral offset)- (fromIntegral <$> limit)- return $ map (uncurry f) <$> xs- where- f t s = BlockTx {blockTxHash = t, blockTxBlock = scoreBlockRef s}--redisGetXPubUnspents ::- (Applicative f, RedisCtx m f)- => XPubSpec- -> Maybe BlockRef- -> Offset- -> Maybe Limit- -> m (f [(BlockRef, OutPoint)])-redisGetXPubUnspents xpub start offset limit = do- xs <-- getFromSortedSet- (utxoPfx <> encode xpub)- (blockRefScore <$> start)- (fromIntegral offset)- (fromIntegral <$> limit)- return $ map (uncurry f) <$> xs- where- f o s = (scoreBlockRef s, o)- blockRefScore :: BlockRef -> Double blockRefScore BlockRef {blockRefHeight = h, blockRefPos = p} = fromIntegral (0x001fffffffffffff - (h' .|. p'))@@ -374,40 +368,36 @@ (Applicative f, RedisCtx m f, Serialize a) => ByteString -> Maybe Double- -> Integer- -> Maybe Integer+ -> Word32+ -> Word32 -> m (f [(a, Double)])-getFromSortedSet key Nothing offset Nothing = do- xs <- zrangeWithscores key offset (-1)+getFromSortedSet key Nothing off 0 = do+ xs <- zrangeWithscores key (fromIntegral off) (-1) return $ do ys <- map (\(x, s) -> (, s) <$> decode x) <$> xs return (rights ys)-getFromSortedSet key Nothing offset (Just count)- | count <= 0 = return (pure [])- | otherwise = do- xs <- zrangeWithscores key offset (offset + count - 1)- return $ do- ys <- map (\(x, s) -> (, s) <$> decode x) <$> xs- return (rights ys)-getFromSortedSet key (Just score) offset Nothing = do+getFromSortedSet key Nothing off count = do xs <-- zrangebyscoreWithscoresLimit+ zrangeWithscores key- score- (2 ^ (53 :: Integer) - 1)- offset- (-1)+ (fromIntegral off)+ (fromIntegral off + fromIntegral count - 1) return $ do ys <- map (\(x, s) -> (, s) <$> decode x) <$> xs return (rights ys)-getFromSortedSet key (Just score) offset (Just count) = do+getFromSortedSet key (Just score) off 0 = do+ xs <- zrangebyscoreWithscoresLimit key score (1 / 0) (fromIntegral off) (-1)+ return $ do+ ys <- map (\(x, s) -> (, s) <$> decode x) <$> xs+ return (rights ys)+getFromSortedSet key (Just score) off count = do xs <- zrangebyscoreWithscoresLimit key score- (2 ^ (53 :: Integer) - 1)- offset- count+ (1 / 0)+ (fromIntegral off)+ (fromIntegral count) return $ do ys <- map (\(x, s) -> (, s) <$> decode x) <$> xs return (rights ys)@@ -579,9 +569,9 @@ withLockWait lockKey $ do ks <- fmap (map fst) . runRedis $- getFromSortedSet maxKey Nothing 0 (Just x)+ getFromSortedSet maxKey Nothing 0 (fromIntegral x) $(logDebugS) "Cache" $- "Pruning " <> cs (show (length ks)) <> " old xpubs"+ "Pruning " <> cs (show (length ks)) <> " old xpubs…" delXPubKeys ks touchKeys :: MonadLoggerIO m => [XPubSpec] -> CacheX m ()@@ -605,9 +595,9 @@ Nothing -> lift (getTxData th) >>= \case Just td -> do- $(logDebugS) "Cache" $- "Updating cache with tx: " <> txHashToHex th importMultiTxC [td]+ $(logDebugS) "Cache" $+ "Updated cache with tx: " <> txHashToHex th Nothing -> $(logErrorS) "Cache" $ "Tx not found in db: " <> txHashToHex th@@ -647,21 +637,26 @@ cs (show (lenNotNull bals)) <> "): " <> xpubtxt- utxo <- lift $ xPubUnspents xpub Nothing 0 Nothing+ utxo <- lift $ xPubUnspents xpub def $(logDebugS) "Cache" $ "Caching xpub with " <> cs (show (length utxo)) <> " utxos: " <> xpubtxt- xtxs <- lift $ xPubTxs xpub Nothing 0 Nothing+ xtxs <- lift $ xPubTxs xpub def $(logDebugS) "Cache" $ "Caching xpub with " <> cs (show (length xtxs)) <> " txs: " <> xpubtxt now <- systemSeconds <$> liftIO getSystemTime- withLockWait lockKey . runRedis $ do- b <- redisTouchKeys now [xpub]- c <- redisAddXPubBalances xpub bals- d <- redisAddXPubUnspents xpub (map op utxo)- e <- redisAddXPubTxs xpub xtxs- return $ b >> c >> d >> e >> return ()+ withLockWait lockKey $ do+ $(logDebugS) "Cache" $+ "Running Redis pipeline to cache xpub: " <> xpubtxt <> "…"+ runRedis $ do+ b <- redisTouchKeys now [xpub]+ c <- redisAddXPubBalances xpub bals+ d <- redisAddXPubUnspents xpub (map op utxo)+ e <- redisAddXPubTxs xpub xtxs+ return $ b >> c >> d >> e >> return ()+ $(logDebugS) "Cache" $+ "Done caching xpub: " <> xpubtxt newBlockC :: (MonadUnliftIO m, MonadLoggerIO m, StoreRead m) => CacheX m () newBlockC = withLockWait importLockKey f@@ -962,10 +957,10 @@ let f us = ( addressXPubSpec i , map (\u -> (unspentPoint u, unspentBlock u)) us)- in f <$> lift (getAddressUnspents a Nothing Nothing)+ in f <$> lift (getAddressUnspents a def) gettxmap a i = let f ts = (addressXPubSpec i, ts)- in f <$> lift (getAddressTxs a Nothing Nothing)+ in f <$> lift (getAddressTxs a def) getNewAddrs ::@@ -1024,10 +1019,14 @@ return Nothing Just newhead -> do mem <- lift getMempool- withLockWait lockKey . runRedis $ do- a <- redisAddToMempool mem- b <- redisSetHead newhead- return $ a >> b >> return (Just newhead)+ withLockWait lockKey $ do+ $(logDebugS) "Cache" "Priming cache…"+ x <- runRedis $ do+ a <- redisAddToMempool mem+ b <- redisSetHead newhead+ return $ a >> b >> return (Just newhead)+ $(logDebugS) "Cache" "Primed"+ return x Just cachehead -> return $ Just cachehead cacheSetHead :: (MonadLoggerIO m, StoreRead m) => BlockHash -> CacheX m ()@@ -1210,7 +1209,7 @@ redisGetMempool :: (Applicative f, RedisCtx m f) => m (f [BlockTx]) redisGetMempool = do- xs <- getFromSortedSet mempoolSetKey Nothing 0 Nothing+ xs <- getFromSortedSet mempoolSetKey Nothing 0 0 return $ do ys <- xs return $ map (uncurry f) ys
src/Haskoin/Store/Common.hs view
@@ -4,9 +4,10 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} module Haskoin.Store.Common- ( Limit- , Offset+ ( Limits(..)+ , Start(..) , StoreRead(..) , StoreWrite(..) , StoreEvent(..)@@ -15,12 +16,9 @@ , xPubBalsUnspents , getTransaction , blockAtOrBefore- , applyOffset- , applyLimit- , applyOffsetLimit- , applyOffsetC- , applyLimitC- , applyOffsetLimitC+ , deOffset+ , applyLimits+ , applyLimitsC , sortTxs , nub' ) where@@ -32,6 +30,7 @@ import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Data.ByteString (ByteString)+import Data.Default (Default (..)) import Data.Function (on) import Data.Hashable (Hashable) import qualified Data.HashSet as H@@ -52,13 +51,12 @@ txHash) import Haskoin.Node (Peer) import Haskoin.Store.Data (Balance (..), BlockData (..),- BlockRef, BlockTx (..),- DeriveType (..), Spender,- Transaction, TxData, UnixTime,- Unspent, XPubBal (..),- XPubSpec (..), XPubSummary (..),- XPubUnspent (..), nullBalance,- toTransaction)+ BlockTx (..), DeriveType (..),+ Spender, Transaction, TxData,+ UnixTime, Unspent (..),+ XPubBal (..), XPubSpec (..),+ XPubSummary (..), XPubUnspent (..),+ nullBalance, toTransaction) import Network.Socket (SockAddr) type DeriveAddr = XPubKey -> KeyIndex -> Address@@ -66,6 +64,27 @@ type Offset = Word32 type Limit = Word32 +data Start+ = AtTx+ { atTxHash :: !TxHash+ }+ | AtBlock+ { atBlockHeight :: !BlockHeight+ } deriving (Eq, Show)++data Limits =+ Limits+ { limit :: !Word32+ , offset :: !Word32+ , start :: !(Maybe Start)+ } deriving (Eq, Show)++defaultLimits :: Limits+defaultLimits = Limits { limit = 0, offset = 0, start = Nothing }++instance Default Limits where+ def = defaultLimits+ class Monad m => StoreRead m where@@ -80,15 +99,13 @@ getBalance a = head <$> getBalances [a] getBalances :: [Address] -> m [Balance] getBalances as = mapM getBalance as- getAddressesTxs :: [Address] -> Maybe BlockRef -> Maybe Limit -> m [BlockTx]- getAddressTxs :: Address -> Maybe BlockRef -> Maybe Limit -> m [BlockTx]+ getAddressesTxs :: [Address] -> Limits -> m [BlockTx]+ getAddressTxs :: Address -> Limits -> m [BlockTx] getAddressTxs a = getAddressesTxs [a] getUnspent :: OutPoint -> m (Maybe Unspent)- getAddressUnspents ::- Address -> Maybe BlockRef -> Maybe Limit -> m [Unspent]+ getAddressUnspents :: Address -> Limits -> m [Unspent] getAddressUnspents a = getAddressesUnspents [a]- getAddressesUnspents ::- [Address] -> Maybe BlockRef -> Maybe Limit -> m [Unspent]+ getAddressesUnspents :: [Address] -> Limits -> m [Unspent] getMempool :: m [BlockTx] xPubBals :: XPubSpec -> m [XPubBal] xPubBals xpub = do@@ -143,34 +160,29 @@ , xPubChangeIndex = ch , xPubExternalIndex = ex }- xPubUnspents ::- XPubSpec- -> Maybe BlockRef- -> Offset- -> Maybe Limit- -> m [XPubUnspent]- xPubUnspents xpub start offset limit = do+ xPubUnspents :: XPubSpec -> Limits -> m [XPubUnspent]+ xPubUnspents xpub limits = do xs <- filter positive <$> xPubBals xpub- applyOffsetLimit offset limit <$> go xs+ sortBy (compare `on` unsblock) . applyLimits limits <$> go xs where+ unsblock = unspentBlock . xPubUnspent positive XPubBal {xPubBal = Balance {balanceUnspentCount = c}} = c > 0 go [] = return [] go (XPubBal {xPubBalPath = p, xPubBal = Balance {balanceAddress = a}}:xs) = do- uns <- getAddressUnspents a start limit+ uns <- getAddressUnspents a (deOffset limits) let xuns = map (\t -> XPubUnspent {xPubUnspentPath = p, xPubUnspent = t}) uns (xuns <>) <$> go xs- xPubTxs ::- XPubSpec -> Maybe BlockRef -> Offset -> Maybe Limit -> m [BlockTx]- xPubTxs xpub start offset limit = do+ xPubTxs :: XPubSpec -> Limits -> m [BlockTx]+ xPubTxs xpub limits = do bs <- xPubBals xpub let as = map (balanceAddress . xPubBal) bs- ts <- concat <$> mapM (\a -> getAddressTxs a start limit) as+ ts <- concat <$> mapM (\a -> getAddressTxs a (deOffset limits)) as let ts' = sortBy (flip compare `on` blockTxBlock) (nub' ts)- return $ applyOffsetLimit offset limit ts'+ return $ applyLimits limits ts' getMaxGap :: m Word32 getInitialGap :: m Word32 @@ -201,18 +213,16 @@ xPubBalsUnspents :: StoreRead m => [XPubBal]- -> Maybe BlockRef- -> Offset- -> Maybe Limit+ -> Limits -> m [XPubUnspent]-xPubBalsUnspents bals start offset limit = do+xPubBalsUnspents bals limits = do let xs = filter positive bals- applyOffsetLimit offset limit <$> go xs+ applyLimits limits <$> go xs where positive XPubBal {xPubBal = Balance {balanceUnspentCount = c}} = c > 0 go [] = return [] go (XPubBal {xPubBalPath = p, xPubBal = Balance {balanceAddress = a}}:xs) = do- uns <- getAddressUnspents a start limit+ uns <- getAddressUnspents a (deOffset limits) let xuns = map (\t -> XPubUnspent {xPubUnspentPath = p, xPubUnspent = t})@@ -222,15 +232,13 @@ xPubBalsTxs :: StoreRead m => [XPubBal]- -> Maybe BlockRef- -> Offset- -> Maybe Limit+ -> Limits -> m [BlockTx]-xPubBalsTxs bals start offset limit = do+xPubBalsTxs bals limits = do let as = map balanceAddress . filter (not . nullBalance) $ map xPubBal bals- ts <- concat <$> mapM (\a -> getAddressTxs a start limit) as+ ts <- concat <$> mapM (\a -> getAddressTxs a (deOffset limits)) as let ts' = sortBy (flip compare `on` blockTxBlock) (nub' ts)- return $ applyOffsetLimit offset limit ts'+ return $ applyLimits limits ts' getTransaction :: (Monad m, StoreRead m) => TxHash -> m (Maybe Transaction)@@ -304,25 +312,28 @@ instance Exception PubExcept -applyOffsetLimit :: Offset -> Maybe Limit -> [a] -> [a]-applyOffsetLimit offset limit = applyLimit limit . applyOffset offset+applyLimits :: Limits -> [a] -> [a]+applyLimits Limits {..} = applyLimit limit . applyOffset offset applyOffset :: Offset -> [a] -> [a] applyOffset = drop . fromIntegral -applyLimit :: Maybe Limit -> [a] -> [a]-applyLimit Nothing = id-applyLimit (Just l) = take (fromIntegral l)+applyLimit :: Limit -> [a] -> [a]+applyLimit 0 = id+applyLimit l = take (fromIntegral l) -applyOffsetLimitC :: Monad m => Offset -> Maybe Limit -> ConduitT i i m ()-applyOffsetLimitC offset limit = applyOffsetC offset >> applyLimitC limit+deOffset :: Limits -> Limits+deOffset l = l { limit = limit l + offset l, offset = 0} +applyLimitsC :: Monad m => Limits -> ConduitT i i m ()+applyLimitsC Limits {..} = applyOffsetC offset >> applyLimitC limit+ applyOffsetC :: Monad m => Offset -> ConduitT i i m () applyOffsetC = dropC . fromIntegral -applyLimitC :: Monad m => Maybe Limit -> ConduitT i i m ()-applyLimitC Nothing = mapC id-applyLimitC (Just l) = takeC (fromIntegral l)+applyLimitC :: Monad m => Limit -> ConduitT i i m ()+applyLimitC 0 = mapC id+applyLimitC l = takeC (fromIntegral l) sortTxs :: [Tx] -> [(Word32, Tx)] sortTxs txs = go [] thset $ zip [0 ..] txs
src/Haskoin/Store/Database/Memory.hs view
@@ -14,26 +14,20 @@ import Control.Monad.Reader (ReaderT) import qualified Control.Monad.Reader as R import qualified Data.ByteString.Short as B.Short-import Data.Function (on) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as M import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as I-import Data.List (sortBy)-import Data.Maybe (catMaybes, fromJust, fromMaybe,- isJust)+import Data.Maybe (fromJust, fromMaybe, isJust) import Data.Word (Word32) import Haskoin (Address, BlockHash, BlockHeight, Network, OutPoint (..), TxHash,- eitherToMaybe, headerHash,- scriptToAddressBS, txHash)-import Haskoin.Store.Common (Limit, StoreRead (..),- StoreWrite (..), applyLimit,- nub')+ headerHash, txHash)+import Haskoin.Store.Common (StoreRead (..), StoreWrite (..)) import Haskoin.Store.Data (Balance (..), BlockData (..),- BlockRef, BlockTx (..), Spender,- TxData (..), Unspent (..),- zeroBalance)+ BlockRef (..), BlockTx (..),+ Spender, TxData (..),+ Unspent (..), zeroBalance) import Haskoin.Store.Database.Types (BalVal, OutVal (..), UnspentVal, balanceToVal, unspentToVal, valToBalance, valToUnspent)@@ -110,63 +104,6 @@ getMempoolH :: MemoryDatabase -> Maybe [BlockTx] getMempoolH = hMempool -getAddressesTxsH ::- [Address] -> Maybe BlockRef -> Maybe Limit -> MemoryDatabase -> [BlockTx]-getAddressesTxsH addrs start limit db = applyLimit limit xs- where- xs =- sortBy (flip compare `on` blockTxBlock) . nub' . concat $- map (\a -> getAddressTxsH a start limit db) addrs--getAddressTxsH ::- Address -> Maybe BlockRef -> Maybe Limit -> MemoryDatabase -> [BlockTx]-getAddressTxsH addr start limit db =- applyLimit limit .- dropWhile h .- sortBy (flip compare) . catMaybes . concatMap (uncurry f) . M.toList $- M.lookupDefault M.empty addr (hAddrTx db)- where- f b hm = map (uncurry (g b)) $ M.toList hm- g b h' True = Just BlockTx {blockTxBlock = b, blockTxHash = h'}- g _ _ False = Nothing- h BlockTx {blockTxBlock = b} =- case start of- Nothing -> False- Just br -> b > br--getAddressesUnspentsH ::- [Address] -> Maybe BlockRef -> Maybe Limit -> MemoryDatabase -> [Unspent]-getAddressesUnspentsH addrs start limit db = applyLimit limit xs- where- xs =- sortBy (flip compare `on` unspentBlock) . nub' . concat $- map (\a -> getAddressUnspentsH a start limit db) addrs--getAddressUnspentsH ::- Address -> Maybe BlockRef -> Maybe Limit -> MemoryDatabase -> [Unspent]-getAddressUnspentsH addr start limit db =- applyLimit limit .- dropWhile h .- sortBy (flip compare) . catMaybes . concatMap (uncurry f) . M.toList $- M.lookupDefault M.empty addr (hAddrOut db)- where- f b hm = map (uncurry (g b)) $ M.toList hm- g b p (Just u) =- Just- Unspent- { unspentBlock = b- , unspentAmount = outValAmount u- , unspentScript = B.Short.toShort (outValScript u)- , unspentPoint = p- , unspentAddress =- eitherToMaybe (scriptToAddressBS (outValScript u))- }- g _ _ Nothing = Nothing- h Unspent {unspentBlock = b} =- case start of- Nothing -> False- Just br -> b > br- setBestH :: BlockHash -> MemoryDatabase -> MemoryDatabase setBestH h db = db {hBest = Just h} @@ -313,18 +250,10 @@ getMempool = do v <- R.asks memoryDatabase >>= readTVarIO return . fromMaybe [] $ getMempoolH v- getAddressesTxs addr start limit = do- v <- R.asks memoryDatabase >>= readTVarIO- return $ getAddressesTxsH addr start limit v- getAddressesUnspents addr start limit = do- v <- R.asks memoryDatabase >>= readTVarIO- return $ getAddressesUnspentsH addr start limit v- getAddressTxs addr start limit = do- v <- R.asks memoryDatabase >>= readTVarIO- return $ getAddressTxsH addr start limit v- getAddressUnspents addr start limit = do- v <- R.asks memoryDatabase >>= readTVarIO- return $ getAddressUnspentsH addr start limit v+ getAddressesTxs = undefined+ getAddressesUnspents = undefined+ getAddressTxs = undefined+ getAddressUnspents = undefined getMaxGap = R.asks memoryMaxGap getInitialGap = R.asks memoryInitialGap getNetwork = R.asks memoryNetwork
src/Haskoin/Store/Database/Reader.hs view
@@ -26,12 +26,13 @@ matchingSkip, retrieve) import Haskoin (Address, BlockHash, BlockHeight, Network, OutPoint (..), TxHash)-import Haskoin.Store.Common (Limit, StoreRead (..),- applyLimit, applyLimitC, nub')+import Haskoin.Store.Common (Limits (..), Start (..),+ StoreRead (..), applyLimits,+ applyLimitsC, deOffset, nub') import Haskoin.Store.Data (Balance, BlockData, BlockRef (..), BlockTx (..),- Spender, TxData, Unspent (..),- zeroBalance)+ Spender, TxData (..),+ Unspent (..), zeroBalance) import Haskoin.Store.Database.Types (AddrOutKey (..), AddrTxKey (..), BalKey (..), BestKey (..), BlockKey (..), HeightKey (..),@@ -153,30 +154,36 @@ getAddressesTxsDB :: MonadIO m => [Address]- -> Maybe BlockRef- -> Maybe Limit+ -> Limits -> DatabaseReader -> m [BlockTx]-getAddressesTxsDB addrs start limit db = do- ts <- concat <$> mapM (\a -> getAddressTxsDB a start limit db) addrs+getAddressesTxsDB addrs limits db = do+ ts <- concat <$> mapM (\a -> getAddressTxsDB a (deOffset limits) db) addrs let ts' = sortBy (flip compare `on` blockTxBlock) (nub' ts)- return $ applyLimit limit ts'+ return $ applyLimits limits ts' getAddressTxsDB :: MonadIO m => Address- -> Maybe BlockRef- -> Maybe Limit+ -> Limits -> DatabaseReader -> m [BlockTx]-getAddressTxsDB a start limit DatabaseReader {databaseReadOptions = opts, databaseHandle = db} =+getAddressTxsDB a limits bdb@DatabaseReader { databaseReadOptions = opts+ , databaseHandle = db+ } = liftIO . runResourceT . runConduit $- x .| applyLimitC limit .| mapC (uncurry f) .| sinkList+ x .| applyLimitsC limits .| mapC (uncurry f) .| sinkList where x =- case start of+ case start limits of Nothing -> matching db opts (AddrTxKeyA a)- Just br -> matchingSkip db opts (AddrTxKeyA a) (AddrTxKeyB a br)+ Just (AtTx txh) ->+ getTxDataDB txh bdb >>= \case+ Just TxData {txDataBlock = b@BlockRef {}} ->+ matchingSkip db opts (AddrTxKeyA a) (AddrTxKeyB a b)+ _ -> matching db opts (AddrTxKeyA a)+ Just (AtBlock bh) ->+ matching db opts (AddrTxKeyB a (BlockRef bh maxBound)) f AddrTxKey {addrTxKeyT = t} () = t f _ _ = undefined @@ -189,32 +196,42 @@ getAddressesUnspentsDB :: MonadIO m => [Address]- -> Maybe BlockRef- -> Maybe Limit+ -> Limits -> DatabaseReader -> m [Unspent]-getAddressesUnspentsDB addrs start limit bdb = do- us <- concat <$> mapM (\a -> getAddressUnspentsDB a start limit bdb) addrs+getAddressesUnspentsDB addrs limits bdb = do+ us <-+ concat <$>+ mapM (\a -> getAddressUnspentsDB a (deOffset limits) bdb) addrs let us' = sortBy (flip compare `on` unspentBlock) (nub' us)- return $ applyLimit limit us'+ return $ applyLimits limits us' getAddressUnspentsDB :: MonadIO m => Address- -> Maybe BlockRef- -> Maybe Limit+ -> Limits -> DatabaseReader -> m [Unspent]-getAddressUnspentsDB a start limit DatabaseReader { databaseReadOptions = opts- , databaseHandle = db- } =+getAddressUnspentsDB a limits bdb@DatabaseReader { databaseReadOptions = opts+ , databaseHandle = db+ } = liftIO . runResourceT . runConduit $- x .| applyLimitC limit .| mapC (uncurry toUnspent) .| sinkList+ x .| applyLimitsC limits .| mapC (uncurry toUnspent) .| sinkList where x =- case start of+ case start limits of Nothing -> matching db opts (AddrOutKeyA a)- Just br -> matchingSkip db opts (AddrOutKeyA a) (AddrOutKeyB a br)+ Just (AtBlock h) ->+ matchingSkip+ db+ opts+ (AddrOutKeyA a)+ (AddrOutKeyB a (BlockRef h maxBound))+ Just (AtTx txh) ->+ getTxDataDB txh bdb >>= \case+ Just TxData {txDataBlock = b@BlockRef {}} ->+ matchingSkip db opts (AddrOutKeyA a) (AddrOutKeyB a b)+ _ -> matching db opts (AddrOutKeyA a) instance MonadIO m => StoreRead (DatabaseReaderT m) where getNetwork = asks databaseNetwork@@ -227,12 +244,9 @@ getUnspent a = ask >>= getUnspentDB a getBalance a = ask >>= getBalanceDB a getMempool = ask >>= getMempoolDB- getAddressesTxs addrs start limit =- ask >>= getAddressesTxsDB addrs start limit- getAddressesUnspents addrs start limit =- ask >>= getAddressesUnspentsDB addrs start limit- getAddressUnspents a b c = ask >>= getAddressUnspentsDB a b c- getAddressTxs a b c = ask >>= getAddressTxsDB a b c+ getAddressesTxs as limits = ask >>= getAddressesTxsDB as limits+ getAddressesUnspents as limits = ask >>= getAddressesUnspentsDB as limits+ getAddressUnspents a limits = ask >>= getAddressUnspentsDB a limits+ getAddressTxs a limits = ask >>= getAddressTxsDB a limits getMaxGap = asks databaseMaxGap getInitialGap = asks databaseInitialGap-
src/Haskoin/Store/Web.hs view
@@ -13,8 +13,8 @@ import Conduit () import Control.Applicative ((<|>))-import Control.Monad (forever, guard, unless, when,- (<=<))+import Control.Monad (forever, guard, mzero, unless,+ when, (<=<)) import Control.Monad.Logger (MonadLogger, MonadLoggerIO, askLoggerIO, logInfoS, monadLoggerLog)@@ -61,9 +61,9 @@ managerGetPeers, sendMessage) import Haskoin.Store.Cache (CacheT, evictFromCache, withCache)-import Haskoin.Store.Common (Limit, Offset, PubExcept (..),- StoreEvent (..), StoreRead (..),- applyOffset, blockAtOrBefore,+import Haskoin.Store.Common (Limits (..), PubExcept (..),+ Start (..), StoreEvent (..),+ StoreRead (..), blockAtOrBefore, getTransaction, nub') import Haskoin.Store.Data (BlockData (..), BlockRef (..), BlockTx (..), DeriveType (..),@@ -72,9 +72,9 @@ HealthCheck (..), PeerInformation (..), StoreInput (..),- Transaction (..), TxData (..),- TxId (..), UnixTime, Unspent,- XPubBal (..), XPubSpec (..),+ Transaction (..), TxId (..),+ UnixTime, Unspent, XPubBal (..),+ XPubSpec (..), balanceToEncoding, blockDataToEncoding, isCoinbase, nullBalance, transactionData,@@ -211,16 +211,12 @@ getBalance a = runInWebReader (getBalance a) getBalances as = runInWebReader (getBalances as) getMempool = runInWebReader getMempool- getAddressesTxs addrs start limit =- runInWebReader (getAddressesTxs addrs start limit)- getAddressesUnspents addrs start limit =- runInWebReader (getAddressesUnspents addrs start limit)- xPubBals xpub = runInWebReader (xPubBals xpub)- xPubSummary xpub = runInWebReader (xPubSummary xpub)- xPubUnspents xpub start offset limit =- runInWebReader (xPubUnspents xpub start offset limit)- xPubTxs xpub start offset limit =- runInWebReader (xPubTxs xpub start offset limit)+ getAddressesTxs as = runInWebReader . getAddressesTxs as+ getAddressesUnspents as = runInWebReader . getAddressesUnspents as+ xPubBals = runInWebReader . xPubBals+ xPubSummary = runInWebReader . xPubSummary+ xPubUnspents xpub = runInWebReader . xPubUnspents xpub+ xPubTxs xpub = runInWebReader . xPubTxs xpub instance (MonadUnliftIO m, MonadLoggerIO m) => StoreRead (WebT m) where getNetwork = lift getNetwork@@ -234,16 +230,14 @@ getBalance = lift . getBalance getBalances = lift . getBalances getMempool = lift getMempool- getAddressesTxs addrs start limit = lift (getAddressesTxs addrs start limit)- getAddressesUnspents addrs start limit =- lift (getAddressesUnspents addrs start limit)+ getAddressesTxs as = lift . getAddressesTxs as+ getAddressesUnspents as = lift . getAddressesUnspents as xPubBals = lift . xPubBals xPubSummary = lift . xPubSummary- xPubUnspents xpub start offset limit =- lift (xPubUnspents xpub start offset limit)- xPubTxs xpub start offset limit = lift (xPubTxs xpub start offset limit)- getMaxGap = lift $ asks (maxLimitGap . webMaxLimits)- getInitialGap = lift $ asks (maxLimitInitialGap . webMaxLimits)+ xPubUnspents xpub = lift . xPubUnspents xpub+ xPubTxs xpub = lift . xPubTxs xpub+ getMaxGap = lift getMaxGap+ getInitialGap = lift getInitialGap defHandler :: Monad m => Except -> WebT m () defHandler e = do@@ -501,51 +495,43 @@ scottyAddressTxs full = do setHeaders a <- parseAddress- s <- getStart- o <- getOffset- l <- getLimit full+ l <- getLimits full proto <- setupBin if full then do- getAddressTxsFull o l s a >>=+ getAddressTxsFull l a >>= protoSerialNet proto (list . transactionToEncoding) else do- getAddressTxsLimit o l s a >>= protoSerial proto+ getAddressTxsLimit l a >>= protoSerial proto scottyAddressesTxs :: (MonadUnliftIO m, MonadLoggerIO m) => Bool -> WebT m () scottyAddressesTxs full = do setHeaders as <- parseAddresses- s <- getStart- o <- getOffset- l <- getLimit full+ l <- getLimits full proto <- setupBin if full- then getAddressesTxsFull o l s as >>=+ then getAddressesTxsFull l as >>= protoSerialNet proto (list . transactionToEncoding)- else getAddressesTxsLimit o l s as >>= protoSerial proto+ else getAddressesTxsLimit l as >>= protoSerial proto scottyAddressUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyAddressUnspent = do setHeaders a <- parseAddress- s <- getStart- o <- getOffset- l <- getLimit False+ l <- getLimits False proto <- setupBin- uns <- getAddressUnspentsLimit o l s a+ uns <- getAddressUnspentsLimit l a protoSerialNet proto (list . unspentToEncoding) uns scottyAddressesUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m () scottyAddressesUnspent = do setHeaders as <- parseAddresses- s <- getStart- o <- getOffset- l <- getLimit False+ l <- getLimits False proto <- setupBin- uns <- getAddressesUnspentsLimit o l s as+ uns <- getAddressesUnspentsLimit l as protoSerialNet proto (list . unspentToEncoding) uns scottyAddressBalance :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()@@ -580,11 +566,9 @@ setHeaders nocache <- parseNoCache xpub <- parseXpub- start <- getStart- limit <- getLimit full- o <- getOffset+ l <- getLimits full proto <- setupBin- txs <- lift . runNoCache nocache $ xPubTxs xpub start o limit+ txs <- lift . runNoCache nocache $ xPubTxs xpub l if full then do txs' <-@@ -609,10 +593,8 @@ nocache <- parseNoCache xpub <- parseXpub proto <- setupBin- start <- getStart- o <- getOffset- limit <- getLimit False- uns <- lift . runNoCache nocache $ xPubUnspents xpub start o limit+ l <- getLimits False+ uns <- lift . runNoCache nocache $ xPubUnspents xpub l protoSerialNet proto (list . xPubUnspentToEncoding) uns scottyXpubSummary :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()@@ -763,34 +745,42 @@ S.get "/health" scottyHealth S.notFound $ S.raise ThingNotFound -getStart :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m (Maybe BlockRef)+getStart :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m (Maybe Start) getStart = runMaybeT $ do- s <- MaybeT $ (Just <$> S.param "height") `S.rescue` const (return Nothing)+ s <-+ MaybeT $+ (Just <$> S.param "height") `S.rescue` const (return Nothing) do case s of StartParamHash {startParamHash = h} -> start_tx h <|> start_block h StartParamHeight {startParamHeight = h} -> start_height h StartParamTime {startParamTime = q} -> start_time q where- start_height h = return $ BlockRef h maxBound+ start_height h = return $ AtBlock h start_block h = do b <- MaybeT $ getBlock (BlockHash h)- let g = blockDataHeight b- return $ BlockRef g maxBound+ return $ AtBlock (blockDataHeight b) start_tx h = do- t <- MaybeT $ getTxData (TxHash h)- return $ txDataBlock t+ _ <- MaybeT $ getTxData (TxHash h)+ return $ AtTx (TxHash h) start_time q = do d <- MaybeT getBestBlock >>= MaybeT . getBlock if q <= fromIntegral (blockTimestamp (blockDataHeader d)) then do b <- MaybeT $ blockAtOrBefore q let g = blockDataHeight b- return $ BlockRef g maxBound- else return $ MemRef q+ return $ AtBlock g+ else mzero -getOffset :: Monad m => WebT m Offset+getLimits :: (MonadLoggerIO m, MonadUnliftIO m) => Bool -> WebT m Limits+getLimits full = do+ o <- getOffset+ l <- getLimit full+ s <- getStart+ return Limits {limit = l, offset = o, start = s}++getOffset :: Monad m => WebT m Word32 getOffset = do limits <- lift $ asks webMaxLimits o <- S.param "offset" `S.rescue` const (return 0)@@ -802,7 +792,7 @@ getLimit :: Monad m => Bool- -> WebT m (Maybe Limit)+ -> WebT m Word32 getLimit full = do limits <- lift $ asks webMaxLimits l <- (Just <$> S.param "limit") `S.rescue` const (return Nothing)@@ -817,12 +807,12 @@ case l of Nothing -> if d > 0 || m > 0- then Just (min m d)- else Nothing+ then (min m d)+ else 0 Just n -> if m > 0- then Just (min m n)- else Just n+ then (min m n)+ else n parseAddress :: Monad m => WebT m Address parseAddress = do@@ -1047,67 +1037,50 @@ getAddressTxsLimit :: (Monad m, StoreRead m)- => Offset- -> Maybe Limit- -> Maybe BlockRef+ => Limits -> Address -> m [BlockTx]-getAddressTxsLimit offset limit start addr =- applyOffset offset <$> getAddressTxs addr start ((offset +) <$> limit)+getAddressTxsLimit limits addr = getAddressTxs addr limits getAddressTxsFull :: (Monad m, StoreRead m)- => Offset- -> Maybe Limit- -> Maybe BlockRef+ => Limits -> Address -> m [Transaction]-getAddressTxsFull offset limit start addr = do- txs <- getAddressTxsLimit offset limit start addr+getAddressTxsFull limits addr = do+ txs <- getAddressTxsLimit limits addr catMaybes <$> mapM (getTransaction . blockTxHash) txs getAddressesTxsLimit :: (Monad m, StoreRead m)- => Offset- -> Maybe Limit- -> Maybe BlockRef+ => Limits -> [Address] -> m [BlockTx]-getAddressesTxsLimit offset limit start addrs =- applyOffset offset <$> getAddressesTxs addrs start ((offset +) <$> limit)+getAddressesTxsLimit limits addrs = getAddressesTxs addrs limits getAddressesTxsFull :: (Monad m, StoreRead m)- => Offset- -> Maybe Limit- -> Maybe BlockRef+ => Limits -> [Address] -> m [Transaction]-getAddressesTxsFull offset limit start addrs =+getAddressesTxsFull limits addrs = fmap catMaybes $- getAddressesTxsLimit offset limit start addrs >>=+ getAddressesTxsLimit limits addrs >>= mapM (getTransaction . blockTxHash) getAddressUnspentsLimit :: (Monad m, StoreRead m)- => Offset- -> Maybe Limit- -> Maybe BlockRef+ => Limits -> Address -> m [Unspent]-getAddressUnspentsLimit offset limit start addr =- applyOffset offset <$> getAddressUnspents addr start ((offset +) <$> limit)+getAddressUnspentsLimit limits addr = getAddressUnspents addr limits getAddressesUnspentsLimit :: (Monad m, StoreRead m)- => Offset- -> Maybe Limit- -> Maybe BlockRef+ => Limits -> [Address] -> m [Unspent]-getAddressesUnspentsLimit offset limit start addrs =- applyOffset offset <$>- getAddressesUnspents addrs start ((offset +) <$> limit)+getAddressesUnspentsLimit limits addrs = getAddressesUnspents addrs limits -- | Publish a new transaction to the network. publishTx ::