packages feed

haskoin-store 1.4.0 → 1.5.0

raw patch · 8 files changed

+67/−40 lines, 8 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

app/Main.hs view
@@ -68,10 +68,16 @@ import System.Exit (exitSuccess) import System.FilePath ((</>)) import System.Metrics.StatsD-    ( defStatConfig,-      withStats,-      StatConfig(statsdPort, statsdServer, namespace, reportSamples,-                 reportStats) )+  ( StatConfig+      ( namespace,+        reportSamples,+        reportStats,+        statsdPort,+        statsdServer+      ),+    defStatConfig,+    withStats,+  ) import Text.Read (readMaybe) import UnliftIO (MonadIO) import UnliftIO.Directory
haskoin-store.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-store-version:        1.4.0+version:        1.5.0 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
src/Haskoin/Store.hs view
@@ -27,7 +27,7 @@     getTransaction,     getDefaultBalance,     getActiveTxData,-    blockAtOrBefore+    blockAtOrBefore,   ) where
src/Haskoin/Store/BlockStore.hs view
@@ -238,8 +238,11 @@ newStoreMetrics cfg =   forM cfg.stats $ \s -> liftIO $ do     m <- withDB cfg.db getMempool-    b <- fmap (maybe 0 (.height)) $ withDB cfg.db $ runMaybeT $-        MaybeT getBestBlock >>= MaybeT . getBlock+    b <-+      fmap (maybe 0 (.height)) $+        withDB cfg.db $+          runMaybeT $+            MaybeT getBestBlock >>= MaybeT . getBlock     h <- chainGetBest cfg.chain     p <- getPeers cfg.peerMgr     blocks <- g s "blocks" (fromIntegral b)
src/Haskoin/Store/Common.hs view
@@ -54,6 +54,8 @@ import Control.Monad.Trans.Reader (runReaderT) import Data.ByteString (ByteString) import Data.Default (Default (..))+import Data.Graph qualified as G+import Data.HashMap.Strict qualified as M import Data.HashSet qualified as H import Data.Hashable (Hashable) import Data.Map.Strict qualified as Map@@ -196,13 +198,13 @@     rx = sum [b.balance.received | b <- xt]  getTransaction ::-  ( StoreReadBase m) =>TxHash -> m (Maybe Transaction)+  (StoreReadBase m) => TxHash -> m (Maybe Transaction) getTransaction h = do   ctx <- getCtx   fmap (toTransaction ctx) <$> getTxData h  getNumTransaction ::-  ( StoreReadExtra m) =>Word64 -> m [Transaction]+  (StoreReadExtra m) => Word64 -> m [Transaction] getNumTransaction i =   getCtx >>= \ctx ->     map (toTransaction ctx) <$> getNumTxData i@@ -286,17 +288,21 @@ applyLimitC l = takeC (fromIntegral l)  sortTxs :: [Tx] -> [(Word32, Tx)]-sortTxs txs = go [] thset $ zip [0 ..] txs+sortTxs txs = ts   where-    thset = H.fromList (map txHash txs)-    go [] _ [] = []-    go orphans ths [] = go [] ths orphans-    go orphans ths ((i, tx) : xs) =-      let ops = map (.outpoint.hash) tx.inputs-          orp = any (`H.member` ths) ops-       in if orp-            then go ((i, tx) : orphans) ths xs-            else (i, tx) : go orphans (txHash tx `H.delete` ths) xs+    hm :: M.HashMap TxHash Int+    hm = M.fromList $ zip (map txHash txs) [0 ..]+    ns :: [(Tx, Int, [Int])]+    ns =+      let is tx = nub' $ map (.outpoint.hash) tx.inputs+          hs tx = mapMaybe (`M.lookup` hm) (is tx)+          tp i tx = (tx, i, hs tx)+       in zipWith tp [0 ..] txs+    (g, n, _) = G.graphFromEdges ns+    vs = G.reverseTopSort g+    ts =+      let f (tx, i, _) = (fromIntegral i, tx)+       in map (f . n) vs  nub' :: (Hashable a) => [a] -> [a] nub' = H.toList . H.fromList
src/Haskoin/Store/Logic.hs view
@@ -39,7 +39,8 @@   ) import qualified Data.ByteString as B import Data.Either (rights)-import qualified Data.HashSet as HashSet+import qualified Data.HashMap.Strict as M+import qualified Data.HashSet as H import qualified Data.IntMap.Strict as I import Data.List (nub) import Data.Maybe@@ -199,7 +200,9 @@  importOrConfirm :: (MonadImport m) => BlockNode -> [Tx] -> m [TxData] importOrConfirm bn txns = do+  $(logDebugS) "BlockStore" "Freeing outputs..."   mapM_ (freeOutputs True False . snd) (reverse txs)+  $(logDebugS) "BlockStore" "Outputs freed"   mapM (uncurry action) txs   where     txs = sortTxs txns@@ -441,12 +444,14 @@   Tx ->   m () freeOutputs memonly rbfcheck tx = do+  $(logDebugS) "BlockStore" $+    "Freeing outputs for tx " <> txHashToHex (txHash tx) <> "..."   let prevs = prevOuts tx   unspents <- mapM getUnspent prevs   let spents = [p | (p, Nothing) <- zip prevs unspents]   spndrs <- catMaybes <$> mapM getSpender spents-  let txids = HashSet.fromList $ filter (/= txHash tx) $ map (.txid) spndrs-  mapM_ (deleteTx memonly rbfcheck) $ HashSet.toList txids+  let txids = H.fromList $ filter (/= txHash tx) $ map (.txid) spndrs+  mapM_ (deleteTx memonly rbfcheck) $ H.toList txids  deleteConfirmedTx :: (MonadImport m) => TxHash -> m () deleteConfirmedTx = deleteTx False False@@ -487,7 +492,7 @@ getChain memonly rbfcheck th' = do   $(logDebugS) "BlockStore" $     "Getting chain for tx " <> txHashToHex th'-  sort_clean <$> go HashSet.empty (HashSet.singleton th')+  sort_clean <$> go M.empty (H.singleton th')   where     sort_clean = reverse . map snd . sortTxs     get_tx th =@@ -511,18 +516,23 @@                       <> txHashToHex th                   throwError DoubleSpend           | otherwise -> return $ Just td-    go txs pdg = do-      tds <- catMaybes <$> mapM get_tx (HashSet.toList pdg)-      let txsn = HashSet.fromList $ fmap (.tx) tds-          pdgn =-            HashSet.fromList-              . concatMap (map (.txid) . I.elems)-              $ fmap (.spenders) tds-          txs' = txsn <> txs-          pdg' = pdgn `HashSet.difference` HashSet.map txHash txs'-      if HashSet.null pdg'-        then return $ HashSet.toList txs'-        else go txs' pdg'+    go txm pdg = do+      let ths = filter (not . (`M.member` txm)) (H.toList pdg)+      tds <- catMaybes <$> mapM get_tx ths+      let txmn = M.fromList $ fmap (\d -> (txHash d.tx, d.tx)) tds+          spds = concatMap (map (.txid) . I.elems . (.spenders)) tds+          pdg' = H.fromList spds+          txm' = txmn <> txm+      if H.null pdg'+        then do+          $(logDebugS) "BlockStore" $+            "Chain for tx "+              <> txHashToHex th'+              <> " contains "+              <> cs (show (M.size txm'))+              <> " txs"+          return $ M.elems txm'+        else go txm' pdg'  deleteSingleTx :: (MonadImport m) => TxHash -> m () deleteSingleTx th =
src/Haskoin/Store/Web.hs view
@@ -46,8 +46,9 @@   ( forM_,     forever,     unless,+    void,     when,-    (<=<), void,+    (<=<),   ) import Control.Monad.Logger   ( MonadLoggerIO,@@ -196,6 +197,7 @@     MonadUnliftIO,     TVar,     askRunInIO,+    async,     atomically,     bracket,     bracket_,@@ -204,7 +206,7 @@     newTVarIO,     readTVarIO,     withAsync,-    writeTVar, async,+    writeTVar,   ) import UnliftIO.Concurrent (threadDelay) import Web.Scotty.Trans qualified as S
test/Haskoin/StoreSpec.hs view
@@ -17,8 +17,8 @@ import Data.ByteString qualified as B import Data.ByteString.Base64 import Data.Either-import Data.List ( find )-import Data.Maybe ( fromJust, fromMaybe, isJust, mapMaybe )+import Data.List (find)+import Data.Maybe (fromJust, fromMaybe, isJust, mapMaybe) import Data.Serialize import Data.Time.Clock.POSIX import Data.Word