haskoin-store 0.53.3 → 0.53.4
raw patch · 3 files changed
+97/−70 lines, 3 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 +8/−0
- haskoin-store.cabal +5/−5
- src/Haskoin/Store/Logic.hs +84/−65
CHANGELOG.md view
@@ -4,6 +4,14 @@ 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.53.4+### Added+- Debugging when reverting block.++### Fixed+- Negative (headers - blocks) diff shown incorrectly.+- Infinite loop when removing a block's coinbase transaction.+ ## 0.53.3 ### Added - Blockchain.info endpoint: `q/pubkeyhash/:addr`.
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b3b7762ba16d37c51367999ec82a9bf98fde10493c5fa48171a6a05ca6e94d45+-- hash: 5335e9cbdcb9bb2776876aaebeb3be20dfb8c6bcb2a98ab0f6fff39e89f897d9 name: haskoin-store-version: 0.53.3+version: 0.53.4 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.3+ , haskoin-store-data ==0.53.4 , 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.3+ , haskoin-store-data ==0.53.4 , 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.3+ , haskoin-store-data ==0.53.4 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/Logic.hs view
@@ -15,36 +15,36 @@ , deleteUnconfirmedTx ) where -import Conduit (ConduitT, await, lift, sealConduitT,- yield, ($$++))-import Control.Monad (forM, forM_, guard, unless, void, when,- zipWithM_)-import Control.Monad.Except (MonadError, throwError)-import Control.Monad.Logger (MonadLoggerIO (..), logDebugS, logErrorS)-import qualified Data.ByteString as B-import Data.Either (rights)-import Data.Function (on)-import qualified Data.IntMap.Strict as I-import Data.List (nub, sortBy)-import qualified Data.Map.Strict as Map-import Data.Maybe (catMaybes, fromMaybe, isJust, isNothing,- mapMaybe)-import Data.Serialize (encode)-import Data.Word (Word32, Word64)-import Haskoin (Address, Block (..), BlockHash,- BlockHeader (..), BlockNode (..),- Network (..), OutPoint (..), Tx (..),- TxHash, TxIn (..), TxOut (..),- blockHashToHex, computeSubsidy,- eitherToMaybe, genesisBlock, genesisNode,- headerHash, isGenesis, nullOutPoint,- scriptToAddressBS, txHash, txHashToHex)+import Control.Monad (forM, forM_, guard, unless, void,+ when, zipWithM_)+import Control.Monad.Except (MonadError, throwError)+import Control.Monad.Logger (MonadLoggerIO (..), logDebugS,+ logErrorS)+import qualified Data.ByteString as B+import Data.Either (rights)+import qualified Data.HashSet as HashSet+import qualified Data.IntMap.Strict as I+import Data.List (nub)+import Data.Maybe (catMaybes, fromMaybe, isJust,+ isNothing)+import Data.Serialize (encode)+import Data.String.Conversions (cs)+import Data.Word (Word32, Word64)+import Haskoin (Address, Block (..), BlockHash,+ BlockHeader (..), BlockNode (..),+ Network (..), OutPoint (..), Tx (..),+ TxHash, TxIn (..), TxOut (..),+ blockHashToHex, computeSubsidy,+ eitherToMaybe, genesisBlock,+ genesisNode, headerHash, isGenesis,+ nullOutPoint, scriptToAddressBS,+ txHash, txHashToHex) import Haskoin.Store.Common-import Haskoin.Store.Data (Balance (..), BlockData (..),- BlockRef (..), Prev (..), Spender (..),- TxData (..), TxRef (..), UnixTime,- Unspent (..), confirmed)-import UnliftIO (Exception)+import Haskoin.Store.Data (Balance (..), BlockData (..),+ BlockRef (..), Prev (..),+ Spender (..), TxData (..), TxRef (..),+ UnixTime, Unspent (..), confirmed)+import UnliftIO (Exception) type MonadImport m = ( MonadError ImportException m@@ -91,10 +91,6 @@ $(logDebugS) "BlockStore" "Importing Genesis block" importBlock (genesisBlock net) (genesisNode net) -getOldMempool :: StoreReadBase m => UnixTime -> m [TxHash]-getOldMempool now =- map snd . filter ((< now - 3600 * 72) . fst) <$> getMempool- newMempoolTx :: MonadImport m => Tx -> UnixTime -> m Bool newMempoolTx tx w = getActiveTxData (txHash tx) >>= \case@@ -129,11 +125,24 @@ $(logErrorS) "BlockStore" $ "Cannot revert non-head block: " <> blockHashToHex bh throwError BlockNotBest+ $(logDebugS) "BlockStore" $+ "Obtained block data for " <> blockHashToHex bh tds <- mapM getImportTxData (blockDataTxs bd)+ $(logDebugS) "BlockStore" $+ "Obtained import tx data for block " <> blockHashToHex bh setBest (prevBlock (blockDataHeader bd))+ $(logDebugS) "BlockStore" $+ "Set parent as best block " <>+ blockHashToHex (prevBlock (blockDataHeader bd)) insertBlock bd {blockDataMainChain = False}+ $(logDebugS) "BlockStore" $+ "Updated as not in main chain: " <> blockHashToHex bh forM_ (tail tds) unConfirmTx+ $(logDebugS) "BlockStore" $+ "Unconfirmed " <> cs (show (length tds)) <> " transactions" deleteConfirmedTx (txHash (txData (head tds)))+ $(logDebugS) "BlockStore" $+ "Deleted coinbase: " <> txHashToHex (txHash (txData (head tds))) checkNewBlock :: MonadImport m => Block -> BlockNode -> m () checkNewBlock b n =@@ -399,44 +408,54 @@ -> Bool -- ^ only delete RBF -> TxHash -> m ()-deleteTx memonly rbfcheck th =- getChain memonly rbfcheck th >>=- mapM_ (deleteSingleTx . 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 -getChain :: MonadImport m+getChain :: (MonadImport m, MonadLoggerIO m) => Bool -- ^ only delete transaction if unconfirmed -> Bool -- ^ only delete RBF -> TxHash -> m [Tx]-getChain memonly rbfcheck th =- fmap sort_clean $- getActiveTxData th >>= \case- Nothing -> do- $(logErrorS) "BlockStore" $- "Transaction not found: " <> txHashToHex th- throwError TxNotFound- Just td- | memonly && confirmed (txDataBlock td) -> do- $(logErrorS) "BlockStore" $- "Transaction already confirmed: "- <> txHashToHex th- throwError TxConfirmed- | rbfcheck ->- isRBF (txDataBlock td) (txData td) >>= \case- True -> go td- False -> do- $(logErrorS) "BlockStore" $- "Double-spending transaction: "- <> txHashToHex th- throwError DoubleSpend- | otherwise -> go td+getChain memonly rbfcheck th' = do+ $(logDebugS) "BlockStore" $+ "Getting chain for tx " <> txHashToHex th'+ sort_clean <$> go HashSet.empty (HashSet.singleton th') where- sort_clean = reverse . map snd . sortTxs . nub'- go td = do- let tx = txData td- ss <- nub' . map spenderHash . I.elems <$> getSpenders th- xs <- concat <$> mapM (getChain memonly rbfcheck) ss- return $ tx : xs+ sort_clean = reverse . map snd . sortTxs+ get_tx th =+ getActiveTxData th >>= \case+ Nothing -> do+ $(logErrorS) "BlockStore" $+ "Transaction not found: " <> txHashToHex th+ throwError TxNotFound+ Just td+ | memonly && confirmed (txDataBlock td) -> do+ $(logErrorS) "BlockStore" $+ "Transaction already confirmed: "+ <> txHashToHex th+ throwError TxConfirmed+ | rbfcheck ->+ isRBF (txDataBlock td) (txData td) >>= \case+ True -> return $ txData td+ False -> do+ $(logErrorS) "BlockStore" $+ "Double-spending transaction: "+ <> txHashToHex th+ throwError DoubleSpend+ | otherwise -> return $ txData td+ go txs pdg = do+ txs1 <- HashSet.fromList <$> mapM get_tx (HashSet.toList pdg)+ pdg1 <- HashSet.fromList . concatMap (map spenderHash . I.elems) <$>+ mapM getSpenders (HashSet.toList pdg)+ let txs' = txs1 <> txs+ pdg' = pdg1 `HashSet.difference` HashSet.map txHash txs'+ if HashSet.null pdg'+ then return $ HashSet.toList txs'+ else go txs' pdg' deleteSingleTx :: MonadImport m => TxHash -> m () deleteSingleTx th =