haskoin-store 0.53.6 → 0.53.8

raw patch · 9 files changed

+234/−217 lines, 9 filesdep ~haskoin-store-dataPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: haskoin-store-data

API changes (from Hackage documentation)

Files

• CHANGELOG.md +12/−0
• haskoin-store.cabal +5/−5
• src/Haskoin/Store/BlockStore.hs +1/−1
• src/Haskoin/Store/Cache.hs +0/−1
• src/Haskoin/Store/Common.hs +23/−1
• src/Haskoin/Store/Database/Reader.hs +181/−93
• src/Haskoin/Store/Manager.hs +5/−1
• src/Haskoin/Store/Stats.hs +3/−24
• src/Haskoin/Store/Web.hs +4/−91

@@ -4,6 +4,18 @@ 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.35.8+### Changed+- Put derivations stat inside database.++## 0.35.7+### Added+- Added counters for database retrievals.+- Added counter for xpub derivations.++### Changed+- Removed some buggy or unnecessary stats.+ ## 0.35.6 ### Changed - Improve web server statistics.

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: ec49d4278d166be7a2b738a510e0aa03c4cd876a0e9be3eea69d21c4effac640+-- hash: 585582b76ffd5ba96243c759d59ac87300d0868ed1b082361e75f3955834a402  name:           haskoin-store-version:        0.53.6+version:        0.53.8 synopsis:       Storage and index for Bitcoin and Bitcoin Cash description:    Please see the README on GitHub at <https://github.com/haskoin/haskoin-store#readme> category:       Bitcoin, Finance, Network@@ -62,7 +62,7 @@     , hashable >=1.3.0.0     , haskoin-core >=0.20.4     , haskoin-node >=0.17.0-    , haskoin-store-data ==0.53.6+    , haskoin-store-data ==0.53.8     , hedis >=0.12.13     , http-types >=0.12.3     , lens >=4.18.1@@ -116,7 +116,7 @@     , haskoin-core >=0.20.4     , haskoin-node >=0.17.0     , haskoin-store-    , haskoin-store-data ==0.53.6+    , haskoin-store-data ==0.53.8     , hedis >=0.12.13     , http-types >=0.12.3     , lens >=4.18.1@@ -175,7 +175,7 @@     , haskoin-core >=0.20.4     , haskoin-node >=0.17.0     , haskoin-store-    , haskoin-store-data ==0.53.6+    , haskoin-store-data ==0.53.8     , hedis >=0.12.13     , hspec >=2.7.1     , http-types >=0.12.3

@@ -260,7 +260,7 @@     getMempool =         runRocksDB getMempool -instance MonadIO m => StoreReadExtra (BlockT m) where+instance MonadUnliftIO m => StoreReadExtra (BlockT m) where     getMaxGap =         runRocksDB getMaxGap     getInitialGap =

@@ -167,7 +167,6 @@         t2 <- systemToUTCTime <$> liftIO getSystemTime         let diff = round $ diffUTCTime t2 t1 * 1000         df metrics `addStatTime` diff-        df metrics `addStatItems` 1         addStatQuery (df metrics)  incrementCounter :: MonadIO m

@@ -115,6 +115,18 @@     getUnspent :: OutPoint -> m (Maybe Unspent)     getMempool :: m [(UnixTime, TxHash)] +    countBlocks :: Int -> m ()+    countBlocks _ = return ()++    countTxs :: Int -> m ()+    countTxs _ = return ()++    countBalances :: Int -> m ()+    countBalances _ = return ()++    countUnspents :: Int -> m ()+    countUnspents _ = return ()+ class StoreReadBase m => StoreReadExtra m where     getAddressesTxs :: [Address] -> Limits -> m [TxRef]     getAddressesUnspents :: [Address] -> Limits -> m [Unspent]@@ -155,6 +167,7 @@         derive_until_gap _ _ [] = return []         derive_until_gap gap m as = do             let (as1, as2) = splitAt (fromIntegral gap) as+            countXPubDerivations (length as1)             bs <- getBalances (map snd as1)             let xbs = zipWith (xbalance m) bs (map fst as1)             if all nullBalance bs@@ -185,7 +198,10 @@       where         l = deOffset limits         cs = filter ((> 0) . balanceUnspentCount . xPubBal) xbals-        i b = getAddressUnspents (balanceAddress (xPubBal b)) l+        i b = do+            us <- getAddressUnspents (balanceAddress (xPubBal b)) l+            countUnspents (length us)+            return us         f b t = XPubUnspent {xPubUnspentPath = xPubBalPath b, xPubUnspent = t}         h b = map (f b) <$> i b @@ -199,6 +215,12 @@     xPubTxCount :: XPubSpec -> [XPubBal] -> m Word32     xPubTxCount xspec xbals =         fromIntegral . length <$> xPubTxs xspec xbals def++    countTxRefs :: Int -> m ()+    countTxRefs _ = return ()++    countXPubDerivations :: Int -> m ()+    countXPubDerivations _ = return ()  class StoreWrite m where     setBest :: BlockHash -> m ()

