haskoin-store 0.14.9 → 0.15.0
raw patch · 11 files changed
+177/−214 lines, 11 files
Files
- CHANGELOG.md +8/−0
- app/Main.hs +1/−1
- haskoin-store.cabal +2/−2
- src/Haskoin/Store.hs +2/−1
- src/Network/Haskoin/Store/Block.hs +5/−5
- src/Network/Haskoin/Store/Data.hs +13/−29
- src/Network/Haskoin/Store/Data/ImportDB.hs +3/−3
- src/Network/Haskoin/Store/Data/KeyValue.hs +5/−5
- src/Network/Haskoin/Store/Data/RocksDB.hs +3/−3
- src/Network/Haskoin/Store/Data/STM.hs +5/−5
- src/Network/Haskoin/Store/Logic.hs +130/−160
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.15.0+### Removed+- `PreciseUnixTime` data type no longer exists.++### Changed+- Use `Word64` for Unix time representation.+- Data model now uses simplified Unix time representation.+ ## 0.14.9 ### Added - Last external/change index information to `XPubSummary` object.
app/Main.hs view
@@ -566,7 +566,7 @@ return $ StartBlock height pos m = do time <- param "time"- return $ StartMem (PreciseUnixTime time)+ return $ StartMem time o = do o <- param "offset" `rescue` const (return 0) return $ StartOffset o
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 617a58a17a5d91918490076dcbe3d80c11fa8480befcac0e5afff71309398fa2+-- hash: f29fa6f913716a037b1af6dd5464ed228c7584d7dffadad6b80404d0efcd3f2c name: haskoin-store-version: 0.14.9+version: 0.15.0 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Store blocks, transactions, and balances for Bitcoin or Bitcoin Cash, and make that information via REST API. category: Bitcoin, Finance, Network
src/Haskoin/Store.hs view
@@ -24,7 +24,6 @@ , XPubUnspent(..) , Balance(..) , PeerInformation(..)- , PreciseUnixTime(..) , HealthCheck(..) , PubExcept(..) , Event(..)@@ -34,6 +33,8 @@ , Except(..) , TxId(..) , StartFrom(..)+ , UnixTime+ , BlockPos , withStore , store , getBestBlock
src/Network/Haskoin/Store/Block.hs view
@@ -160,7 +160,7 @@ net <- blockConfNet <$> asks myConfig um <- asks myUnspent bm <- asks myBalances- runExceptT (newBlock net db um bm b n) >>= \case+ runExceptT (runImportDB db um bm $ importBlock net b n) >>= \case Right () -> do l <- blockConfListener <$> asks myConfig atomically $ l (StoreBestBlock (headerHash (blockHeader b)))@@ -183,7 +183,7 @@ if nodeHeader h == blockHeader b then resetPeer else do- now <- systemSeconds <$> liftIO getSystemTime+ now <- fromIntegral . systemSeconds <$> liftIO getSystemTime asks myPeer >>= atomically . (`writeTVar` Just s {syncingTime = now})@@ -225,7 +225,7 @@ "Ignoring incoming tx (not synced yet): " <> txHashToHex (txHash tx) True -> do $(logInfoS) "Block" $ "Incoming tx: " <> txHashToHex (txHash tx)- now <- preciseUnixTime <$> liftIO getSystemTime+ now <- fromIntegral . systemSeconds <$> liftIO getSystemTime (net, db) <- (blockConfNet &&& blockConfDB) <$> asks myConfig um <- asks myUnspent bm <- asks myBalances@@ -279,7 +279,7 @@ asks myPeer >>= readTVarIO >>= \case Nothing -> $(logDebugS) "Block" "Peer timeout check: no syncing peer" Just Syncing {syncingTime = t, syncingPeer = p} -> do- n <- systemSeconds <$> liftIO getSystemTime+ n <- fromIntegral . systemSeconds <$> liftIO getSystemTime if n > t + 60 then do $(logErrorS) "Block" "Peer timeout"@@ -427,7 +427,7 @@ setPeer :: (MonadIO m, MonadReader BlockRead m) => Peer -> BlockNode -> m () setPeer p b = do box <- asks myPeer- now <- systemSeconds <$> liftIO getSystemTime+ now <- fromIntegral . systemSeconds <$> liftIO getSystemTime atomically . writeTVar box $ Just Syncing {syncingPeer = p, syncingHead = b, syncingTime = now}
src/Network/Haskoin/Store/Data.hs view
@@ -28,7 +28,6 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.Lazy as T.Lazy-import Data.Time.Clock.System import Data.Word import GHC.Generics import Haskoin as H@@ -37,7 +36,8 @@ import UnliftIO.Exception import qualified Web.Scotty.Trans as Scotty -type UnixTime = Int64+type UnixTime = Word64+type BlockPos = Word32 newtype InitException = IncorrectVersion Word32 deriving (Show, Read, Eq, Ord, Exception)@@ -74,8 +74,7 @@ return $ toTransaction d sm class StoreStream m where- getMempool ::- Maybe PreciseUnixTime -> ConduitT () (PreciseUnixTime, TxHash) m ()+ getMempool :: Maybe UnixTime -> ConduitT () (UnixTime, TxHash) m () getAddressUnspents :: Address -> Maybe BlockRef -> ConduitT () Unspent m () getAddressTxs :: Address -> Maybe BlockRef -> ConduitT () BlockTx m () @@ -91,27 +90,12 @@ removeAddrTx :: Address -> BlockTx -> m () insertAddrUnspent :: Address -> Unspent -> m () removeAddrUnspent :: Address -> Unspent -> m ()- insertMempoolTx :: TxHash -> PreciseUnixTime -> m ()- deleteMempoolTx :: TxHash -> PreciseUnixTime -> m ()---- | Unix time with nanosecond precision for mempool transactions.-newtype PreciseUnixTime = PreciseUnixTime Word64- deriving (Show, Eq, Read, Generic, Ord, Hashable)+ insertMempoolTx :: TxHash -> UnixTime -> m ()+ deleteMempoolTx :: TxHash -> UnixTime -> m () -- | Serialize such that ordering is inverted.-instance Serialize PreciseUnixTime where- put (PreciseUnixTime w) = putWord64be $ maxBound - w- get = PreciseUnixTime . (maxBound -) <$> getWord64be--preciseUnixTime :: SystemTime -> PreciseUnixTime-preciseUnixTime s =- PreciseUnixTime . fromIntegral $- (systemSeconds s * 1000) +- (fromIntegral (systemNanoseconds s) `div` (1000 * 1000))--instance ToJSON PreciseUnixTime where- toJSON (PreciseUnixTime w) = toJSON w- toEncoding (PreciseUnixTime w) = toEncoding w+putUnixTime w = putWord64be $ maxBound - w+getUnixTime = (maxBound -) <$> getWord64be class JsonSerial a where jsonSerial :: Network -> a -> Encoding@@ -147,14 +131,14 @@ , blockRefPos :: !Word32 -- ^ position of transaction within the block }- | MemRef { memRefTime :: !PreciseUnixTime }+ | MemRef { memRefTime :: !UnixTime } deriving (Show, Read, Eq, Ord, Generic, Hashable) -- | Serialized entities will sort in reverse order. instance Serialize BlockRef where put MemRef {memRefTime = t} = do putWord8 0x00- put t+ putUnixTime t put BlockRef {blockRefHeight = h, blockRefPos = p} = do putWord8 0x01 putWord32be (maxBound - h)@@ -163,7 +147,7 @@ where getmemref = do guard . (== 0x00) =<< getWord8- MemRef . PreciseUnixTime <$> get+ MemRef <$> getUnixTime getblockref = do guard . (== 0x01) =<< getWord8 h <- (maxBound -) <$> getWord32be@@ -175,7 +159,7 @@ putWord8 0x00 putWord32be h putWord32be p- binSerial _ MemRef {memRefTime = PreciseUnixTime t} = do+ binSerial _ MemRef {memRefTime = t} = do putWord8 0x01 putWord64be t @@ -1010,7 +994,7 @@ binSerial _ (TxId th) = put th data StartFrom- = StartBlock !Word32 !Word32- | StartMem !PreciseUnixTime+ = StartBlock !BlockHeight !BlockPos+ | StartMem !UnixTime | StartOffset !Word32 deriving (Show, Eq, Generic)
src/Network/Haskoin/Store/Data/ImportDB.hs view
@@ -141,7 +141,7 @@ deleteOp AddrOutKey {addrOutKeyA = a, addrOutKeyB = b, addrOutKeyP = p} mempoolOps ::- HashMap PreciseUnixTime (HashMap TxHash Bool) -> [BatchOp]+ HashMap UnixTime (HashMap TxHash Bool) -> [BatchOp] mempoolOps = concatMap (uncurry f) . M.toList where f u = map (uncurry (g u)) . M.toList@@ -211,11 +211,11 @@ removeAddrUnspentI a u ImportDB {importHashMap = hm} = atomically . withBlockSTM hm $ removeAddrUnspent a u -insertMempoolTxI :: MonadIO m => TxHash -> PreciseUnixTime -> ImportDB -> m ()+insertMempoolTxI :: MonadIO m => TxHash -> UnixTime -> ImportDB -> m () insertMempoolTxI t p ImportDB {importHashMap = hm} = atomically . withBlockSTM hm $ insertMempoolTx t p -deleteMempoolTxI :: MonadIO m => TxHash -> PreciseUnixTime -> ImportDB -> m ()+deleteMempoolTxI :: MonadIO m => TxHash -> UnixTime -> ImportDB -> m () deleteMempoolTxI t p ImportDB {importHashMap = hm} = atomically . withBlockSTM hm $ deleteMempoolTx t p
src/Network/Haskoin/Store/Data/KeyValue.hs view
@@ -186,9 +186,9 @@ -- | Mempool transaction database key. data MemKey- = MemKey { memTime :: !PreciseUnixTime+ = MemKey { memTime :: !UnixTime , memKey :: !TxHash }- | MemKeyT { memTime :: !PreciseUnixTime }+ | MemKeyT { memTime :: !UnixTime } | MemKeyS deriving (Show, Read, Eq, Ord, Generic, Hashable) @@ -196,16 +196,16 @@ -- 0x07 · TxHash put (MemKey t h) = do putWord8 0x07- put t+ putUnixTime t put h put (MemKeyT t) = do putWord8 0x07- put t+ putUnixTime t -- 0x07 put MemKeyS = putWord8 0x07 get = do guard . (== 0x07) =<< getWord8- MemKey <$> get <*> get+ MemKey <$> getUnixTime <*> get instance R.Key MemKey instance R.KeyValue MemKey ()
src/Network/Haskoin/Store/Data/RocksDB.hs view
@@ -21,7 +21,7 @@ type BlockDB = (ReadOptions, DB) dataVersion :: Word32-dataVersion = 14+dataVersion = 15 withBlockDB :: ReadOptions -> DB -> ReaderT BlockDB m a -> m a withBlockDB opts db f = R.runReaderT f (opts, db)@@ -87,10 +87,10 @@ getMempoolDB :: (MonadIO m, MonadResource m)- => Maybe PreciseUnixTime+ => Maybe UnixTime -> ReadOptions -> DB- -> ConduitT () (PreciseUnixTime, TxHash) m ()+ -> ConduitT () (UnixTime, TxHash) m () getMempoolDB mpu opts db = x .| mapC (uncurry f) where x =
src/Network/Haskoin/Store/Data/STM.hs view
@@ -45,7 +45,7 @@ , hBalance :: !(HashMap Address BalVal) , hAddrTx :: !(HashMap Address (HashMap BlockRef (HashMap TxHash Bool))) , hAddrOut :: !(HashMap Address (HashMap BlockRef (HashMap OutPoint (Maybe OutVal))))- , hMempool :: !(HashMap PreciseUnixTime (HashMap TxHash Bool))+ , hMempool :: !(HashMap UnixTime (HashMap TxHash Bool)) , hInit :: !Bool } deriving (Eq, Show) @@ -104,9 +104,9 @@ getMempoolH :: Monad m- => Maybe PreciseUnixTime+ => Maybe UnixTime -> HashMapDB- -> ConduitT () (PreciseUnixTime, TxHash) m ()+ -> ConduitT () (UnixTime, TxHash) m () getMempoolH mpu db = let f ts = case mpu of@@ -254,12 +254,12 @@ (M.singleton (unspentPoint u) Nothing)) in db {hAddrOut = M.unionWith (M.unionWith M.union) s (hAddrOut db)} -insertMempoolTxH :: TxHash -> PreciseUnixTime -> HashMapDB -> HashMapDB+insertMempoolTxH :: TxHash -> UnixTime -> HashMapDB -> HashMapDB insertMempoolTxH h u db = let s = M.singleton u (M.singleton h True) in db {hMempool = M.unionWith M.union s (hMempool db)} -deleteMempoolTxH :: TxHash -> PreciseUnixTime -> HashMapDB -> HashMapDB+deleteMempoolTxH :: TxHash -> UnixTime -> HashMapDB -> HashMapDB deleteMempoolTxH h u db = let s = M.singleton u (M.singleton h False) in db {hMempool = M.unionWith M.union s (hMempool db)}
src/Network/Haskoin/Store/Logic.hs view
@@ -18,6 +18,7 @@ import Data.Maybe import Data.Serialize import Data.String+import Data.String.Conversions (cs) import Data.Text (Text) import Data.Word import Database.RocksDB@@ -88,9 +89,9 @@ ) => Network -> Tx- -> PreciseUnixTime+ -> UnixTime -> m Bool-newMempoolTx net tx now@(PreciseUnixTime w) = do+newMempoolTx net tx w = do $(logInfoS) "BlockLogic" $ "Adding transaction to mempool: " <> txHashToHex (txHash tx) getTxData (txHash tx) >>= \case@@ -119,7 +120,7 @@ let ds = map spenderHash (mapMaybe outputSpender us) if null ds then do- importTx net (MemRef now) (w `div` 1000) tx+ importTx net (MemRef w) w tx return True else g ds g ds = do@@ -136,27 +137,16 @@ $(logWarnS) "BlockLogic" $ "Replacting RBF transaction with: " <> txHashToHex (txHash tx) forM_ ds (deleteTx net True)- importTx net (MemRef now) (w `div` 1000) tx+ importTx net (MemRef w) w tx return True n = do $(logWarnS) "BlockLogic" $ "Inserting transaction with deleted flag: " <> txHashToHex (txHash tx)- insertDeletedMempoolTx tx now+ insertDeletedMempoolTx tx w return False isrbf th = transactionRBF <$> getImportTx th -newBlock ::- (MonadError ImportException m, MonadIO m, MonadLogger m)- => Network- -> DB- -> TVar UnspentMap- -> TVar BalanceMap- -> Block- -> BlockNode- -> m ()-newBlock net db um bm b n = runImportDB db um bm $ importBlock net b n- revertBlock :: ( MonadError ImportException m , StoreRead m@@ -244,22 +234,30 @@ insertAtHeight (headerHash (nodeHeader n)) (nodeHeight n) setBest (headerHash (nodeHeader n)) zipWithM_- (\x t ->- importTx- net- (br x)- (fromIntegral (blockTimestamp (nodeHeader n)))- t)+ (\x t -> import_or_confirm (br x) t) [0 ..] (sortTxs (blockTxns b)) where+ import_or_confirm b tx =+ getTxData (txHash tx) >>= \case+ Just t+ | not (txDataDeleted t) -> confirmTx net t b tx+ _ ->+ importTx net b (fromIntegral (blockTimestamp (nodeHeader n))) tx subsidy = computeSubsidy net cb_out_val = sum (map outValue (txOut (head (blockTxns b)))) ts_out_val = sum (map (sum . map outValue . txOut) (tail (blockTxns b))) br pos = BlockRef {blockRefHeight = nodeHeight n, blockRefPos = pos}- w = let s = B.length (encode b {blockTxns = map (\t -> t {txWitness = []}) (blockTxns b)})+ w =+ let s =+ B.length+ (encode+ b+ { blockTxns =+ map (\t -> t {txWitness = []}) (blockTxns b)+ }) x = B.length (encode b)- in s * 3 + x+ in s * 3 + x sortTxs :: [Tx] -> [Tx] sortTxs [] = []@@ -307,75 +305,35 @@ "Insufficient funds: " <> txHashToHex (txHash tx) throwError (InsufficientFunds th) zipWithM_ (spendOutput net br (txHash tx)) [0 ..] us- if | iscb || not (null us) ->- do zipWithM_- (newOutput br . OutPoint (txHash tx))- [0 ..]- (txOut tx)- rbf <- getrbf- let t =- Transaction- { transactionBlock = br- , transactionVersion = txVersion tx- , transactionLockTime = txLockTime tx- , transactionInputs =- if iscb- then zipWith mkcb (txIn tx) ws- else zipWith3 mkin us (txIn tx) ws- , transactionOutputs = map mkout (txOut tx)- , transactionDeleted = False- , transactionRBF = rbf- , transactionTime = tt- }- let (d, _) = fromTransaction t- insertTx d- updateAddressCounts (txAddresses t) (+1)- unless (confirmed br) $- insertMempoolTx (txHash tx) (memRefTime br)- | null us && confirmed br -> confirmTx net br tx- | otherwise ->- do $(logErrorS) "BlockLogic" $- "Invalid operation required for transaction: " <>- txHashToHex (txHash tx)- throwError (TxInvalidOp (txHash tx))+ zipWithM_ (newOutput br . OutPoint (txHash tx)) [0 ..] (txOut tx)+ rbf <- getrbf+ let t =+ Transaction+ { transactionBlock = br+ , transactionVersion = txVersion tx+ , transactionLockTime = txLockTime tx+ , transactionInputs =+ if iscb+ then zipWith mkcb (txIn tx) ws+ else zipWith3 mkin us (txIn tx) ws+ , transactionOutputs = map mkout (txOut tx)+ , transactionDeleted = False+ , transactionRBF = rbf+ , transactionTime = tt+ }+ let (d, _) = fromTransaction t+ insertTx d+ updateAddressCounts (txAddresses t) (+ 1)+ unless (confirmed br) $ insertMempoolTx (txHash tx) (memRefTime br) where uns op = getUnspent op >>= \case- Nothing- | confirmed br -> do- $(logWarnS) "BlockLogic" $- "Could not find unspent output: " <>- txHashToHex (outPointHash op) <>- " " <>- fromString (show (outPointIndex op))- getSpender op >>= \case- Nothing -> do- $(logErrorS) "BlockLogic" $- "Could not find output: " <>- txHashToHex (outPointHash op) <>- " " <>- fromString (show (outPointIndex op))- throwError (OrphanTx (txHash tx))- Just s- | spenderHash s == txHash tx -> return Nothing- | otherwise -> do- $(logWarnS) "BlockLogic" $- "Deleting conflicting transaction: " <>- txHashToHex (spenderHash s)- deleteTx net True (spenderHash s)- getUnspent op >>= \case- Nothing -> do- $(logErrorS) "BlockLogic" $- "Transaction double-spend detected: " <>- txHashToHex (txHash tx)- throwError (TxDoubleSpend (txHash tx))- Just u -> return $ Just u- | otherwise -> do- $(logErrorS) "BlockLogic" $- "No unspent output: " <> txHashToHex (outPointHash op) <>- " " <>- fromString (show (outPointIndex op))- throwError (NoUnspent op)+ Nothing -> do+ $(logErrorS) "BlockLogic" $+ "No unspent output: " <> txHashToHex (outPointHash op) <>+ " " <>+ fromString (show (outPointIndex op))+ throwError (NoUnspent op) Just u -> return $ Just u th = txHash tx iscb = all (== nullOutPoint) (map prevOutput (txIn tx))@@ -427,82 +385,94 @@ , MonadLogger m ) => Network+ -> TxData -> BlockRef -> Tx -> m ()-confirmTx net br tx =- getTxData (txHash tx) >>= \case- Nothing -> do- $(logErrorS) "BlockLogic" $- "Transaction not found: " <> txHashToHex (txHash tx)- throwError (TxNotFound (txHash tx))- Just t -> do- forM_ (txDataPrevs t) $ \p ->- case scriptToAddressBS (prevScript p) of- Left _ -> return ()- Right a -> do- removeAddrTx- a- BlockTx- { blockTxBlock = txDataBlock t- , blockTxHash = txHash tx- }- insertAddrTx- a- BlockTx- { blockTxBlock = br- , blockTxHash = txHash tx- }- forM_ (zip [0 ..] (txOut tx)) $ \(n, o) -> do- let op = OutPoint (txHash tx) n- s <- getSpender (OutPoint (txHash tx) n)+confirmTx net t br tx = do+ $(logDebugS) "BlockLogic" $+ "Confirming tx " <> txHashToHex (txHash tx) <> " previously on " <>+ cs (show (txDataBlock t)) <>+ " and now on " <>+ cs (show br)+ forM_ (txDataPrevs t) $ \p ->+ case scriptToAddressBS (prevScript p) of+ Left _ -> return ()+ Right a -> do+ $(logDebugS) "BlockLogic" $+ "Removing tx " <> txHashToHex (txHash tx) <>+ " from address " <>+ fromMaybe "???" (addrToString net a) <>+ " on " <>+ cs (show (txDataBlock t))+ removeAddrTx+ a+ BlockTx+ {blockTxBlock = txDataBlock t, blockTxHash = txHash tx}+ $(logDebugS) "BlockLogic" $ "Inserting tx " <>+ txHashToHex (txHash tx) <>+ " for address " <>+ fromMaybe "???" (addrToString net a) <>+ " on " <>+ cs (show br)+ insertAddrTx+ a+ BlockTx {blockTxBlock = br, blockTxHash = txHash tx}+ forM_ (zip [0 ..] (txOut tx)) $ \(n, o) -> do+ let op = OutPoint (txHash tx) n+ s <- getSpender (OutPoint (txHash tx) n)+ when (isNothing s) $ do+ delUnspent op+ addUnspent+ Unspent+ { unspentBlock = br+ , unspentPoint = op+ , unspentAmount = outValue o+ , unspentScript = B.Short.toShort (scriptOutput o)+ }+ case scriptToAddressBS (scriptOutput o) of+ Left _ -> return ()+ Right a -> do+ $(logDebugS) "BlockLogic" $+ "Removing tx " <> txHashToHex (txHash tx) <>+ " from address " <>+ fromMaybe "???" (addrToString net a) <>+ " on " <>+ cs (show (txDataBlock t))+ removeAddrTx+ a+ BlockTx+ {blockTxBlock = txDataBlock t, blockTxHash = txHash tx}+ $(logDebugS) "BlockLogic" $ "Inserting tx " <>+ txHashToHex (txHash tx) <>+ " for address " <>+ fromMaybe "???" (addrToString net a) <>+ " on " <>+ cs (show br)+ insertAddrTx+ a+ BlockTx {blockTxBlock = br, blockTxHash = txHash tx} when (isNothing s) $ do- delUnspent op- addUnspent+ removeAddrUnspent+ a Unspent+ { unspentBlock = txDataBlock t+ , unspentPoint = op+ , unspentAmount = outValue o+ , unspentScript = B.Short.toShort (scriptOutput o)+ }+ insertAddrUnspent+ a+ Unspent { unspentBlock = br , unspentPoint = op , unspentAmount = outValue o , unspentScript = B.Short.toShort (scriptOutput o) }- case scriptToAddressBS (scriptOutput o) of- Left _ -> return ()- Right a -> do- removeAddrTx- a- BlockTx- { blockTxBlock = txDataBlock t- , blockTxHash = txHash tx- }- insertAddrTx- a- BlockTx- { blockTxBlock = br- , blockTxHash = txHash tx- }- when (isNothing s) $ do- removeAddrUnspent- a- Unspent- { unspentBlock = txDataBlock t- , unspentPoint = op- , unspentAmount = outValue o- , unspentScript =- B.Short.toShort (scriptOutput o)- }- insertAddrUnspent- a- Unspent- { unspentBlock = br- , unspentPoint = op- , unspentAmount = outValue o- , unspentScript =- B.Short.toShort (scriptOutput o)- }- reduceBalance net False False a (outValue o)- increaseBalance True False a (outValue o)- insertTx t {txDataBlock = br}- deleteMempoolTx (txHash tx) (memRefTime (txDataBlock t))+ reduceBalance net False False a (outValue o)+ increaseBalance True False a (outValue o)+ insertTx t {txDataBlock = br}+ deleteMempoolTx (txHash tx) (memRefTime (txDataBlock t)) getRecursiveTx :: (Monad m, StoreRead m, MonadLogger m) => TxHash -> m [Transaction]@@ -567,9 +537,9 @@ , MonadLogger m ) => Tx- -> PreciseUnixTime+ -> UnixTime -> m ()-insertDeletedMempoolTx tx now@(PreciseUnixTime w) = do+insertDeletedMempoolTx tx w = do us <- forM (txIn tx) $ \TxIn {prevOutput = op} -> getImportTx (outPointHash op) >>= getTxOutput (outPointIndex op)@@ -577,14 +547,14 @@ let (d, _) = fromTransaction Transaction- { transactionBlock = MemRef now+ { transactionBlock = MemRef w , transactionVersion = txVersion tx , transactionLockTime = txLockTime tx , transactionInputs = zipWith3 mkin us (txIn tx) ws , transactionOutputs = map mkout (txOut tx) , transactionDeleted = True , transactionRBF = rbf- , transactionTime = w `div` 1000+ , transactionTime = w } $(logWarnS) "BlockLogic" $ "Inserting deleted mempool transaction: " <> txHashToHex (txHash tx)