diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,10 @@ 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.64.16 +### Fixed +- Correct fee calculation for blocks that do not claim all rewards. + ## 0.64.15 ### Fixed - Correct scale of cache pruning code. diff --git a/haskoin-store.cabal b/haskoin-store.cabal --- a/haskoin-store.cabal +++ b/haskoin-store.cabal @@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack name: haskoin-store -version: 0.64.15 +version: 0.64.16 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Please see the README on GitHub at category: Bitcoin, Finance, Network @@ -60,7 +60,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.21.1 , haskoin-node >=0.17.0 - , haskoin-store-data ==0.64.15 + , haskoin-store-data ==0.64.16 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1 @@ -116,7 +116,7 @@ , haskoin-core >=0.21.1 , haskoin-node >=0.17.0 , haskoin-store - , haskoin-store-data ==0.64.15 + , haskoin-store-data ==0.64.16 , hedis >=0.12.13 , http-types >=0.12.3 , lens >=4.18.1 @@ -177,7 +177,7 @@ , haskoin-core >=0.21.1 , haskoin-node >=0.17.0 , haskoin-store - , haskoin-store-data ==0.64.15 + , haskoin-store-data ==0.64.16 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3 diff --git a/src/Haskoin/Store/BlockStore.hs b/src/Haskoin/Store/BlockStore.hs --- a/src/Haskoin/Store/BlockStore.hs +++ b/src/Haskoin/Store/BlockStore.hs @@ -490,7 +490,7 @@ lift . notify (Just block) $ runImport (importBlock block node) >>= \case Left e -> failure e - Right () -> success node + Right _ -> success node where header = blockHeader block blockhash = headerHash header 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 @@ -84,6 +84,8 @@ UnixTime, Unspent (..), confirmed, + isCoinbaseTx, + txDataFee, ) import UnliftIO (Exception) @@ -203,10 +205,10 @@ <> blockHashToHex (headerHash (blockHeader b)) throwError PrevBlockNotBest -importOrConfirm :: MonadImport m => BlockNode -> [Tx] -> m () +importOrConfirm :: MonadImport m => BlockNode -> [Tx] -> m [TxData] importOrConfirm bn txns = do mapM_ (freeOutputs True False . snd) (reverse txs) - mapM_ (uncurry action) txs + mapM (uncurry action) txs where txs = sortTxs txns br i = BlockRef {blockRefHeight = nodeHeight bn, blockRefPos = i} @@ -222,7 +224,6 @@ "Confirming tx: " <> txHashToHex (txHash tx) confirmTx t (br i) - return Nothing Nothing -> do $(logErrorS) "BlockStore" $ "Cannot find tx to confirm: " @@ -232,9 +233,8 @@ $(logDebugS) "BlockStore" $ "Importing tx: " <> txHashToHex (txHash tx) importTx (br i) bn_time False tx - return Nothing -importBlock :: MonadImport m => Block -> BlockNode -> m () +importBlock :: MonadImport m => Block -> BlockNode -> m (BlockData, [TxData]) importBlock b n = do $(logDebugS) "BlockStore" $ "Checking new block: " @@ -247,27 +247,29 @@ $(logDebugS) "BlockStore" $ "Inserting block entries for: " <> blockHashToHex (headerHash (nodeHeader n)) - insertBlock - BlockData - { blockDataHeight = nodeHeight n, - blockDataMainChain = True, - blockDataWork = nodeWork n, - blockDataHeader = nodeHeader n, - blockDataSize = fromIntegral (B.length (encode b)), - blockDataTxs = map txHash (blockTxns b), - blockDataWeight = if getSegWit net then w else 0, - blockDataSubsidy = subsidy, - blockDataFees = cb_out_val - subsidy, - blockDataOutputs = ts_out_val - } setBlocksAtHeight (nub (headerHash (nodeHeader n) : bs)) (nodeHeight n) setBest (headerHash (nodeHeader n)) - importOrConfirm n (blockTxns b) + tds <- importOrConfirm n (blockTxns b) + let bd = + BlockData + { blockDataHeight = nodeHeight n, + blockDataMainChain = True, + blockDataWork = nodeWork n, + blockDataHeader = nodeHeader n, + blockDataSize = fromIntegral (B.length (encode b)), + blockDataTxs = map txHash (blockTxns b), + blockDataWeight = if getSegWit net then w else 0, + blockDataSubsidy = subsidy, + blockDataFees = sum $ map txDataFee tds, + blockDataOutputs = ts_out_val + } + insertBlock bd $(logDebugS) "BlockStore" $ - "Finished importing transactions for: " + "Finished importing block: " <> blockHashToHex (headerHash (nodeHeader n)) + return (bd, tds) where cb_out_val = sum $ map outValue $ txOut $ head $ blockTxns b @@ -292,7 +294,7 @@ $(logErrorS) "BlockStore" $ "Orphan: " <> txHashToHex (txHash tx) throwError Orphan - when (isCoinbase tx) $ do + when (isCoinbaseTx tx) $ do $(logErrorS) "BlockStore" $ "Coinbase cannot be imported into mempool: " <> txHashToHex (txHash tx) @@ -335,7 +337,7 @@ -- | RBF Bool -> Tx -> - m () + m TxData importTx br tt rbf tx = do mus <- getUnspentOutputs tx us <- forM mus $ \case @@ -347,11 +349,12 @@ Just u -> return u let td = prepareTxData rbf br tt tx us commitAddTx td + return td -unConfirmTx :: MonadImport m => TxData -> m () +unConfirmTx :: MonadImport m => TxData -> m TxData unConfirmTx t = confTx t Nothing -confirmTx :: MonadImport m => TxData -> BlockRef -> m () +confirmTx :: MonadImport m => TxData -> BlockRef -> m TxData confirmTx t br = confTx t (Just br) replaceAddressTx :: MonadImport m => TxData -> BlockRef -> m () @@ -419,7 +422,7 @@ decreaseBalance (confirmed old) a (outValue o) increaseBalance (confirmed new) a (outValue o) -confTx :: MonadImport m => TxData -> Maybe BlockRef -> m () +confTx :: MonadImport m => TxData -> Maybe BlockRef -> m TxData confTx t mbr = do replaceAddressTx t new forM_ (zip [0 ..] (txOut (txData t))) $ \(n, o) -> do @@ -429,6 +432,7 @@ let td = t {txDataBlock = new, txDataRBF = rbf} insertTx td updateMempool td + return td where new = fromMaybe (MemRef (txDataTime t)) mbr old = txDataBlock t @@ -766,9 +770,6 @@ where prevs = I.elems (txDataPrevs t) outs = txOut (txData t) - -isCoinbase :: Tx -> Bool -isCoinbase = all ((== nullOutPoint) . prevOutput) . txIn prevOuts :: Tx -> [OutPoint] prevOuts tx = filter (/= nullOutPoint) (map prevOutput (txIn tx))