@@ -1,10 +1,14 @@ {-# LANGUAGE FlexibleContexts  #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards   #-} module Haskoin.Store.Database.Reader     ( -- * RocksDB Database Access       DatabaseReader (..)     , DatabaseReaderT+    , DatabaseStats(..)+    , createDatabaseStats     , withDatabaseReader     , addrTxCF     , addrOutCF@@ -26,7 +30,7 @@ import           Data.Function                (on) import           Data.List                    (sortOn) import           Data.Maybe                   (fromMaybe)-import           Data.Ord                     (Down(..))+import           Data.Ord                     (Down (..)) import           Data.Serialize               (encode) import           Data.Word                    (Word32, Word64) import           Database.RocksDB             (ColumnFamily, Config (..),@@ -41,18 +45,52 @@ import           Haskoin.Store.Common import           Haskoin.Store.Data import           Haskoin.Store.Database.Types+import qualified System.Metrics               as Metrics+import           System.Metrics.Counter       (Counter)+import qualified System.Metrics.Counter       as Counter import           UnliftIO                     (MonadIO, MonadUnliftIO, liftIO)  type DatabaseReaderT = ReaderT DatabaseReader +data DatabaseStats =+    DatabaseStats+        { databaseBlockCount   :: !Counter+        , databaseTxCount      :: !Counter+        , databaseBalanceCount :: !Counter+        , databaseUnspentCount :: !Counter+        , databaseTxRefCount   :: !Counter+        , databaseDerivations  :: !Counter+        }+ data DatabaseReader =     DatabaseReader         { databaseHandle     :: !DB         , databaseMaxGap     :: !Word32         , databaseInitialGap :: !Word32         , databaseNetwork    :: !Network+        , databaseStats      :: !(Maybe DatabaseStats)         } +createDatabaseStats :: MonadIO m => Metrics.Store -> m DatabaseStats+createDatabaseStats s = liftIO $ do+    databaseBlockCount          <- Metrics.createCounter "database.blocks"      s+    databaseTxCount             <- Metrics.createCounter "database.txs"         s+    databaseBalanceCount        <- Metrics.createCounter "database.balances"    s+    databaseUnspentCount        <- Metrics.createCounter "database.unspents"    s+    databaseTxRefCount          <- Metrics.createCounter "database.txrefs"      s+    databaseDerivations         <- Metrics.createCounter "database.derivations" s+    return DatabaseStats{..}++incrementCounter :: MonadIO m+                 => (DatabaseStats -> Counter)+                 -> Int+                 -> ReaderT DatabaseReader m ()+incrementCounter f i = do+    stats <- asks databaseStats+    case stats of+        Just s  -> liftIO $ Counter.add (f s) (fromIntegral i)+        Nothing -> return ()+ dataVersion :: Word32 dataVersion = 17 @@ -61,9 +99,10 @@                    -> Word32                    -> Word32                    -> FilePath+                   -> Maybe DatabaseStats                    -> DatabaseReaderT m a                    -> m a-withDatabaseReader net igap gap dir f =+withDatabaseReader net igap gap dir stats f =     withDBCF dir cfg columnFamilyConfig $ \db -> do     let bdb =             DatabaseReader@@ -71,6 +110,7 @@                 , databaseMaxGap = gap                 , databaseNetwork = net                 , databaseInitialGap = igap+                , databaseStats = stats                 }     initRocksDB bdb     runReaderT f bdb@@ -129,65 +169,98 @@ setInitRocksDB :: MonadIO m => DB -> m () setInitRocksDB db = insert db VersionKey dataVersion -getBestDatabaseReader :: MonadIO m => DatabaseReader -> m (Maybe BlockHash)-getBestDatabaseReader DatabaseReader{databaseHandle = db} =-    retrieve db BestKey+getBestDB :: MonadIO m+          => DatabaseReaderT m (Maybe BlockHash)+getBestDB =+    asks databaseHandle >>= (`retrieve` BestKey) -getBlocksAtHeightDB :: MonadIO m => BlockHeight -> DatabaseReader -> m [BlockHash]-getBlocksAtHeightDB h DatabaseReader{databaseHandle = db} =+getBlocksAtHeightDB :: MonadIO m+                    => BlockHeight+                    -> DatabaseReaderT m [BlockHash]+getBlocksAtHeightDB h = do+    db <- asks databaseHandle     retrieveCF db (heightCF db) (HeightKey h) >>= \case         Nothing -> return []-        Just ls -> return ls+        Just ls -> countBlocks (length ls) >> return ls -getDatabaseReader :: MonadIO m => BlockHash -> DatabaseReader -> m (Maybe BlockData)-getDatabaseReader h DatabaseReader{databaseHandle = db} =-    retrieveCF db (blockCF db) (BlockKey h)+getDatabaseReader :: MonadIO m+                  => BlockHash+                  -> DatabaseReaderT m (Maybe BlockData)+getDatabaseReader h = do+    db <- asks databaseHandle+    retrieveCF db (blockCF db) (BlockKey h) >>= \case+        Nothing -> return Nothing+        Just b  -> countBlocks 1 >> return (Just b) -getTxDataDB :: MonadIO m => TxHash -> DatabaseReader -> m (Maybe TxData)-getTxDataDB th DatabaseReader{databaseHandle = db} =-    retrieveCF db (txCF db) (TxKey th)+getTxDataDB :: MonadIO m+            => TxHash -> DatabaseReaderT m (Maybe TxData)+getTxDataDB th = do+    db <- asks databaseHandle+    retrieveCF db (txCF db) (TxKey th) >>= \case+        Nothing -> return Nothing+        Just t  -> countTxs 1 >> return (Just t) -getNumTxDataDB :: MonadIO m => Word64 -> DatabaseReader -> m [TxData]-getNumTxDataDB i r@DatabaseReader{databaseHandle = db} = do+getNumTxDataDB :: MonadIO m+               => Word64+               -> DatabaseReaderT m [TxData]+getNumTxDataDB i = do+    db <- asks databaseHandle     let (sk, w) = decodeTxKey i     ls <- liftIO $ matchingAsListCF db (txCF db) (TxKeyS sk)     let f t = let bs = encode $ txHash (txData t)                   b = BS.head (BS.drop 6 bs)                   w' = b .&. 0xf8               in w == w'-    return $ filter f $ map snd ls+        txs = filter f $ map snd ls+    countTxs (length txs)+    return txs -getSpenderDB :: MonadIO m => OutPoint -> DatabaseReader -> m (Maybe Spender)-getSpenderDB op DatabaseReader{databaseHandle = db} =+getSpenderDB :: MonadIO m+             => OutPoint+             -> DatabaseReaderT m (Maybe Spender)+getSpenderDB op = do+    db <- asks databaseHandle     retrieveCF db (spenderCF db) $ SpenderKey op -getBalanceDB :: MonadIO m => Address -> DatabaseReader -> m (Maybe Balance)-getBalanceDB a DatabaseReader{databaseHandle = db} =-    fmap (valToBalance a) <$> retrieveCF db (balanceCF db) (BalKey a)+getBalanceDB :: MonadIO m+             => Address+             -> DatabaseReaderT m (Maybe Balance)+getBalanceDB a = do+    db <- asks databaseHandle+    fmap (valToBalance a) <$> retrieveCF db (balanceCF db) (BalKey a) >>= \case+        Nothing -> return Nothing+        Just b  -> countBalances 1 >> return (Just b) -getMempoolDB :: MonadIO m => DatabaseReader -> m [(UnixTime, TxHash)]-getMempoolDB DatabaseReader{databaseHandle = db} =+getMempoolDB :: MonadIO m+             => DatabaseReaderT m [(UnixTime, TxHash)]+getMempoolDB = do+    db <- asks databaseHandle     fromMaybe [] <$> retrieve db MemKey -getAddressesTxsDB :: MonadIO m-                  => [Address] -> Limits -> DatabaseReader -> m [TxRef]-getAddressesTxsDB addrs limits bdb@DatabaseReader{databaseHandle = db} =-    applyLimits limits . sortOn Down . concat <$> mapM f addrs+getAddressesTxsDB :: MonadUnliftIO m+                  => [Address]+                  -> Limits+                  -> DatabaseReaderT m [TxRef]+getAddressesTxsDB addrs limits = do+    txs <- applyLimits limits . sortOn Down . concat <$> mapM f addrs+    countTxRefs (length txs)+    return txs   where     l = deOffset limits-    f a = liftIO . withIterCF db (addrTxCF db) $ \it ->-        runConduit $-        addressConduit a bdb (start l) it .|-        applyLimitC (limit l) .|-        sinkList+    f a = do+        db <- asks databaseHandle+        withIterCF db (addrTxCF db) $ \it ->+            runConduit $+            addressConduit a (start l) it .|+            applyLimitC (limit l) .|+            sinkList  addressConduit :: MonadUnliftIO m                => Address-               -> DatabaseReader                -> Maybe Start                -> Iterator-               -> ConduitT i TxRef m ()-addressConduit a bdb s it  =+               -> ConduitT i TxRef (DatabaseReaderT m) ()+addressConduit a s it  =     x .| mapC (uncurry f)   where     f (AddrTxKey _ t) () = t@@ -201,7 +274,7 @@                 (AddrTxKeyA a)                 (AddrTxKeyB a (BlockRef bh maxBound))         Just (AtTx txh) ->-            lift (getTxDataDB txh bdb) >>= \case+            lift (getTxDataDB txh) >>= \case                 Just TxData {txDataBlock = b@BlockRef{}} ->                     matchingSkip it (AddrTxKeyA a) (AddrTxKeyB a b)                 Just TxData {txDataBlock = MemRef{}} ->@@ -213,46 +286,53 @@                        (dropWhileC (cond . fst) >> mapC id)                 Nothing -> return () -getAddressTxsDB ::-       MonadIO m-    => Address-    -> Limits-    -> DatabaseReader-    -> m [TxRef]-getAddressTxsDB a limits bdb@DatabaseReader{databaseHandle = db} =-    liftIO . withIterCF db (addrTxCF db) $ \it ->-    runConduit $-    addressConduit a bdb (start limits) it .|-    applyLimitsC limits .|-    sinkList+getAddressTxsDB :: MonadUnliftIO m+                => Address+                -> Limits+                -> DatabaseReaderT m [TxRef]+getAddressTxsDB a limits = do+    db <- asks databaseHandle+    txs <- withIterCF db (addrTxCF db) $ \it ->+        runConduit $+        addressConduit a (start limits) it .|+        applyLimitsC limits .|+        sinkList+    countTxRefs (length txs)+    return txs -getUnspentDB :: MonadIO m => OutPoint -> DatabaseReader -> m (Maybe Unspent)-getUnspentDB p DatabaseReader{databaseHandle = db} =-    fmap (valToUnspent p) <$> retrieveCF db (unspentCF db) (UnspentKey p)+getUnspentDB :: MonadIO m+             => OutPoint+             -> DatabaseReaderT m (Maybe Unspent)+getUnspentDB p = do+    db <- asks databaseHandle+    fmap (valToUnspent p) <$> retrieveCF db (unspentCF db) (UnspentKey p) >>= \case+        Nothing -> return Nothing+        Just u  -> countUnspents 1 >> return (Just u) -getAddressesUnspentsDB ::-       MonadIO m-    => [Address]-    -> Limits-    -> DatabaseReader-    -> m [Unspent]-getAddressesUnspentsDB addrs limits bdb@DatabaseReader{databaseHandle = db} =-    applyLimits limits . sortOn Down . concat <$> mapM f addrs+getAddressesUnspentsDB :: MonadUnliftIO m+                       => [Address]+                       -> Limits+                       -> DatabaseReaderT m [Unspent]+getAddressesUnspentsDB addrs limits = do+    us <- applyLimits limits . sortOn Down . concat <$> mapM f addrs+    countUnspents (length us)+    return us   where     l = deOffset limits-    f a = liftIO . withIterCF db (addrOutCF db) $ \it ->-        runConduit $-        unspentConduit a bdb (start l) it .|-        applyLimitC (limit l) .|-        sinkList+    f a = do+        db <- asks databaseHandle+        withIterCF db (addrOutCF db) $ \it ->+            runConduit $+            unspentConduit a (start l) it .|+            applyLimitC (limit l) .|+            sinkList  unspentConduit :: MonadUnliftIO m                => Address-               -> DatabaseReader                -> Maybe Start                -> Iterator-               -> ConduitT i Unspent m ()-unspentConduit a bdb s it =+               -> ConduitT i Unspent (DatabaseReaderT m) ()+unspentConduit a s it =     x .| mapC (uncurry toUnspent)   where     x = case s of@@ -264,7 +344,7 @@                 (AddrOutKeyA a)                 (AddrOutKeyB a (BlockRef h maxBound))         Just (AtTx txh) ->-            lift (getTxDataDB txh bdb) >>= \case+            lift (getTxDataDB txh) >>= \case                 Just TxData {txDataBlock = b@BlockRef{}} ->                     matchingSkip it (AddrOutKeyA a) (AddrOutKeyB a b)                 Just TxData {txDataBlock = MemRef{}} ->@@ -276,15 +356,16 @@                        (dropWhileC (cond . fst) >> mapC id)                 Nothing -> return () -getAddressUnspentsDB ::-       MonadIO m-    => Address-    -> Limits-    -> DatabaseReader-    -> m [Unspent]-getAddressUnspentsDB a limits bdb@DatabaseReader{databaseHandle = db} =-    liftIO $ withIterCF db (addrOutCF db) $ \it -> runConduit $-    x it .| applyLimitsC limits .| mapC (uncurry toUnspent) .| sinkList+getAddressUnspentsDB :: MonadUnliftIO m+                     => Address+                     -> Limits+                     -> DatabaseReaderT m [Unspent]+getAddressUnspentsDB a limits = do+    db <- asks databaseHandle+    us <- withIterCF db (addrOutCF db) $ \it -> runConduit $+        x it .| applyLimitsC limits .| mapC (uncurry toUnspent) .| sinkList+    countUnspents (length us)+    return us   where     x it = case start limits of         Nothing ->@@ -295,7 +376,7 @@                 (AddrOutKeyA a)                 (AddrOutKeyB a (BlockRef h maxBound))         Just (AtTx txh) ->-            lift (getTxDataDB txh bdb) >>= \case+            lift (getTxDataDB txh) >>= \case                 Just TxData {txDataBlock = b@BlockRef{}} ->                     matchingSkip it (AddrOutKeyA a) (AddrOutKeyB a b)                 Just TxData {txDataBlock = MemRef{}} ->@@ -309,20 +390,27 @@  instance MonadIO m => StoreReadBase (DatabaseReaderT m) where     getNetwork = asks databaseNetwork-    getTxData t = ask >>= getTxDataDB t-    getSpender p = ask >>= getSpenderDB p-    getUnspent a = ask >>= getUnspentDB a-    getBalance a = ask >>= getBalanceDB a-    getMempool = ask >>= getMempoolDB-    getBestBlock = ask >>= getBestDatabaseReader-    getBlocksAtHeight h = ask >>= getBlocksAtHeightDB h-    getBlock b = ask >>= getDatabaseReader b+    getTxData t = getTxDataDB t+    getSpender p = getSpenderDB p+    getUnspent a = getUnspentDB a+    getBalance a = getBalanceDB a+    getMempool = getMempoolDB+    getBestBlock = getBestDB+    getBlocksAtHeight h = getBlocksAtHeightDB h+    getBlock b = getDatabaseReader b+    countBlocks = incrementCounter databaseBlockCount+    countTxs = incrementCounter databaseTxCount+    countBalances = incrementCounter databaseBalanceCount+    countUnspents = incrementCounter databaseUnspentCount -instance MonadIO m => StoreReadExtra (DatabaseReaderT m) where-    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+instance MonadUnliftIO m => StoreReadExtra (DatabaseReaderT m) where+    getAddressesTxs as limits = getAddressesTxsDB as limits+    getAddressesUnspents as limits = getAddressesUnspentsDB as limits+    getAddressUnspents a limits = getAddressUnspentsDB a limits+    getAddressTxs a limits = getAddressTxsDB a limits     getMaxGap = asks databaseMaxGap     getInitialGap = asks databaseInitialGap-    getNumTxData t = ask >>= getNumTxDataDB t+    getNumTxData t = getNumTxDataDB t+    countTxRefs = incrementCounter databaseTxRefCount+    countXPubDerivations = incrementCounter databaseDerivations+

@@ -40,6 +40,7 @@ import           Haskoin.Store.Common          (StoreEvent (..)) import           Haskoin.Store.Database.Reader (DatabaseReader (..),                                                 DatabaseReaderT,+                                                createDatabaseStats,                                                 withDatabaseReader) import           NQE                           (Inbox, Process (..), Publisher,                                                 publishSTM, receive,@@ -125,12 +126,15 @@                  }  connectDB :: MonadUnliftIO m => StoreConfig -> DatabaseReaderT m a -> m a-connectDB cfg =+connectDB cfg f = do+    stats <- mapM createDatabaseStats (storeConfStats cfg)     withDatabaseReader           (storeConfNetwork cfg)           (storeConfInitialGap cfg)           (storeConfGap cfg)           (storeConfDB cfg)+          stats+          f  blockStoreCfg :: StoreConfig               -> Node

@@ -4,7 +4,6 @@     , withStats     , createStatDist     , addStatTime-    , addStatItems     , addClientError     , addServerError     , addStatQuery@@ -52,7 +51,6 @@     StatData     {         statTimes        :: ![Int64],-        statItems        :: !Int64,         statQueries      :: !Int64,         statClientErrors :: !Int64,         statServerErrors :: !Int64@@ -62,7 +60,6 @@     StatDist     {         distQueue        :: !(TQueue Int64),-        distItems        :: !(TVar Int64),         distQueries      :: !(TVar Int64),         distClientErrors :: !(TVar Int64),         distServerErrors :: !(TVar Int64)@@ -71,13 +68,11 @@ createStatDist :: MonadIO m => Text -> Store -> m StatDist createStatDist t store = liftIO $ do     q <- newTQueueIO-    items <- newTVarIO 0     queries <- newTVarIO 0     client_errors <- newTVarIO 0     server_errors <- newTVarIO 0     let metrics = HashMap.fromList             [ (t <> ".query_count",   Counter . statQueries)-            , (t <> ".item_count",    Counter . statItems)             , (t <> ".errors.client", Counter . statClientErrors)             , (t <> ".errors.server", Counter . statServerErrors)             , (t <> ".mean_ms",       Gauge . mean . statTimes)@@ -85,11 +80,10 @@             , (t <> ".max_ms",        Gauge . maxi . statTimes)             , (t <> ".min_ms",        Gauge . mini . statTimes)             , (t <> ".p90max_ms",     Gauge . p90max . statTimes)-            , (t <> ".p90min_ms",     Gauge . p90min . statTimes)             , (t <> ".p90avg_ms",     Gauge . p90avg . statTimes)             , (t <> ".var_ms",        Gauge . var . statTimes)             ]-    let sd = StatDist q items queries client_errors server_errors+    let sd = StatDist q queries client_errors server_errors     registerGroup metrics (flush sd) store     return sd @@ -100,10 +94,6 @@ addStatTime q =     liftIO . atomically . writeTQueue (distQueue q) -addStatItems :: MonadIO m => StatDist -> Int64 -> m ()-addStatItems q =-    liftIO . atomically . modifyTVar (distItems q) . (+)- addStatQuery :: MonadIO m => StatDist -> m () addStatQuery q =     liftIO . atomically $ modifyTVar (distQueries q) (+1)@@ -117,13 +107,12 @@     liftIO . atomically $ modifyTVar (distServerErrors q) (+1)  flush :: MonadIO m => StatDist -> m StatData-flush (StatDist q i n c s) = atomically $ do+flush (StatDist q n c s) = atomically $ do     ts <- flushTQueue q-    is <- readTVar i     qs <- readTVar n     ce <- readTVar c     se <- readTVar s-    return $ StatData ts is qs ce se+    return $ StatData ts qs ce se  average :: Fractional a => L.Fold a a average = (/) <$> L.sum <*> L.genericLength@@ -150,16 +139,6 @@         h:_ -> h   where     sorted = sortBy (comparing Down) ls-    len = length sorted-    chopped = drop (length sorted * 1 `div` 10) sorted--p90min :: [Int64] -> Int64-p90min ls =-    case chopped of-        []  -> 0-        h:_ -> h-  where-    sorted = sort ls     len = length sorted     chopped = drop (length sorted * 1 `div` 10) sorted 

@@ -260,7 +260,6 @@      -- Request     , statKey         :: !(V.Key (TVar (Maybe (WebMetrics -> StatDist))))-    , itemsKey        :: !(V.Key (TVar Int))     }  createMetrics :: MonadIO m => Metrics.Store -> m WebMetrics@@ -338,7 +337,6 @@      statEvents <- g "events.connected"     statKey <- V.newKey-    itemsKey <- V.newKey     return WebMetrics{..}   where     d x = createStatDist       ("web." <> x) s@@ -362,16 +360,6 @@     start m = liftIO $ Metrics.Gauge.inc (gf m)     end m = liftIO $ Metrics.Gauge.dec (gf m) -setCount :: MonadUnliftIO m => Int -> WebT m ()-setCount i =-    asks webMetrics >>= mapM_ go-  where-    go m = do-        req <- S.request-        let t = fromMaybe e $ V.lookup (itemsKey m) (vault req)-        atomically $ writeTVar t i-    e = error "do not count on me"- setMetrics :: MonadUnliftIO m            => (WebMetrics -> StatDist)            -> WebT m ()@@ -879,7 +867,6 @@         Nothing ->             raise ThingNotFound         Just b -> do-            setCount 1             return $ pruneTx noTx b  getBlocks :: (MonadUnliftIO m, MonadLoggerIO m)@@ -894,7 +881,6 @@ scottyBlocks (GetBlocks hs (NoTx notx)) = do     setMetrics statBlock     bs <- getBlocks hs notx-    setCount (length bs)     return bs  pruneTx :: Bool -> BlockData -> BlockData@@ -908,7 +894,6 @@ scottyBlockRaw (GetBlockRaw h) = do     setMetrics statBlockRaw     b <- getRawBlock h-    setCount 1     return $ RawResult b  getRawBlock :: (MonadUnliftIO m, MonadLoggerIO m)@@ -940,7 +925,6 @@         Just bb -> getBlock bb >>= \case             Nothing -> raise ThingNotFound             Just b  -> do-              setCount 1               return $ pruneTx notx b  scottyBlockBestRaw ::@@ -953,7 +937,6 @@         Nothing -> raise ThingNotFound         Just bb -> do           b <- getRawBlock bb-          setCount 1           return $ RawResult b  -- GET BlockLatest --@@ -967,7 +950,6 @@     blocks <- getBestBlock >>= maybe         (raise ThingNotFound)         (go [] <=< getBlock)-    setCount (length blocks)     return blocks   where     go acc Nothing = return $ reverse acc@@ -985,7 +967,6 @@ scottyBlockHeight (GetBlockHeight h (NoTx notx)) = do     setMetrics statBlock     blocks <- (`getBlocks` notx) =<< getBlocksAtHeight (fromIntegral h)-    setCount (length blocks)     return blocks  scottyBlockHeights ::@@ -996,7 +977,6 @@     setMetrics statBlock     bhs <- concat <$> mapM getBlocksAtHeight (fromIntegral <$> heights)     blocks <- getBlocks bhs notx-    setCount (length blocks)     return blocks  scottyBlockHeightRaw ::@@ -1006,7 +986,6 @@ scottyBlockHeightRaw (GetBlockHeightRaw h) = do     setMetrics statBlockRaw     blocks <- mapM getRawBlock =<< getBlocksAtHeight (fromIntegral h)-    setCount (length blocks)     return $ RawResultList blocks  -- GET BlockTime / BlockTimeRaw --@@ -1019,7 +998,6 @@     blockAtOrBefore ch t >>= \case         Nothing -> raise ThingNotFound         Just b -> do-            setCount 1             return $ pruneTx notx b  scottyBlockMTP :: (MonadUnliftIO m, MonadLoggerIO m)@@ -1030,7 +1008,6 @@     blockAtOrAfterMTP ch t >>= \case         Nothing -> raise ThingNotFound         Just b -> do-            setCount 1             return $ pruneTx notx b  scottyBlockTimeRaw :: (MonadUnliftIO m, MonadLoggerIO m)@@ -1042,7 +1019,6 @@         Nothing -> raise ThingNotFound         Just b -> do             raw <- lift $ toRawBlock b-            setCount 1             return $ RawResult raw  scottyBlockMTPRaw :: (MonadUnliftIO m, MonadLoggerIO m)@@ -1054,7 +1030,6 @@         Nothing -> raise ThingNotFound         Just b -> do             raw <- lift $ toRawBlock b-            setCount 1             return $ RawResult raw  -- GET Transactions --@@ -1065,7 +1040,6 @@     getTransaction txid >>= \case         Nothing -> raise ThingNotFound         Just tx -> do-            setCount 1             return tx  scottyTxs ::@@ -1073,7 +1047,6 @@ scottyTxs (GetTxs txids) = do     setMetrics statTransaction     txs <- catMaybes <$> mapM f (nub txids)-    setCount (length txs)     return txs   where     f x = lift $ withRunInIO $ \run ->@@ -1087,7 +1060,6 @@     getTransaction txid >>= \case         Nothing -> raise ThingNotFound         Just tx -> do-            setCount 1             return $ RawResult (transactionData tx)  scottyTxsRaw ::@@ -1097,7 +1069,6 @@ scottyTxsRaw (GetTxsRaw txids) = do     setMetrics statTransactionRaw     txs <- catMaybes <$> mapM f (nub txids)-    setCount (length txs)     return $ RawResultList $ transactionData <$> txs   where     f x = lift $ withRunInIO $ \run ->@@ -1124,7 +1095,6 @@ scottyTxsBlock (GetTxsBlock h) = do     setMetrics statTransactionsBlock     txs <- getTxsBlock h-    setCount (length txs)     return txs  scottyTxsBlockRaw ::@@ -1134,7 +1104,6 @@ scottyTxsBlockRaw (GetTxsBlockRaw h) = do     setMetrics statTransactionsBlockRaw     txs <- fmap transactionData <$> getTxsBlock h-    setCount (length txs)     return $ RawResultList txs  -- GET TransactionAfterHeight --@@ -1145,7 +1114,6 @@     -> WebT m (GenericResult (Maybe Bool)) scottyTxAfter (GetTxAfter txid height) = do     setMetrics statTransactionAfter-    setCount 1     GenericResult <$> cbAfterHeight (fromIntegral height) txid  -- | Check if any of the ancestors of this transaction is a coinbase after the@@ -1188,7 +1156,7 @@ scottyPostTx (PostTx tx) = do     setMetrics statTransactionPost     lift (asks webConfig) >>= \cfg -> lift (publishTx cfg tx) >>= \case-        Right ()             -> setCount 1 >> return (TxId (txHash tx))+        Right ()             -> return (TxId (txHash tx))         Left e@(PubReject _) -> raise $ UserError (show e)         _                    -> raise ServerError @@ -1248,7 +1216,6 @@     let wl' = wl { maxLimitCount = 0 }         l = Limits (validateLimit wl' False limitM) (fromIntegral o) Nothing     ths <- map snd . applyLimits l <$> getMempool-    setCount (length ths)     return ths  scottyEvents :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()@@ -1284,7 +1251,6 @@ scottyAddrTxs (GetAddrTxs addr pLimits) = do     setMetrics statAddressTransactions     txs <- getAddressTxs addr =<< paramToLimits False pLimits-    setCount (length txs)     return txs  scottyAddrsTxs ::@@ -1292,7 +1258,6 @@ scottyAddrsTxs (GetAddrsTxs addrs pLimits) = do     setMetrics statAddressTransactions     txs <- getAddressesTxs addrs =<< paramToLimits False pLimits-    setCount (length txs)     return txs  scottyAddrTxsFull ::@@ -1303,7 +1268,6 @@     setMetrics statAddressTransactionsFull     txs <- getAddressTxs addr =<< paramToLimits True pLimits     ts <- catMaybes <$> mapM (getTransaction . txRefHash) txs-    setCount (length ts)     return ts  scottyAddrsTxsFull :: (MonadUnliftIO m, MonadLoggerIO m)@@ -1312,14 +1276,12 @@     setMetrics statAddressTransactionsFull     txs <- getAddressesTxs addrs =<< paramToLimits True pLimits     ts <- catMaybes <$> mapM (getTransaction . txRefHash) txs-    setCount (length ts)     return ts  scottyAddrBalance :: (MonadUnliftIO m, MonadLoggerIO m)                   => GetAddrBalance -> WebT m Balance scottyAddrBalance (GetAddrBalance addr) = do     setMetrics statAddressBalance-    setCount 1     getDefaultBalance addr  scottyAddrsBalance ::@@ -1327,7 +1289,6 @@ scottyAddrsBalance (GetAddrsBalance addrs) = do     setMetrics statAddressBalance     balances <- getBalances addrs-    setCount (length balances)     return balances  scottyAddrUnspent ::@@ -1335,7 +1296,6 @@ scottyAddrUnspent (GetAddrUnspent addr pLimits) = do     setMetrics statAddressUnspent     unspents <- getAddressUnspents addr =<< paramToLimits False pLimits-    setCount (length unspents)     return unspents  scottyAddrsUnspent ::@@ -1343,7 +1303,6 @@ scottyAddrsUnspent (GetAddrsUnspent addrs pLimits) = do     setMetrics statAddressUnspent     unspents <- getAddressesUnspents addrs =<< paramToLimits False pLimits-    setCount (length unspents)     return unspents  -- GET XPubs --@@ -1354,7 +1313,6 @@     setMetrics statXpub     let xspec = XPubSpec xpub deriv     xbals <- xPubBals xspec-    setCount (length xbals)     lift . runNoCache noCache $ xPubSummary xspec xbals  scottyDelXPub :: (MonadUnliftIO m, MonadLoggerIO m)@@ -1364,7 +1322,6 @@     let xspec = XPubSpec xpub deriv     cacheM <- lift (asks (storeCache . webStore . webConfig))     n <- lift $ withCache cacheM (cacheDelXPubs [xspec])-    setCount (fromIntegral n)     return (GenericResult (n > 0))  getXPubTxs :: (MonadUnliftIO m, MonadLoggerIO m)@@ -1380,7 +1337,6 @@ scottyXPubTxs (GetXPubTxs xpub deriv plimits (NoCache nocache)) = do     setMetrics statXpubTransactions     txs <- getXPubTxs xpub deriv plimits nocache-    setCount (length txs)     return txs  scottyXPubTxsFull ::@@ -1393,7 +1349,6 @@     txs <- fmap catMaybes $            lift . runNoCache nocache $            mapM (getTransaction . txRefHash) refs-    setCount (length txs)     return txs  scottyXPubBalances ::@@ -1401,7 +1356,6 @@ scottyXPubBalances (GetXPubBalances xpub deriv (NoCache noCache)) = do     setMetrics statXpubBalances     balances <- filter f <$> lift (runNoCache noCache (xPubBals spec))-    setCount (length balances)     return balances   where     spec = XPubSpec xpub deriv@@ -1417,7 +1371,6 @@     let xspec = XPubSpec xpub deriv     xbals <- xPubBals xspec     unspents <- lift . runNoCache noCache $ xPubUnspents xspec xbals limits-    setCount (length unspents)     return unspents  ---------------------------------------@@ -1522,7 +1475,6 @@     bus <- lift . runConduit $            getBinfoUnspents numtxid height xspecs' addrs .|            (dropWhileC mn >> takeC limit .| sinkList)-    setCount (length bus)     setHeaders     streamEncoding (binfoUnspentsToEncoding net (BinfoUnspents bus))   where@@ -1682,7 +1634,6 @@     net <- lift $ asks (storeNetwork . webStore . webConfig)     rates <- map binfoRatePrice <$> lift (getRates net code times)     let hs = zipWith (convert cur aaddrs) txs (rates <> repeat 0.0)-    setCount (length hs)     setHeaders     streamEncoding $ toEncoding hs   where@@ -1754,7 +1705,6 @@     ch <- lift $ asks (storeChain . webStore . webConfig)     m <- blockAtOrBefore ch t     bs <- go (d t) m-    setCount (length bs)     streamEncoding $ toEncoding $ map toBinfoBlockInfo bs   where     h = fromIntegral (maxBound :: H.Timestamp)@@ -1832,9 +1782,6 @@             , getBinfoBTC = coin             , getBinfoLatestBlock = block             }-    setCount $ sum (map length (HashMap.elems xbals))-             + HashMap.size abals-             + length ftxs     setHeaders     streamEncoding $ binfoMultiAddrToEncoding net         BinfoMultiAddr@@ -1980,7 +1927,6 @@                          fromIntegral amnt                  , binfoRawTxs = txs                  }-        setCount (length xbals + length txs)         setHeaders         streamEncoding $ binfoRawAddrToEncoding net ra     compute_abook xpub xbals =@@ -2024,7 +1970,6 @@                          fromIntegral amnt                  , binfoRawTxs = txs                  }-        setCount (length txs)         setHeaders         streamEncoding $ binfoRawAddrToEncoding net ra @@ -2033,7 +1978,6 @@     setMetrics statBlockchainQgetreceivedbyaddress     a <- getAddress "addr"     b <- fromMaybe (zeroBalance a) <$> getBalance a-    setCount 1     setHeaders     S.text . cs . show $ balanceTotalReceived b @@ -2042,7 +1986,6 @@     setMetrics statBlockchainQgetsentbyaddress     a <- getAddress "addr"     b <- fromMaybe (zeroBalance a) <$> getBalance a-    setCount 1     setHeaders     S.text . cs . show $ balanceTotalReceived b - balanceAmount b - balanceZero b @@ -2051,7 +1994,6 @@     setMetrics statBlockchainQaddressbalance     a <- getAddress "addr"     b <- fromMaybe (zeroBalance a) <$> getBalance a-    setCount 1     setHeaders     S.text . cs . show $ balanceAmount b + balanceZero b @@ -2064,7 +2006,6 @@     let top = H.nodeHeight bb         bot = 0     i <- go ch bb a bot top-    setCount 1     setHeaders     S.text . cs $ show i   where@@ -2097,7 +2038,6 @@              mapM (get_addr_balance net cashaddr) (HashSet.toList addrs)     xbals <- mapM (get_xspec_balance net) (HashMap.elems xspecs)     let res = HashMap.fromList (abals <> xbals)-    setCount (HashMap.size res)     setHeaders     streamEncoding $ toEncoding res   where@@ -2152,7 +2092,6 @@     next_block_headers <- catMaybes <$> mapM getBlock next_block_hashes     binfo_blocks <-         mapM (get_binfo_blocks numtxid next_block_headers) block_headers-    setCount (length binfo_blocks)     setHeaders     net <- lift $ asks (storeNetwork . webStore . webConfig)     streamEncoding $ binfoBlocksToEncoding net binfo_blocks@@ -2183,7 +2122,6 @@         binfoHeaderTime = H.blockTimestamp (blockDataHeader best)         binfoHeaderIndex = binfoHeaderTime         binfoHeaderHeight = blockDataHeight best-    setCount 1     streamEncoding $ toEncoding BinfoHeader{..}   where     get_best_block =@@ -2232,7 +2170,6 @@               else do                 let btxs = map (toBinfoTxSimple numtxid) txs                     y = toBinfoBlock b btxs nxt-                setCount 1                 setHeaders                 net <- lift $ asks (storeNetwork . webStore . webConfig)                 streamEncoding $ binfoBlockToEncoding net y@@ -2259,7 +2196,6 @@     tx <- getBinfoTx txid >>= \case               Right t -> return t               Left e  -> raise e-    setCount 1     if hex then hx tx else js numtxid tx   where     js numtxid t = do@@ -2277,7 +2213,6 @@     tx <- getBinfoTx txid >>= \case               Right t -> return t               Left e  -> raise e-    setCount 1     S.text . cs . show . sum . map outputAmount $ transactionOutputs tx  scottyBinfoTxFees :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()@@ -2290,7 +2225,6 @@     let i = sum . map inputAmount . filter f $             transactionInputs tx         o = sum . map outputAmount $ transactionOutputs tx-    setCount 1     S.text . cs . show $ i - o   where     f StoreInput{}    = True@@ -2308,7 +2242,6 @@             transactionInputs tx         o = toInteger . sum . map outputAmount . filter (g addr) $             transactionOutputs tx-    setCount 1     S.text . cs . show $ o - i   where     f addr StoreInput{inputAddress = Just a} = a == addr@@ -2325,7 +2258,6 @@     tx <- getBinfoTx txid >>= \case               Right t -> return t               Left e  -> raise e-    setCount 1     S.text . cs . show . sum . map inputAmount . filter f $ transactionInputs tx   where     f StoreInput{}    = True@@ -2341,7 +2273,6 @@     let txids = map snd $ take n $ drop offset mempool     txs <- catMaybes <$> mapM getTransaction txids     net <- lift $ asks (storeNetwork . webStore . webConfig)-    setCount (length txs)     setHeaders     let mem = BinfoMempool $ map (toBinfoTxSimple numtxid) txs     streamEncoding $ binfoMempoolToEncoding net mem@@ -2352,7 +2283,6 @@     ch <- asks (storeChain . webStore . webConfig)     bn <- chainGetBest ch     setHeaders-    setCount 1     S.text . cs . show $ H.nodeHeight bn  scottyBinfoLatestHash :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()@@ -2360,7 +2290,6 @@     setMetrics statBlockchainQlatesthash     ch <- asks (storeChain . webStore . webConfig)     bn <- chainGetBest ch-    setCount 1     setHeaders     S.text . TL.fromStrict . H.blockHashToHex . H.headerHash $ H.nodeHeader bn @@ -2370,7 +2299,6 @@     ch <- asks (storeChain . webStore . webConfig)     net <- asks (storeNetwork . webStore . webConfig)     bn <- chainGetBest ch-    setCount 1     setHeaders     S.text . cs . show . (/ (100 * 1000 * 1000 :: Double)) . fromIntegral $         H.computeSubsidy net (H.nodeHeight bn + 1)@@ -2379,7 +2307,6 @@ scottyBinfoAddrToHash = do     setMetrics statBlockchainQaddresstohash     addr <- getAddress "addr"-    setCount 1     setHeaders     S.text . encodeHexLazy . runPutL . serialize $ getAddrHash160 addr @@ -2390,7 +2317,6 @@     net <- asks (storeNetwork . webStore . webConfig)     hash <- either (const S.next) return (decode bs)     addr <- maybe S.next return (addrToText net (PubKeyAddress hash))-    setCount 1     setHeaders     S.text $ TL.fromStrict addr @@ -2401,7 +2327,6 @@   pubkey <- maybe S.next (return . pubKeyAddr) $       eitherToMaybe . runGetS deserialize =<< decodeHex hex   net <- lift $ asks (storeNetwork . webStore . webConfig)-  setCount 1   setHeaders   case addrToText net pubkey of       Nothing -> raise ThingNotFound@@ -2418,7 +2343,6 @@     pk <- case extr addr i of         Left e  -> raise $ UserError e         Right t -> return t-    setCount 1     setHeaders     S.text $ encodeHexLazy $ L.fromStrict pk   where@@ -2457,7 +2381,6 @@   addr <- case pkm of       Nothing -> raise $ UserError "Could not decode public key"       Just pk -> return $ pubKeyAddr pk-  setCount 1   setHeaders   S.text . encodeHexLazy . runPutL . serialize $ getAddrHash160 addr @@ -2471,7 +2394,6 @@     setMetrics statPeers     peers <- lift $ getPeersInformation =<<              asks (storeManager . webStore . webConfig)-    setCount (length peers)     return peers  -- | Obtain information about connected peers from peer manager process.@@ -2502,7 +2424,6 @@     setMetrics statHealth     h <- lift $ asks webConfig >>= healthCheck     unless (isOK h) $ S.status status503-    setCount 1     return h  blockHealthCheck :: (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m)@@ -2580,7 +2501,6 @@     setHeaders     db <- lift $ asks (databaseHandle . storeDB . webStore . webConfig)     statsM <- lift (getProperty db Stats)-    setCount 1     S.text $ maybe "Could not get stats" cs statsM  -----------------------@@ -2732,9 +2652,7 @@                    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') $ \_ ->@@ -2752,10 +2670,9 @@         b <- old_body         unless (B.null b) . atomically $ modifyTVar var (<> b)         return b-    add_stat d i s = do+    add_stat d s = do         addStatQuery s         addStatTime s d-        addStatItems s (fromIntegral i)     end var runner req t1 = do         t2 <- systemToUTCTime <$> getSystemTime         let diff = round $ diffUTCTime t2 t1 * 1000@@ -2763,17 +2680,13 @@             Nothing -> return ()             Just m -> do                 let m_stat_var = V.lookup (statKey m) (vault req)-                    m_item_var = V.lookup (itemsKey m) (vault req)-                i <- case m_item_var of-                    Nothing       -> return 0-                    Just item_var -> readTVarIO item_var-                add_stat diff i (statAll m)+                add_stat diff (statAll m)                 case m_stat_var of                     Nothing -> return ()                     Just stat_var ->                         readTVarIO stat_var >>= \case                             Nothing -> return ()-                            Just f  -> add_stat diff i (f m)+                            Just f  -> add_stat diff (f m)         when (diff > 10000) $ do             b <- readTVarIO var             runner $ $(logWarnS) "Web" $