haskoin-store 0.55.0 → 0.56.0

raw patch · 4 files changed

+37/−22 lines, 4 filesdep ~haskoin-store-dataPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskoin-store-data

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• haskoin-store.cabal +4/−4
• src/Haskoin/Store/BlockStore.hs +5/−4
• src/Haskoin/Store/Logic.hs +23/−14

@@ -4,6 +4,11 @@ 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.56.0+### Changed+- Report all deleted mempool transactions.+- Crash on certain data corruption.+ ## 0.55.0 ### Changed - Always have a previous output object in Blockchain inputs.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-store-version:        0.55.0+version:        0.56.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@@ -60,7 +60,7 @@     , hashable >=1.3.0.0     , haskoin-core >=0.21.0     , haskoin-node >=0.17.0-    , haskoin-store-data ==0.55.0+    , haskoin-store-data ==0.56.0     , hedis >=0.12.13     , http-types >=0.12.3     , lens >=4.18.1@@ -116,7 +116,7 @@     , haskoin-core >=0.21.0     , haskoin-node >=0.17.0     , haskoin-store-    , haskoin-store-data ==0.55.0+    , haskoin-store-data ==0.56.0     , hedis >=0.12.13     , http-types >=0.12.3     , lens >=4.18.1@@ -177,7 +177,7 @@     , haskoin-core >=0.21.0     , haskoin-node >=0.17.0     , haskoin-store-    , haskoin-store-data ==0.55.0+    , haskoin-store-data ==0.56.0     , hedis >=0.12.13     , hspec >=2.7.1     , http-types >=0.12.3

@@ -391,15 +391,15 @@         <> " from peer: " <> peerText peer     lift $ runImport (importBlock block node) >>= \case         Left e   -> failure e-        Right () -> success node+        Right ths -> success node ths   where     header = blockHeader block     blockhash = headerHash header     hexhash = blockHashToHex blockhash-    success node = do+    success node ths = do         $(logInfoS) "BlockStore" $             "Best block: " <> blockText node (Just block)-        notify+        notify ths         removeSyncingBlock $ headerHash $ nodeHeader node         touchPeer         isInSync >>= \case@@ -413,8 +413,9 @@             <> " from peer: " <> peerText peer <> ": "             <> cs (show e)         killPeer (PeerMisbehaving (show e)) peer-    notify = do+    notify ths = do         listener <- asks (blockConfListener . myConfig)+        mapM_ ((`publish` listener) . StoreMempoolDelete) ths         publish (StoreBestBlock blockhash) listener  setSyncingBlocks :: (MonadReader BlockStore m, MonadIO m)

@@ -16,7 +16,7 @@     ) where  import           Control.Monad           (forM, forM_, guard, unless, void,-                                          when, zipWithM_)+                                          when, zipWithM_, (<=<)) import           Control.Monad.Except    (MonadError, throwError) import           Control.Monad.Logger    (MonadLoggerIO (..), logDebugS,                                           logErrorS)@@ -67,6 +67,7 @@     | DuplicatePrevOutput     | TxSpent     | OrphanLoop+    | SpenderNotFound     deriving (Eq, Ord, Exception)  instance Show ImportException where@@ -82,6 +83,7 @@     show DuplicatePrevOutput = "Duplicate previous output"     show TxSpent             = "Transaction is spent"     show OrphanLoop          = "Orphan loop"+    show SpenderNotFound     = "Spender not found"  initBest :: MonadImport m => m () initBest = do@@ -166,10 +168,11 @@                     <> blockHashToHex (headerHash (blockHeader b))                 throwError PrevBlockNotBest -importOrConfirm :: MonadImport m => BlockNode -> [Tx] -> m ()+importOrConfirm :: MonadImport m => BlockNode -> [Tx] -> m (HashSet TxHash) importOrConfirm bn txns = do-    mapM_ (freeOutputs True False . snd) (reverse txs)+    ths <- foldl (<>) HashSet.empty <$> mapM (freeOutputs True False . snd) (reverse txs)     mapM_ (uncurry action) txs+    return ths   where     txs = sortTxs txns     br i = BlockRef {blockRefHeight = nodeHeight bn, blockRefPos = i}@@ -197,7 +200,7 @@         importTx (br i) bn_time False tx         return Nothing -importBlock :: MonadImport m => Block -> BlockNode -> m ()+importBlock :: MonadImport m => Block -> BlockNode -> m (HashSet TxHash) importBlock b n = do     $(logDebugS) "BlockStore" $         "Checking new block: "@@ -227,10 +230,11 @@         (nub (headerHash (nodeHeader n) : bs))         (nodeHeight n)     setBest (headerHash (nodeHeader n))-    importOrConfirm n (blockTxns b)+    ths <- importOrConfirm n (blockTxns b)     $(logDebugS) "BlockStore" $         "Finished importing transactions for: "         <> blockHashToHex (headerHash (nodeHeader n))+    return ths   where     cb_out_val =         sum $ map outValue $ txOut $ head $ blockTxns b@@ -394,32 +398,37 @@     let prevs = prevOuts tx     unspents <- mapM getUnspent prevs     let spents = map fst $ filter (isNothing . snd) $ zip prevs unspents-    spndrs <- catMaybes <$> mapM getSpender spents+    spndrs <- mapM (spender <=< getSpender) spents     let txids = HashSet.fromList $ filter (/= txHash tx) $ map spenderHash spndrs-    mapM (deleteTx memonly rbfcheck) $ HashSet.toList txids-    return txids+    del <- fmap concat $ mapM (deleteTx memonly rbfcheck) $ HashSet.toList txids+    return $ HashSet.fromList del+  where+    spender Nothing  = throwError SpenderNotFound+    spender (Just s) = return s -deleteConfirmedTx :: MonadImport m => TxHash -> m ()+deleteConfirmedTx :: MonadImport m => TxHash -> m [TxHash] deleteConfirmedTx = deleteTx False False -deleteUnconfirmedTx :: MonadImport m => Bool -> TxHash -> m ()+deleteUnconfirmedTx :: MonadImport m => Bool -> TxHash -> m [TxHash] deleteUnconfirmedTx rbfcheck th =     getActiveTxData th >>= \case         Just _ -> deleteTx True rbfcheck th-        Nothing -> $(logDebugS) "BlockStore" $-                   "Not found or already deleted: " <> txHashToHex th+        Nothing -> do+          $(logDebugS) "BlockStore" $+              "Not found or already deleted: " <> txHashToHex th+          return []  deleteTx :: MonadImport m          => Bool -- ^ only delete transaction if unconfirmed          -> Bool -- ^ only delete RBF          -> TxHash-         -> m ()+         -> m [TxHash] deleteTx memonly rbfcheck th = do     chain <- getChain memonly rbfcheck th     $(logDebugS) "BlockStore" $         "Deleting " <> cs (show (length chain)) <>         " txs from chain leading to " <> txHashToHex th-    mapM_ (deleteSingleTx . txHash) chain+    mapM (\t -> let h = txHash t in deleteSingleTx h >> return h) chain  getChain :: (MonadImport m, MonadLoggerIO m)          => Bool -- ^ only delete transaction if unconfirmed