diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,15 @@ 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.52.0 +### Changed +- Remove unnecessary performance optimisations. + +### Fixed +- Reduce balance retrievals for xpubs. +- Hack UTXO ordering to avoid unwanted behaviours. +- Do not merge conduits when there are too many. + ## 0.51.0 ### Fixed - Data type for RequestTooLarge was missing. diff --git a/app/Main.hs b/app/Main.hs --- a/app/Main.hs +++ b/app/Main.hs @@ -79,9 +79,7 @@ , configStatsdHost :: !String , configStatsdPort :: !Int , configStatsdPrefix :: !String - , configWebRequests :: !Int , configWebPriceGet :: !Int - , configCacheThreads :: !Int } instance Default Config where @@ -113,9 +111,7 @@ , configStatsdHost = defStatsdHost , configStatsdPort = defStatsdPort , configStatsdPrefix = defStatsdPrefix - , configWebRequests = defWebRequests , configWebPriceGet = defWebPriceGet - , configCacheThreads = defCacheThreads } defEnv :: MonadIO m => String -> a -> (String -> Maybe a) -> m a @@ -270,16 +266,6 @@ defEnv "STATSD_PORT" 8125 readMaybe {-# NOINLINE defStatsdPort #-} -defWebRequests :: Int -defWebRequests = unsafePerformIO $ - defEnv "WEB_REQUESTS" 32 readMaybe -{-# NOINLINE defWebRequests #-} - -defCacheThreads :: Int -defCacheThreads = unsafePerformIO $ - defEnv "CACHE_THREADS" 8 readMaybe -{-# NOINLINE defCacheThreads #-} - defWebPriceGet :: Int defWebPriceGet = unsafePerformIO $ defEnv "WEB_PRICE_GET" (90 * 1000 * 1000) readMaybe @@ -536,13 +522,6 @@ <> help "Prefix for statsd metrics" <> showDefault <> value (configStatsdPrefix def) - configWebRequests <- - option auto $ - metavar "INT" - <> long "web-requests" - <> help "Simultaneous web requests" - <> showDefault - <> value (configWebRequests def) configWebPriceGet <- option auto $ metavar "MICROSECONDS" @@ -550,13 +529,6 @@ <> help "How often to retrieve price information" <> showDefault <> value (configWebPriceGet def) - configCacheThreads <- - option auto $ - metavar "INT" - <> long "cache-threads" - <> help "Number of simultaneous xpub caching threads" - <> showDefault - <> value (configCacheThreads def) pure Config { configWebLimits = WebLimits {..} @@ -633,9 +605,7 @@ , configStatsdHost = statsdhost , configStatsdPort = statsdport , configStatsdPrefix = statsdpfx - , configWebRequests = wreqs , configWebPriceGet = wpget - , configCacheThreads = cth } = runStderrLoggingT . filterLogger l . with_stats $ \stats -> do $(logInfoS) "Main" $ @@ -665,7 +635,6 @@ , storeConfCacheRefresh = crefresh , storeConfCacheRetryDelay = cretrydelay , storeConfStats = stats - , storeConfCacheThreads = cth } withStore scfg $ \st -> runWeb @@ -680,7 +649,6 @@ , webMaxDiff = maxdiff , webNoMempool = nomem , webStats = stats - , webRequests = wreqs , webPriceGet = wpget } where 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: cf0e99fca7630779bc98f41b4e1ee7cb2b98c1a6e0285a2a817eeb1100560cd9 +-- hash: 78e1694f8db6dab25d0a46bec8ac4221798c460aa51eb92f60c674676fb773fa name: haskoin-store -version: 0.51.0 +version: 0.52.0 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -61,7 +61,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 - , haskoin-store-data ==0.51.0 + , haskoin-store-data ==0.52.0 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1 @@ -115,7 +115,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store - , haskoin-store-data ==0.51.0 + , haskoin-store-data ==0.52.0 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1 @@ -174,7 +174,7 @@ , haskoin-core >=0.19.0 , haskoin-node >=0.17.0 , haskoin-store - , haskoin-store-data ==0.51.0 + , haskoin-store-data ==0.52.0 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3 diff --git a/src/Haskoin/Store/Cache.hs b/src/Haskoin/Store/Cache.hs --- a/src/Haskoin/Store/Cache.hs +++ b/src/Haskoin/Store/Cache.hs @@ -15,7 +15,6 @@ , CacheT , CacheError(..) , newCacheMetrics - , newCacheThreads , withCache , connectRedis , blockRefScore @@ -35,10 +34,11 @@ import Control.Monad.Reader (ReaderT (..), ask, asks) import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) -import Data.Bits (shift, (.&.), (.|.)) +import Data.Bits (complement, shift, (.&.), (.|.)) import Data.ByteString (ByteString) +import qualified Data.ByteString as B import Data.Default (def) -import Data.Either (rights) +import Data.Either (fromRight, isRight, rights) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap import Data.HashSet (HashSet) @@ -117,14 +117,8 @@ , cacheRefresh :: !Int -- millisenconds , cacheRetryDelay :: !Int -- microseconds , cacheMetrics :: !(Maybe CacheMetrics) - , cacheThreads :: !CacheThreads } -type CacheThreads = TVar Int - -newCacheThreads :: MonadIO m => Int -> m CacheThreads -newCacheThreads = newTVarIO - data CacheMetrics = CacheMetrics { cacheHits :: !Metrics.Counter , cacheMisses :: !Metrics.Counter @@ -220,25 +214,33 @@ getAddressTxs addr = lift . getAddressTxs addr getAddressUnspents addr = lift . getAddressUnspents addr getAddressesUnspents addrs = lift . getAddressesUnspents addrs + getMaxGap = lift getMaxGap + getInitialGap = lift getInitialGap + getNumTxData = lift . getNumTxData xPubBals xpub = ask >>= \case - Nothing -> lift (xPubBals xpub) - Just cfg -> lift (runReaderT (getXPubBalances xpub) cfg) - xPubUnspents xpub limits = + Nothing -> lift $ + xPubBals xpub + Just cfg -> lift $ + runReaderT (getXPubBalances xpub) cfg + xPubUnspents xpub xbals limits = ask >>= \case - Nothing -> lift (xPubUnspents xpub limits) - Just cfg -> lift (runReaderT (getXPubUnspents xpub limits) cfg) - xPubTxs xpub limits = + Nothing -> lift $ + xPubUnspents xpub xbals limits + Just cfg -> lift $ + runReaderT (getXPubUnspents xpub xbals limits) cfg + xPubTxs xpub xbals limits = ask >>= \case - Nothing -> lift (xPubTxs xpub limits) - Just cfg -> lift (runReaderT (getXPubTxs xpub limits) cfg) - xPubTxCount xpub = + Nothing -> lift $ + xPubTxs xpub xbals limits + Just cfg -> lift $ + runReaderT (getXPubTxs xpub xbals limits) cfg + xPubTxCount xpub xbals = ask >>= \case - Nothing -> lift (xPubTxCount xpub) - Just cfg -> lift (runReaderT (getXPubTxCount xpub) cfg) - getMaxGap = lift getMaxGap - getInitialGap = lift getInitialGap - getNumTxData = lift . getNumTxData + Nothing -> lift $ + xPubTxCount xpub xbals + Just cfg -> lift $ + runReaderT (getXPubTxCount xpub xbals) cfg withCache :: StoreReadBase m => Maybe CacheConfig -> CacheT m a -> m a withCache s f = runReaderT f s @@ -257,24 +259,24 @@ getXPubTxs :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) - => XPubSpec -> Limits -> CacheX m [TxRef] -getXPubTxs xpub limits = go Nothing + => XPubSpec -> [XPubBal] -> Limits -> CacheX m [TxRef] +getXPubTxs xpub xbals limits = go False where go m = isXPubCached xpub >>= \case True -> do - when (isNothing m) $ incrementCounter cacheHits + unless m $ incrementCounter cacheHits cacheGetXPubTxs xpub limits False -> case m of - Just bals -> lift $ xPubBalsTxs bals limits - Nothing -> do - bals <- lift $ xPubBals xpub - newXPubC xpub bals - go (Just bals) + True -> lift $ xPubTxs xpub xbals limits + False -> do + newXPubC xpub xbals + go True getXPubTxCount :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) - => XPubSpec -> CacheX m Word32 -getXPubTxCount xpub = go False + => XPubSpec -> [XPubBal] -> CacheX m Word32 +getXPubTxCount xpub xbals = + go False where go t = isXPubCached xpub >>= \case True -> do @@ -282,43 +284,49 @@ cacheGetXPubTxCount xpub False -> if t - then lift $ xPubTxCount xpub + then lift $ xPubTxCount xpub xbals else do - bals <- lift $ xPubBals xpub - newXPubC xpub bals + newXPubC xpub xbals go True -getXPubUnspents :: - (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) - => XPubSpec -> Limits -> CacheX m [XPubUnspent] -getXPubUnspents xpub limits = go Nothing +getXPubUnspents :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) + => XPubSpec -> [XPubBal] -> Limits -> CacheX m [XPubUnspent] +getXPubUnspents xpub xbals limits = + go False where + xm = let f x = (balanceAddress (xPubBal x), x) + g = (> 0) . balanceUnspentCount . xPubBal + in HashMap.fromList $ map f $ filter g xbals go m = isXPubCached xpub >>= \case True -> do - when (isNothing m) $ incrementCounter cacheHits - process =<< cacheGetXPubBalances xpub + unless m $ incrementCounter cacheHits + process False -> case m of - Just bals -> lift $ xPubBalsUnspents bals limits - Nothing -> do - bals <- lift $ xPubBals xpub - newXPubC xpub bals - go (Just bals) - process bals = do + True -> + lift $ xPubUnspents xpub xbals limits + False -> do + newXPubC xpub xbals + go True + process = do ops <- map snd <$> cacheGetXPubUnspents xpub limits uns <- catMaybes <$> lift (mapM getUnspent ops) - let g b = (balanceAddress (xPubBal b), xPubBalPath b) - addrmap = Map.fromList (map g bals) - f u = either + let f u = either (const Nothing) (\a -> Just (a, u)) (scriptToAddressBS (unspentScript u)) - addrutxo = mapMaybe f uns - e (a, u) = (`XPubUnspent` u) <$> Map.lookup a addrmap - return $ mapMaybe e addrutxo + g a = HashMap.lookup a xm + h u x = + XPubUnspent + { + xPubUnspent = u, + xPubUnspentPath = xPubBalPath x + } + us = mapMaybe f uns + i a u = h u <$> g a + return $ mapMaybe (uncurry i) us -getXPubBalances :: - (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) - => XPubSpec -> CacheX m [XPubBal] +getXPubBalances :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) + => XPubSpec -> CacheX m [XPubBal] getXPubBalances xpub = isXPubCached xpub >>= \case True -> do incrementCounter cacheHits @@ -688,76 +696,57 @@ void pruneDB lenNotNull :: [XPubBal] -> Int -lenNotNull bals = length $ filter (not . nullBalance . xPubBal) bals +lenNotNull = length . filter (not . nullBalance . xPubBal) newXPubC :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) => XPubSpec -> [XPubBal] -> CacheX m () -newXPubC xpub bals = should_index >>= \i -> +newXPubC xpub xbals = should_index >>= \i -> if i then do - a <- async $ do - incrementCounter cacheMisses - withMetrics cacheIndexTime index - wait a + incrementCounter cacheMisses + withMetrics cacheIndexTime index else incrementCounter cacheIgnore where op XPubUnspent {xPubUnspent = u} = (unspentPoint u, unspentBlock u) - should_index = asks cacheMin >>= \x -> - if x <= lenNotNull bals - then is_indexing >>= \y -> if y then return False else inSync - else return False - index = bracket set_index unset_index $ \(x, y) -> when (x && y) $ do + should_index = + asks cacheMin >>= \x -> + if x <= lenNotNull xbals then inSync else return False + index = + bracket set_index unset_index $ \y -> when y $ + withMetrics cacheIndexTime $ do xpubtxt <- xpubText xpub $(logDebugS) "Cache" $ - "Caching " <> xpubtxt <> ": " <> cs (show (length bals)) <> - " addresses / " <> cs (show (lenNotNull bals)) <> - " used" - utxo <- lift $ xPubUnspents xpub def + "Caching " <> xpubtxt <> ": " <> + cs (show (length xbals)) <> " addresses / " <> + cs (show (lenNotNull xbals)) <> " used" + utxo <- lift $ xPubUnspents xpub xbals def $(logDebugS) "Cache" $ "Caching " <> xpubtxt <> ": " <> cs (show (length utxo)) <> " utxos" - xtxs <- lift $ xPubTxs xpub def + xtxs <- lift $ xPubTxs xpub xbals def $(logDebugS) "Cache" $ "Caching " <> xpubtxt <> ": " <> cs (show (length xtxs)) <> " txs" now <- systemSeconds <$> liftIO getSystemTime runRedis $ do b <- redisTouchKeys now [xpub] - c <- redisAddXPubBalances xpub bals + c <- redisAddXPubBalances xpub xbals d <- redisAddXPubUnspents xpub (map op utxo) e <- redisAddXPubTxs xpub xtxs return $ b >> c >> d >> e >> return () $(logDebugS) "Cache" $ "Cached " <> xpubtxt - is_indexing = runRedis (Redis.exists key) key = idxPfx <> encode xpub - get_thread = do - v <- asks cacheThreads - atomically $ do - x <- readTVar v - if x <= 0 - then return False - else modifyTVar v (subtract 1) >> return True - put_thread = do - v <- asks cacheThreads - atomically $ modifyTVar v (+1) - unset_index (x, y) = do - when x put_thread - when y . void . runRedis $ Redis.del [key] + opts = Redis.SetOpts + { Redis.setSeconds = Just 600 + , Redis.setMilliseconds = Nothing + , Redis.setCondition = Just Redis.Nx + } + red = Redis.setOpts key "1" opts + unset_index y = when y . void . runRedis $ Redis.del [key] set_index = - let opts = Redis.SetOpts - { Redis.setSeconds = Just 600 - , Redis.setMilliseconds = Nothing - , Redis.setCondition = Just Redis.Nx - } - red = Redis.setOpts key "1" opts - in get_thread >>= \case - True -> do - conn <- asks cacheConn - liftIO (Redis.runRedis conn red) >>= \case - Right _ -> return (True, True) - Left _ -> return (True, False) - False -> return (False, False) + asks cacheConn >>= \conn -> + liftIO (Redis.runRedis conn red) >>= return . isRight inSync :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) => CacheX m Bool @@ -1220,27 +1209,32 @@ => XPubSpec -> [(OutPoint, BlockRef)] -> m (f Integer) -redisAddXPubUnspents _ [] = return (pure 0) +redisAddXPubUnspents _ [] = + return (pure 0) redisAddXPubUnspents xpub utxo = zadd (utxoPfx <> encode xpub) $ map (\(p, r) -> (blockRefScore r, encode p)) utxo redisRemXPubUnspents :: (Applicative f, RedisCtx m f) => XPubSpec -> [OutPoint] -> m (f Integer) -redisRemXPubUnspents _ [] = return (pure 0) -redisRemXPubUnspents xpub ops = zrem (utxoPfx <> encode xpub) (map encode ops) +redisRemXPubUnspents _ [] = + return (pure 0) +redisRemXPubUnspents xpub ops = + zrem (utxoPfx <> encode xpub) (map encode ops) redisAddXPubBalances :: (Monad f, RedisCtx m f) => XPubSpec -> [XPubBal] -> m (f ()) redisAddXPubBalances _ [] = return (pure ()) redisAddXPubBalances xpub bals = do xs <- mapM (uncurry (Redis.hset (balancesPfx <> encode xpub))) entries - ys <- - forM bals $ \b -> - redisSetAddrInfo - (balanceAddress (xPubBal b)) - AddressXPub - {addressXPubSpec = xpub, addressXPubPath = xPubBalPath b} + ys <- forM bals $ \b -> + redisSetAddrInfo + (balanceAddress (xPubBal b)) + AddressXPub + { + addressXPubSpec = xpub, + addressXPubPath = xPubBalPath b + } return $ sequence_ xs >> sequence_ ys where entries = map (\b -> (encode (xPubBalPath b), encode (xPubBal b))) bals diff --git a/src/Haskoin/Store/Common.hs b/src/Haskoin/Store/Common.hs --- a/src/Haskoin/Store/Common.hs +++ b/src/Haskoin/Store/Common.hs @@ -18,8 +18,6 @@ , getActiveTxData , getDefaultBalance , getSpenders - , xPubBalsTxs - , xPubBalsUnspents , getTransaction , getNumTransaction , blockAtOrBefore @@ -27,12 +25,18 @@ , deOffset , applyLimits , applyLimitsC + , applyLimit + , applyLimitC , sortTxs , nub' , microseconds + , streamThings + , joinDescStreams ) where -import Conduit (ConduitT, dropC, mapC, takeC) +import Conduit (ConduitT, await, dropC, mapC, + runConduit, sealConduitT, sinkList, + takeC, yield, ($$++), (.|)) import Control.DeepSeq (NFData) import Control.Exception (Exception) import Control.Monad (forM) @@ -46,8 +50,11 @@ import Data.Hashable (Hashable) import Data.IntMap.Strict (IntMap) import qualified Data.IntMap.Strict as I -import Data.List (sortBy) -import Data.Maybe (catMaybes) +import Data.List (sortOn) +import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map +import Data.Maybe (catMaybes, mapMaybe) +import Data.Ord (Down(..)) import Data.Serialize (Serialize (..)) import Data.Time.Clock.System (getSystemTime, systemNanoseconds, systemSeconds) @@ -111,19 +118,25 @@ getMempool :: m [(UnixTime, TxHash)] class StoreReadBase m => StoreReadExtra m where + getAddressesTxs :: [Address] -> Limits -> m [TxRef] + getAddressesUnspents :: [Address] -> Limits -> m [Unspent] + getInitialGap :: m Word32 + getMaxGap :: m Word32 + getNumTxData :: Word64 -> m [TxData] + getBalances :: [Address] -> m [Balance] getBalances as = zipWith f as <$> mapM getBalance as where f a Nothing = zeroBalance a f _ (Just b) = b - getAddressesTxs :: [Address] -> Limits -> m [TxRef] + getAddressTxs :: Address -> Limits -> m [TxRef] getAddressTxs a = getAddressesTxs [a] + getAddressUnspents :: Address -> Limits -> m [Unspent] getAddressUnspents a = getAddressesUnspents [a] - getAddressesUnspents :: [Address] -> Limits -> m [Unspent] - getNumTxData :: Word64 -> m [TxData] + xPubBals :: XPubSpec -> m [XPubBal] xPubBals xpub = do igap <- getInitialGap @@ -149,50 +162,48 @@ if all nullBalance bs then return xbs else (xbs <>) <$> derive_until_gap gap m as2 - xPubSummary :: XPubSpec -> m XPubSummary - xPubSummary xpub = do - bs <- filter (not . nullBalance . xPubBal) <$> xPubBals xpub - let ex = foldl max 0 [i | XPubBal {xPubBalPath = [0, i]} <- bs] - ch = foldl max 0 [i | XPubBal {xPubBalPath = [1, i]} <- bs] - uc = - sum - [ c - | XPubBal {xPubBal = Balance {balanceUnspentCount = c}} <- - bs - ] - xt = [b | b@XPubBal {xPubBalPath = [0, _]} <- bs] - rx = - sum - [ r - | XPubBal {xPubBal = Balance {balanceTotalReceived = r}} <- - xt - ] - return - XPubSummary - { xPubSummaryConfirmed = sum (map (balanceAmount . xPubBal) bs) - , xPubSummaryZero = sum (map (balanceZero . xPubBal) bs) - , xPubSummaryReceived = rx - , xPubUnspentCount = uc - , xPubChangeIndex = ch - , xPubExternalIndex = ex - } - xPubUnspents :: XPubSpec -> Limits -> m [XPubUnspent] - xPubUnspents xpub limits = do - xs <- filter positive <$> xPubBals xpub - sortBy (compare `on` unsblock) . applyLimits limits <$> xUns limits xs + + xPubSummary :: XPubSpec -> [XPubBal] -> m XPubSummary + xPubSummary _xspec xbals = return + XPubSummary + { xPubSummaryConfirmed = sum (map (balanceAmount . xPubBal) bs) + , xPubSummaryZero = sum (map (balanceZero . xPubBal) bs) + , xPubSummaryReceived = rx + , xPubUnspentCount = uc + , xPubChangeIndex = ch + , xPubExternalIndex = ex + } where - unsblock = unspentBlock . xPubUnspent - positive XPubBal {xPubBal = Balance {balanceUnspentCount = c}} = c > 0 - xPubTxs :: XPubSpec -> Limits -> m [TxRef] - xPubTxs xpub limits = do - bs <- xPubBals xpub - let as = map (balanceAddress . xPubBal) bs - getAddressesTxs as limits - xPubTxCount :: XPubSpec -> m Word32 - xPubTxCount xpub = fromIntegral . length <$> xPubTxs xpub def - getMaxGap :: m Word32 - getInitialGap :: m Word32 + bs = filter (not . nullBalance . xPubBal) xbals + ex = foldl max 0 [i | XPubBal {xPubBalPath = [0, i]} <- bs] + ch = foldl max 0 [i | XPubBal {xPubBalPath = [1, i]} <- bs] + uc = sum [balanceUnspentCount (xPubBal b) | b <- bs] + xt = [b | b@XPubBal {xPubBalPath = [0, _]} <- bs] + rx = sum [balanceTotalReceived (xPubBal b) | b <- xt] + xPubUnspents :: XPubSpec -> [XPubBal] -> Limits -> m [XPubUnspent] + xPubUnspents _xspec xbals limits = + applyLimits limits . sortOn Down . concat <$> mapM h cs + where + l = deOffset limits + g = balanceAddress . xPubBal + cs = filter ((> 0) . balanceUnspentCount . xPubBal) xbals + i b = getAddressUnspents (balanceAddress (xPubBal b)) l + f b t = XPubUnspent {xPubUnspentPath = xPubBalPath b, xPubUnspent = t} + h b = map (f b) <$> i b + + xPubTxs :: XPubSpec -> [XPubBal] -> Limits -> m [TxRef] + xPubTxs _xspec xbals limits = + let as = map balanceAddress $ + filter (not . nullBalance) $ + map xPubBal $ + xbals + in getAddressesTxs as limits + + xPubTxCount :: XPubSpec -> [XPubBal] -> m Word32 + xPubTxCount xspec xbals = + fromIntegral . length <$> xPubTxs xspec xbals def + class StoreWrite m where setBest :: BlockHash -> m () insertBlock :: BlockData -> m () @@ -234,14 +245,6 @@ Nothing -> return $ zeroBalance a Just b -> return b -xUns :: StoreReadExtra f => Limits -> [XPubBal] -> f [XPubUnspent] -xUns limits bs = concat <$> mapM g bs - where - f p t = XPubUnspent {xPubUnspentPath = p, xPubUnspent = t} - g b = - map (f (xPubBalPath b)) <$> - getAddressUnspents (balanceAddress (xPubBal b)) (deOffset limits) - deriveAddresses :: DeriveAddr -> XPubKey -> Word32 -> [(Word32, Address)] deriveAddresses derive xpub start = map (\i -> (i, derive xpub i)) [start ..] @@ -250,28 +253,6 @@ deriveFunction DeriveP2SH i = fst . deriveCompatWitnessAddr i deriveFunction DeriveP2WPKH i = fst . deriveWitnessAddr i -xPubBalsUnspents :: - StoreReadExtra m - => [XPubBal] - -> Limits - -> m [XPubUnspent] -xPubBalsUnspents bals limits = do - let xs = filter positive bals - applyLimits limits <$> xUns limits xs - where - positive XPubBal {xPubBal = Balance {balanceUnspentCount = c}} = c > 0 - -xPubBalsTxs :: - StoreReadExtra m - => [XPubBal] - -> Limits - -> m [TxRef] -xPubBalsTxs bals limits = do - let as = map balanceAddress . filter (not . nullBalance) $ map xPubBal bals - ts <- concat <$> mapM (\a -> getAddressTxs a (deOffset limits)) as - let ts' = sortBy (flip compare `on` txRefBlock) (nub' ts) - return $ applyLimits limits ts' - getTransaction :: (Monad m, StoreReadBase m) => TxHash -> m (Maybe Transaction) getTransaction h = runMaybeT $ do @@ -359,7 +340,9 @@ applyLimit l = take (fromIntegral l) deOffset :: Limits -> Limits -deOffset l = l { limit = limit l + offset l, offset = 0} +deOffset l = case limit l of + 0 -> l{offset = 0} + _ -> l{limit = limit l + offset l, offset = 0} applyLimitsC :: Monad m => Limits -> ConduitT i i m () applyLimitsC Limits {..} = applyOffsetC offset >> applyLimitC limit @@ -392,3 +375,47 @@ let f t = toInteger (systemSeconds t) * 1000000 + toInteger (systemNanoseconds t) `div` 1000 in liftIO $ f <$> getSystemTime + +streamThings :: Monad m + => (Limits -> m [a]) + -> Maybe (a -> TxHash) + -> Limits + -> ConduitT () a m () +streamThings getit gettx limits = + lift (getit limits) >>= \case + [] -> return () + ls -> mapM yield ls >> go limits (last ls) + where + h l x = case gettx of + Just g -> Just l{offset = 1, start = Just (AtTx (g x))} + Nothing -> case limit l of + 0 -> Nothing + _ -> Just l{offset = offset l + limit l} + go l x = case h l x of + Nothing -> return () + Just l' -> lift (getit l') >>= \case + [] -> return () + ls -> mapM yield ls >> go l' (last ls) + +joinDescStreams :: (Monad m, Ord a) + => [ConduitT () a m ()] + -> ConduitT () a m () +joinDescStreams xs = do + let ss = map sealConduitT xs + go Nothing =<< g ss + where + j (x, y) = (, [x]) <$> y + g ss = let l = mapMaybe j <$> lift (traverse ($$++ await) ss) + in Map.fromListWith (++) <$> l + go m mp = case Map.lookupMax mp of + Nothing -> return () + Just (x, ss) -> do + case m of + Nothing -> yield x + Just x' + | x == x' -> return () + | otherwise -> yield x + mp1 <- g ss + let mp2 = Map.deleteMax mp + mp' = Map.unionWith (++) mp1 mp2 + go (Just x) mp' diff --git a/src/Haskoin/Store/Database/Reader.hs b/src/Haskoin/Store/Database/Reader.hs --- a/src/Haskoin/Store/Database/Reader.hs +++ b/src/Haskoin/Store/Database/Reader.hs @@ -24,8 +24,9 @@ import qualified Data.ByteString as BS import Data.Default (def) import Data.Function (on) -import Data.List (sortBy) +import Data.List (sortOn) import Data.Maybe (fromMaybe) +import Data.Ord (Down(..)) import Data.Serialize (encode) import Data.Word (Word32, Word64) import Database.RocksDB (ColumnFamily, Config (..), @@ -40,7 +41,6 @@ import Haskoin.Store.Common import Haskoin.Store.Data import Haskoin.Store.Database.Types -import Haskoin.Store.Logic (joinDescStreams) import UnliftIO (MonadIO, MonadUnliftIO, liftIO) type DatabaseReaderT = ReaderT DatabaseReader @@ -169,21 +169,17 @@ getMempoolDB DatabaseReader{databaseHandle = db} = fromMaybe [] <$> retrieve db MemKey -getAddressesTxsDB :: - MonadIO m - => [Address] - -> Limits - -> DatabaseReader - -> m [TxRef] +getAddressesTxsDB :: MonadIO m + => [Address] -> Limits -> DatabaseReader -> m [TxRef] getAddressesTxsDB addrs limits bdb@DatabaseReader{databaseHandle = db} = - liftIO $ iters addrs [] $ \cs -> - runConduit $ - joinDescStreams cs .| applyLimitsC limits .| sinkList + applyLimits limits . sortOn Down . concat <$> mapM f addrs where - iters [] acc f = f acc - iters (a : as) acc f = - withIterCF db (addrTxCF db) $ \it -> - iters as (addressConduit a bdb (start limits) it : acc) f + l = deOffset limits + f a = liftIO . withIterCF db (addrTxCF db) $ \it -> + runConduit $ + addressConduit a bdb (start l) it .| + applyLimitC (limit l) .| + sinkList addressConduit :: MonadUnliftIO m => Address @@ -241,14 +237,14 @@ -> DatabaseReader -> m [Unspent] getAddressesUnspentsDB addrs limits bdb@DatabaseReader{databaseHandle = db} = - liftIO $ iters addrs [] $ \cs -> - runConduit $ - joinDescStreams cs .| applyLimitsC limits .| sinkList + applyLimits limits . sortOn Down . concat <$> mapM f addrs where - iters [] acc f = f acc - iters (a : as) acc f = - withIterCF db (addrOutCF db) $ \it -> - iters as (unspentConduit a bdb (start limits) it : acc) f + l = deOffset limits + f a = liftIO . withIterCF db (addrTxCF db) $ \it -> + runConduit $ + unspentConduit a bdb (start l) it .| + applyLimitC (limit l) .| + sinkList unspentConduit :: MonadUnliftIO m => Address diff --git a/src/Haskoin/Store/Logic.hs b/src/Haskoin/Store/Logic.hs --- a/src/Haskoin/Store/Logic.hs +++ b/src/Haskoin/Store/Logic.hs @@ -13,8 +13,6 @@ , importBlock , newMempoolTx , deleteUnconfirmedTx - , streamThings - , joinDescStreams ) where import Conduit (ConduitT, await, lift, sealConduitT, @@ -673,45 +671,3 @@ testPresent :: StoreReadBase m => Tx -> m Bool testPresent tx = isJust <$> getActiveTxData (txHash tx) - -streamThings :: Monad m - => (Limits -> m [a]) - -> (a -> TxHash) - -> Limits - -> ConduitT () a m () -streamThings f g l = - lift (f l{limit = 50}) >>= \case - [] -> return () - ls -> do - mapM yield ls - go (last ls) - where - go x = - lift (f (Limits 50 1 (Just (AtTx (g x))))) >>= \case - [] -> return () - ls -> do - mapM yield ls - go (last ls) - -joinDescStreams :: (Monad m, Ord a) - => [ConduitT () a m ()] - -> ConduitT () a m () -joinDescStreams xs = do - let ss = map sealConduitT xs - go Nothing =<< g ss - where - j (x, y) = (, [x]) <$> y - g ss = let l = mapMaybe j <$> lift (traverse ($$++ await) ss) - in Map.fromListWith (++) <$> l - go m mp = case Map.lookupMax mp of - Nothing -> return () - Just (x, ss) -> do - case m of - Nothing -> yield x - Just x' - | x == x' -> return () - | otherwise -> yield x - mp1 <- g ss - let mp2 = Map.deleteMax mp - mp' = Map.unionWith (++) mp1 mp2 - go (Just x) mp' diff --git a/src/Haskoin/Store/Manager.hs b/src/Haskoin/Store/Manager.hs --- a/src/Haskoin/Store/Manager.hs +++ b/src/Haskoin/Store/Manager.hs @@ -36,8 +36,7 @@ blockStoreTxSTM, withBlockStore) import Haskoin.Store.Cache (CacheConfig (..), CacheWriter, cacheNewBlock, cacheWriter, - connectRedis, newCacheMetrics, - newCacheThreads) + connectRedis, newCacheMetrics) import Haskoin.Store.Common (StoreEvent (..)) import Haskoin.Store.Database.Reader (DatabaseReader (..), DatabaseReaderT, @@ -103,8 +102,6 @@ -- ^ delay in microseconds to retry getting cache lock , storeConfStats :: !(Maybe Metrics.Store) -- ^ stats store - , storeConfCacheThreads :: !Int - -- ^ how many caching threads } withStore :: (MonadLoggerIO m, MonadUnliftIO m) @@ -190,15 +187,14 @@ mapM newCacheMetrics (storeConfStats cfg) >>= \metrics -> connectRedis redisurl >>= \conn -> withSubscription pub $ \evts -> - newCacheThreads (storeConfCacheThreads cfg) >>= \cth -> - let conf = c conn metrics cth + let conf = c conn metrics in withProcess (f conf) $ \p -> cacheWriterProcesses crefresh evts (getProcessMailbox p) $ do action (Just conf) where crefresh = storeConfCacheRefresh cfg f conf cwinbox = runReaderT (cacheWriter conf cwinbox) db - c conn metrics cth = + c conn metrics = CacheConfig { cacheConn = conn , cacheMin = storeConfCacheMin cfg @@ -207,7 +203,6 @@ , cacheRefresh = storeConfCacheRefresh cfg , cacheRetryDelay = storeConfCacheRetryDelay cfg , cacheMetrics = metrics - , cacheThreads = cth } cacheWriterProcesses :: MonadUnliftIO m diff --git a/src/Haskoin/Store/Web.hs b/src/Haskoin/Store/Web.hs --- a/src/Haskoin/Store/Web.hs +++ b/src/Haskoin/Store/Web.hs @@ -64,7 +64,7 @@ import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import Data.Int (Int64) -import Data.List (nub, sortBy) +import Data.List (nub) import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromJust, fromMaybe, isJust, @@ -186,7 +186,6 @@ , webVersion :: !String , webNoMempool :: !Bool , webStats :: !(Maybe Metrics.Store) - , webRequests :: !Int , webPriceGet :: !Int } @@ -194,38 +193,36 @@ { webConfig :: !WebConfig , webTicker :: !(TVar (HashMap Text BinfoTicker)) , webMetrics :: !(Maybe WebMetrics) - , webTokens :: !(TVar Int) } data WebMetrics = WebMetrics - { everyStat :: !StatDist - , blockStat :: !StatDist - , rawBlockStat :: !StatDist - , txStat :: !StatDist - , txsBlockStat :: !StatDist - , txAfterStat :: !StatDist - , postTxStat :: !StatDist - , mempoolStat :: !StatDist - , addrTxStat :: !StatDist - , addrTxFullStat :: !StatDist - , addrBalanceStat :: !StatDist - , addrUnspentStat :: !StatDist - , xPubStat :: !StatDist - , xPubTxStat :: !StatDist - , xPubTxFullStat :: !StatDist - , xPubUnspentStat :: !StatDist - , multiaddrStat :: !StatDist - , rawaddrStat :: !StatDist - , balanceStat :: !StatDist - , unspentStat :: !StatDist - , rawtxStat :: !StatDist - , peerStat :: !StatDist - , healthStat :: !StatDist - , dbStatsStat :: !StatDist - , eventsConnected :: !Metrics.Gauge - , inFlightRequests :: !Metrics.Gauge - , statKey :: !(V.Key (TVar (Maybe (WebMetrics -> StatDist)))) - , itemsKey :: !(V.Key (TVar Int)) + { everyStat :: !StatDist + , blockStat :: !StatDist + , rawBlockStat :: !StatDist + , txStat :: !StatDist + , txsBlockStat :: !StatDist + , txAfterStat :: !StatDist + , postTxStat :: !StatDist + , mempoolStat :: !StatDist + , addrTxStat :: !StatDist + , addrTxFullStat :: !StatDist + , addrBalanceStat :: !StatDist + , addrUnspentStat :: !StatDist + , xPubStat :: !StatDist + , xPubTxStat :: !StatDist + , xPubTxFullStat :: !StatDist + , xPubUnspentStat :: !StatDist + , multiaddrStat :: !StatDist + , rawaddrStat :: !StatDist + , balanceStat :: !StatDist + , unspentStat :: !StatDist + , rawtxStat :: !StatDist + , peerStat :: !StatDist + , healthStat :: !StatDist + , dbStatsStat :: !StatDist + , eventsConnected :: !Metrics.Gauge + , statKey :: !(V.Key (TVar (Maybe (WebMetrics -> StatDist)))) + , itemsKey :: !(V.Key (TVar Int)) } createMetrics :: MonadIO m => Metrics.Store -> m WebMetrics @@ -255,7 +252,6 @@ healthStat <- d "health" dbStatsStat <- d "dbstats" eventsConnected <- g "events.connected" - inFlightRequests <- g "inflight" statKey <- V.newKey itemsKey <- V.newKey return WebMetrics{..} @@ -281,23 +277,6 @@ start m = liftIO $ Metrics.Gauge.inc (gf m) end m = liftIO $ Metrics.Gauge.dec (gf m) -withToken :: Int -> TVar Int -> Maybe WebMetrics -> IO a -> IO a -withToken max_req tok metrics go = do - let minf = inFlightRequests <$> metrics - bracket (t tok) (p tok) $ \rem -> do - let i = fromIntegral $ max_req - rem - case minf of - Nothing -> return () - Just inf -> Metrics.Gauge.set inf i - go - where - t tok = atomically $ do - ts <- readTVar tok - check (0 < ts) - modifyTVar tok (subtract 1) - readTVar tok - p tok _ = atomically $ modifyTVar tok (+1) - setMetrics :: MonadUnliftIO m => (WebMetrics -> StatDist) -> Int @@ -346,10 +325,10 @@ 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 - xPubTxCount = runInWebReader . xPubTxCount + xPubSummary xpub = runInWebReader . xPubSummary xpub + xPubUnspents xpub xbals = runInWebReader . xPubUnspents xpub xbals + xPubTxs xpub xbals = runInWebReader . xPubTxs xpub xbals + xPubTxCount xpub = runInWebReader . xPubTxCount xpub getNumTxData = runInWebReader . getNumTxData instance (MonadUnliftIO m, MonadLoggerIO m) => StoreReadBase (WebT m) where @@ -368,10 +347,10 @@ getAddressesTxs as = lift . getAddressesTxs as getAddressesUnspents as = lift . getAddressesUnspents as xPubBals = lift . xPubBals - xPubSummary = lift . xPubSummary - xPubUnspents xpub = lift . xPubUnspents xpub - xPubTxs xpub = lift . xPubTxs xpub - xPubTxCount = lift . xPubTxCount + xPubSummary xpub = lift . xPubSummary xpub + xPubUnspents xpub xbals = lift . xPubUnspents xpub xbals + xPubTxs xpub xbals = lift . xPubTxs xpub xbals + xPubTxCount xpub = lift . xPubTxCount xpub getMaxGap = lift getMaxGap getInitialGap = lift getInitialGap getNumTxData = lift . getNumTxData @@ -386,17 +365,13 @@ , webStore = store , webStats = stats , webPriceGet = pget - , webRequests = max_req } = do ticker <- newTVarIO HashMap.empty metrics <- mapM createMetrics stats - tok <- newTVarIO max_req let st = WebState - { - webConfig = cfg, - webTicker = ticker, - webMetrics = metrics, - webTokens = tok + { webConfig = cfg + , webTicker = ticker + , webMetrics = metrics } net = storeNetwork store withAsync (price net pget ticker) $ \_ -> do @@ -405,7 +380,6 @@ S.scottyOptsT opts (runner . (`runReaderT` st)) $ do S.middleware reqLogger S.middleware reqSizeLimit - S.middleware $ reqToken max_req tok metrics S.defaultHandler defHandler handlePaths S.notFound $ S.raise ThingNotFound @@ -1196,13 +1170,17 @@ (MonadUnliftIO m, MonadLoggerIO m) => GetXPub -> WebT m XPubSummary scottyXPub (GetXPub xpub deriv (NoCache noCache)) = do setMetrics xPubStat 1 - lift . runNoCache noCache $ xPubSummary $ XPubSpec xpub deriv + let xspec = XPubSpec xpub deriv + xbals <- xPubBals xspec + lift . runNoCache noCache $ xPubSummary xspec xbals getXPubTxs :: (MonadUnliftIO m, MonadLoggerIO m) => XPubKey -> DeriveType -> LimitsParam -> Bool -> WebT m [TxRef] getXPubTxs xpub deriv plimits nocache = do limits <- paramToLimits False plimits - lift . runNoCache nocache $ xPubTxs (XPubSpec xpub deriv) limits + let xspec = XPubSpec xpub deriv + xbals <- xPubBals xspec + lift . runNoCache nocache $ xPubTxs xspec xbals limits scottyXPubTxs :: (MonadUnliftIO m, MonadLoggerIO m) => GetXPubTxs -> WebT m [TxRef] @@ -1236,7 +1214,9 @@ scottyXPubUnspent (GetXPubUnspent xpub deriv pLimits (NoCache noCache)) = do setMetrics xPubUnspentStat 1 limits <- paramToLimits False pLimits - lift . runNoCache noCache $ xPubUnspents (XPubSpec xpub deriv) limits + let xspec = XPubSpec xpub deriv + xbals <- xPubBals xspec + lift . runNoCache noCache $ xPubUnspents xspec xbals limits --------------------------------------- -- Blockchain.info API Compatibility -- @@ -1330,9 +1310,8 @@ getBinfoActive unspentStat >>= \(xspecs, addrs) -> getNumTxId >>= \numtxid -> get_limit >>= \limit -> - get_min_conf >>= \min_conf -> + get_min_conf >>= \min_conf -> do let len = HashSet.size addrs + HashMap.size xspecs - in do setMetrics unspentStat len net <- lift $ asks (storeNetwork . webStore . webConfig) height <- getChainHeight @@ -1353,8 +1332,9 @@ -> HashSet XPubSpec -> HashSet Address -> ConduitT () BinfoUnspent m () -getBinfoUnspents numtxid height xspecs addrs = - joinDescStreams conduits .| mapC (uncurry binfo) +getBinfoUnspents numtxid height xspecs addrs = do + cs <- conduits + joinDescStreams cs .| mapC (uncurry binfo) where binfo Unspent{..} xp = let conf = case unspentBlock of @@ -1375,21 +1355,28 @@ , getBinfoUnspentXPub = xp } point_hash = outPointHash . unspentPoint - conduits = xconduits <> acounduits - xconduits = - let f x (XPubUnspent p u) = + conduits = (<>) <$> xconduits <*> pure acounduits + xconduits = lift $ do + let f x (XPubUnspent u p) = let path = toSoft (listToPath p) xp = BinfoXPubPath (xPubSpecKey x) <$> path in (u, xp) - g x = - streamThings (xPubUnspents x) (point_hash . xPubUnspent) def .| - mapC (f x) - in map g (HashSet.toList xspecs) + g x = do + bs <- xPubBals x + return $ + streamThings + (xPubUnspents x bs) + Nothing + def{limit = 250} .| + mapC (f x) + mapM g (HashSet.toList xspecs) acounduits = let f u = (u, Nothing) - g a = - streamThings (getAddressUnspents a) point_hash def .| - mapC f + g a = streamThings + (getAddressUnspents a) + Nothing + def{limit = 250} .| + mapC f in map g (HashSet.toList addrs) getBinfoTxs :: (StoreReadExtra m, MonadIO m) @@ -1402,14 +1389,17 @@ -> Bool -- prune outputs -> Int64 -- starting balance -> ConduitT () BinfoTx m () -getBinfoTxs abook sxspecs saddrs baddrs bfilter numtxid prune bal = - joinDescStreams conduits .| go bal +getBinfoTxs abook sxspecs saddrs baddrs bfilter numtxid prune bal = do + cs <- conduits + joinDescStreams cs .| go bal where sxspecs_ls = HashSet.toList sxspecs saddrs_ls = HashSet.toList saddrs - conduits = map xpub_c sxspecs_ls <> map addr_c saddrs_ls - xpub_c x = streamThings (xPubTxs x) txRefHash def - addr_c a = streamThings (getAddressTxs a) txRefHash def + conduits = (<>) <$> mapM xpub_c sxspecs_ls <*> pure (map addr_c saddrs_ls) + xpub_c x = lift $ do + bs <- xPubBals x + return $ streamThings (xPubTxs x bs) (Just txRefHash) def{limit = 50} + addr_c a = streamThings (getAddressTxs a) (Just txRefHash) def{limit = 50} binfo_tx b = toBinfoTx numtxid abook prune b compute_bal_change BinfoTx{..} = let ins = mapMaybe getBinfoTxInputPrevOut getBinfoTxInputs @@ -1466,7 +1456,7 @@ in do setMetrics multiaddrStat len xbals <- get_xbals xspecs - xtxns <- mapM (fmap fromIntegral . xPubTxCount) xspecs + xtxns <- get_xpub_tx_count xbals xspecs let sxbals = subset sxpubs xbals xabals = compute_xabals xbals addrs = addrs' `HashSet.difference` HashMap.keysSet xabals @@ -1529,6 +1519,14 @@ , getBinfoMultiAddrCashAddr = cashaddr } where + get_xpub_tx_count xbals = + let f (k, s) = + case HashMap.lookup k xbals of + Nothing -> return (k, 0) + Just bs -> do + n <- xPubTxCount s bs + return (k, fromIntegral n) + in fmap HashMap.fromList . mapM f . HashMap.toList get_filter = S.param "filter" `S.rescue` const (return BinfoFilterAll) get_best_block = getBestBlock >>= \case @@ -1705,7 +1703,7 @@ is_ext _ = False get_xspec_balance net xpub = do xbals <- xPubBals xpub - xts <- xPubTxCount xpub + xts <- xPubTxCount xpub xbals let val = sum $ map balanceAmount $ map xPubBal xbals zro = sum $ map balanceZero $ map xPubBal xbals exs = filter is_ext xbals @@ -2079,34 +2077,24 @@ runner <- askRunInIO return $ \app req respond -> do var <- newTVarIO B.empty - req' <- case metrics of - Nothing -> - return - req - { - requestBody = - req_body var (getRequestBodyChunk req) - } - Just m -> do - stat_var <- newTVarIO Nothing - item_var <- newTVarIO 0 - let vault' = V.insert (statKey m) stat_var $ - V.insert (itemsKey m) item_var $ - vault req - return - req - { - vault = vault', - requestBody = - req_body var (getRequestBodyChunk req) - } + req' <- + let rb = req_body var (getRequestBodyChunk req) + rq = req{requestBody = rb} + in case metrics of + Nothing -> return rq + Just m -> do + stat_var <- newTVarIO Nothing + item_var <- newTVarIO 0 + let vt = V.insert (statKey m) stat_var $ + V.insert (itemsKey m) item_var $ + vault rq + return rq{vault = vt} bracket start (end var runner req') $ \t1 -> app req' $ \res -> do t2 <- systemToUTCTime <$> getSystemTime - let diff = round $ diffUTCTime t2 t1 * 1000 b <- readTVarIO var let s = responseStatus res - msg = fmtReq b req' <> ": " <> fmtStatus s diff + msg = fmtReq b req' <> ": " <> fmtStatus s if statusIsSuccessful s then runner $ $(logDebugS) "Web" msg else runner $ $(logErrorS) "Web" msg @@ -2144,10 +2132,6 @@ runner $ $(logWarnS) "Web" $ "Slow [" <> cs (show diff) <> " ms]: " <> fmtReq b req -reqToken :: Int -> TVar Int -> Maybe WebMetrics -> Middleware -reqToken max_req tok metrics app req respond = - withToken max_req tok metrics $ app req respond - reqSizeLimit :: Middleware reqSizeLimit = requestSizeLimitMiddleware lim where @@ -2170,9 +2154,6 @@ Right t -> " [" <> t <> "]" in T.decodeUtf8 (m <> " " <> p <> q <> " " <> cs (show v)) <> txt -fmtStatus :: Status -> Int -> Text -fmtStatus s i = - cs (show (statusCode s)) <> " " <> - cs (statusMessage s) <> " (" <> - cs (show i) <> " ms)" +fmtStatus :: Status -> Text +fmtStatus s = cs (show (statusCode s)) <> " " <> cs (statusMessage s) diff --git a/test/Haskoin/StoreSpec.hs b/test/Haskoin/StoreSpec.hs --- a/test/Haskoin/StoreSpec.hs +++ b/test/Haskoin/StoreSpec.hs @@ -99,7 +99,6 @@ , storeConfCacheRefresh = 750 , storeConfCacheRetryDelay = 100000 , storeConfStats = Nothing - , storeConfCacheThreads = 8 } withStore cfg $ \Store {..} -> withSubscription storePublisher $ \sub ->