haskoin-store 0.25.4 → 0.26.0
raw patch · 5 files changed
+109/−90 lines, 5 filesdep ~haskoin-store-data
Dependency ranges changed: haskoin-store-data
Files
- haskoin-store.cabal +5/−5
- src/Haskoin/Store/BlockStore.hs +15/−11
- src/Haskoin/Store/Database/Memory.hs +4/−1
- src/Haskoin/Store/Database/Types.hs +4/−1
- src/Haskoin/Store/Logic.hs +81/−72
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 454857d6641206426edf1b345b6c3325c11aa449009fe4abc4e2cf89dfcaefee+-- hash: 513e05388b9aeae3b17af94550d0da07c8f48cd45bc7dd191c39ac4ba296fbaa name: haskoin-store-version: 0.25.4+version: 0.26.0 synopsis: Storage and index for Bitcoin and Bitcoin Cash description: Store and index Bitcoin or Bitcoin Cash blocks, transactions, balances and unspent outputs. All data is available via REST API in JSON or binary format.@@ -57,7 +57,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.3 , haskoin-node >=0.13.0- , haskoin-store-data ==0.25.4+ , haskoin-store-data ==0.26.0 , hedis >=0.12.13 , http-types >=0.12.3 , monad-logger >=0.3.32@@ -99,7 +99,7 @@ , haskoin-core >=0.13.3 , haskoin-node >=0.13.0 , haskoin-store- , haskoin-store-data ==0.25.4+ , haskoin-store-data ==0.26.0 , monad-logger >=0.3.32 , mtl >=2.2.2 , nqe >=0.6.1@@ -149,7 +149,7 @@ , hashable >=1.3.0.0 , haskoin-core >=0.13.3 , haskoin-node >=0.13.0- , haskoin-store-data ==0.25.4+ , haskoin-store-data ==0.26.0 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/BlockStore.hs view
@@ -280,7 +280,7 @@ atomically $ do mapM_ (listener . StoreTxDeleted) deletedtxids listener (StoreBestBlock blockhash)- lift (syncMe peer)+ lift (touchPeer peer >> syncMe peer) Left e -> do $(logErrorS) "BlockStore" $ "Error importing block: " <> hexhash <> ": " <>@@ -300,16 +300,9 @@ "Ignoring block " <> hexhash <> " from disconnected peer" mzero Just _ ->- getSyncingState >>= \case- Just Syncing {syncingPeer = syncingpeer}- | peer == syncingpeer -> do- box <- asks myPeer- now <-- fromIntegral . systemSeconds <$>- liftIO getSystemTime- atomically . modifyTVar box . fmap $ \s ->- s {syncingTime = now}- _ -> do+ lift (touchPeer peer) >>= \case+ True -> return ()+ False -> do p' <- managerPeerText peer =<< asks (blockConfManager . myConfig)@@ -530,6 +523,17 @@ then InvWitnessTx else InvTx MGetData (GetData (map (InvVector inv . getTxHash) xs)) `sendMessage` p++touchPeer :: MonadIO m => Peer -> ReaderT BlockRead m Bool+touchPeer p =+ getSyncingState >>= \case+ Just Syncing {syncingPeer = s}+ | p == s -> do+ box <- asks myPeer+ now <- fromIntegral . systemSeconds <$> liftIO getSystemTime+ atomically . modifyTVar box . fmap $ \x -> x {syncingTime = now}+ return True+ _ -> return False checkTime :: (MonadUnliftIO m, MonadLoggerIO m) => ReaderT BlockRead m () checkTime =
src/Haskoin/Store/Database/Memory.hs view
@@ -25,7 +25,8 @@ import Data.Word (Word32) import Haskoin (Address, BlockHash, BlockHeight, Network, OutPoint (..), TxHash,- headerHash, txHash)+ eitherToMaybe, headerHash,+ scriptToAddressBS, txHash) import Haskoin.Store.Common (Limit, StoreRead (..), StoreWrite (..), applyLimit) import Haskoin.Store.Data (Balance (..), BlockData (..),@@ -156,6 +157,8 @@ , unspentAmount = outValAmount u , unspentScript = B.Short.toShort (outValScript u) , unspentPoint = p+ , unspentAddress =+ eitherToMaybe (scriptToAddressBS (outValScript u)) } g _ _ Nothing = Nothing h Unspent {unspentBlock = b} =
src/Haskoin/Store/Database/Types.hs view
@@ -39,7 +39,8 @@ import Database.RocksDB.Query (Key, KeyValue) import GHC.Generics (Generic) import Haskoin (Address, BlockHash, BlockHeight,- OutPoint (..), TxHash)+ OutPoint (..), TxHash, eitherToMaybe,+ scriptToAddressBS) import Haskoin.Store.Data (Balance (..), BlockData, BlockRef, BlockTx (..), Spender, TxData, UnixTime, Unspent (..), getUnixTime,@@ -220,6 +221,7 @@ , unspentAmount = outValAmount v , unspentScript = BSS.toShort (outValScript v) , unspentPoint = addrOutKeyP b+ , unspentAddress = eitherToMaybe (scriptToAddressBS (outValScript v)) } -- | Mempool transaction database key.@@ -431,4 +433,5 @@ , unspentPoint = p , unspentAmount = v , unspentScript = s+ , unspentAddress = eitherToMaybe (scriptToAddressBS (BSS.fromShort s)) }
src/Haskoin/Store/Logic.hs view
@@ -13,8 +13,8 @@ , deleteTx ) where -import Control.Monad (forM, forM_, unless, void, when,- zipWithM_)+import Control.Monad (forM, forM_, guard, unless, void,+ when, zipWithM_) import Control.Monad.Except (MonadError (..)) import Control.Monad.Logger (MonadLogger, logDebugS, logErrorS, logWarnS)@@ -34,20 +34,19 @@ Network (..), OutPoint (..), Tx (..), TxHash, TxIn (..), TxOut (..), addrToString, blockHashToHex,- computeSubsidy, genesisBlock,- genesisNode, headerHash, isGenesis,- nullOutPoint, scriptToAddressBS,- txHash, txHashToHex)+ computeSubsidy, eitherToMaybe,+ genesisBlock, genesisNode, headerHash,+ isGenesis, nullOutPoint,+ scriptToAddressBS, txHash,+ txHashToHex) import Haskoin.Store.Common (StoreRead (..), StoreWrite (..), sortTxs) import Haskoin.Store.Data (Balance (..), BlockData (..), BlockRef (..), BlockTx (..), Prev (..), Spender (..),- StoreInput (..), StoreOutput (..),- Transaction (..), TxData (..),- UnixTime, Unspent (..), confirmed,- fromTransaction, isCoinbase,- nullBalance, toTransaction,+ StoreOutput (..), Transaction (..),+ TxData (..), UnixTime, Unspent (..),+ confirmed, nullBalance, toTransaction, transactionData) import UnliftIO (Exception) @@ -135,7 +134,7 @@ "Cannot delete block that is not head: " <> blockHashToHex h throwError (BlockNotBest (blockHashToHex bh))- txs <- mapM (fmap transactionData . getImportTx) (blockDataTxs bd)+ txs <- mapM (fmap txData . getImportTxData) (blockDataTxs bd) ths <- nub . concat <$> mapM (deleteTx False False . txHash . snd) (reverse (sortTxs txs))@@ -263,23 +262,22 @@ (\i o -> newOutput br (OutPoint (txHash tx) i) o) [0 ..] (txOut tx)- 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 ps =+ I.fromList . zip [0 ..] $+ if iscb+ then []+ else map mkprv us+ d =+ TxData+ { txDataBlock = br+ , txData = tx+ , txDataPrevs = ps+ , txDataDeleted = False+ , txDataRBF = rbf+ , txDataTime = tt }- let (d, _) = fromTransaction t insertTx d- updateAddressCounts (txAddresses t) (+ 1)+ updateAddressCounts (txDataAddresses d) (+ 1) unless (confirmed br) $ insertIntoMempool (txHash tx) (memRefTime br) uns op = getUnspent op >>= \case@@ -317,30 +315,7 @@ Just u -> return (u, ths) th = txHash tx iscb = all (== nullOutPoint) (map prevOutput (txIn tx))- ws = map Just (txWitness tx) <> repeat Nothing- mkcb ip w =- StoreCoinbase- { inputPoint = prevOutput ip- , inputSequence = txInSequence ip- , inputSigScript = scriptInput ip- , inputWitness = w- }- mkin u ip w =- let script = B.Short.fromShort (unspentScript u)- in StoreInput- { inputPoint = prevOutput ip- , inputSequence = txInSequence ip- , inputSigScript = scriptInput ip- , inputPkScript = script- , inputAmount = unspentAmount u- , inputWitness = w- }- mkout o =- StoreOutput- { outputAmount = outValue o- , outputScript = scriptOutput o- , outputSpender = Nothing- }+ mkprv u = Prev (B.Short.fromShort (unspentScript u)) (unspentAmount u) confirmTx :: ( StoreRead m@@ -375,6 +350,8 @@ , unspentPoint = op , unspentAmount = outValue o , unspentScript = B.Short.toShort (scriptOutput o)+ , unspentAddress =+ eitherToMaybe (scriptToAddressBS (scriptOutput o)) } case scriptToAddressBS (scriptOutput o) of Left _ -> return ()@@ -394,6 +371,9 @@ , unspentPoint = op , unspentAmount = outValue o , unspentScript = B.Short.toShort (scriptOutput o)+ , unspentAddress =+ eitherToMaybe+ (scriptToAddressBS (scriptOutput o)) } insertAddrUnspent a@@ -402,6 +382,9 @@ , unspentPoint = op , unspentAmount = outValue o , unspentScript = B.Short.toShort (scriptOutput o)+ , unspentAddress =+ eitherToMaybe+ (scriptToAddressBS (scriptOutput o)) } reduceBalance False False a (outValue o) increaseBalance True False a (outValue o)@@ -532,6 +515,8 @@ , unspentAmount = outValue to , unspentScript = B.Short.toShort (scriptOutput to) , unspentPoint = op+ , unspentAddress =+ eitherToMaybe (scriptToAddressBS (scriptOutput to)) } delOutput ::@@ -543,32 +528,53 @@ => OutPoint -> m () delOutput op = do- t <- getImportTx (outPointHash op)- u <- getTxOutput (outPointIndex op) t+ t <- getImportTxData (outPointHash op)+ u <-+ case getTxOut (outPointIndex op) (txData t) of+ Just u -> return u+ Nothing -> do+ $(logErrorS) "BlockStore" $+ "Output out of range: " <> txHashToHex (txHash (txData t)) <>+ " " <>+ fromString (show (outPointIndex op))+ throwError . OutputOutOfRange . cs $ show op deleteUnspent op- case scriptToAddressBS (outputScript u) of+ case scriptToAddressBS (scriptOutput u) of Left _ -> return () Right a -> do deleteAddrUnspent a Unspent- { unspentScript = B.Short.toShort (outputScript u)- , unspentBlock = transactionBlock t+ { unspentScript = B.Short.toShort (scriptOutput u)+ , unspentBlock = txDataBlock t , unspentPoint = op- , unspentAmount = outputAmount u+ , unspentAmount = outValue u+ , unspentAddress =+ eitherToMaybe (scriptToAddressBS (scriptOutput u)) } deleteAddrTx a BlockTx { blockTxHash = outPointHash op- , blockTxBlock = transactionBlock t+ , blockTxBlock = txDataBlock t }- reduceBalance- (confirmed (transactionBlock t))- True- a- (outputAmount u)+ reduceBalance (confirmed (txDataBlock t)) True a (outValue u) +getImportTxData ::+ (StoreRead m, MonadLogger m, MonadError ImportException m)+ => TxHash+ -> m TxData+getImportTxData th =+ getTxData th >>= \case+ Nothing -> do+ $(logErrorS) "BlockStore" $ "Tx not found: " <> txHashToHex th+ throwError $ TxNotFound (txHashToHex th)+ Just d+ | txDataDeleted d -> do+ $(logErrorS) "BlockStore" $ "Tx deleted: " <> txHashToHex th+ throwError $ TxDeleted (txHashToHex th)+ | otherwise -> return d+ getImportTx :: (StoreRead m, MonadLogger m, MonadError ImportException m) => TxHash@@ -586,6 +592,14 @@ sm <- getSpenders th return $ toTransaction d sm +getTxOut+ :: Word32+ -> Tx+ -> Maybe TxOut+getTxOut i tx = do+ guard (fromIntegral i < length (txOut tx))+ return $ txOut tx !! fromIntegral i+ getTxOutput :: (MonadLogger m, MonadError ImportException m) => Word32@@ -650,7 +664,7 @@ fromString (show (outPointIndex op)) throwError (AlreadyUnspent (cs (show op))) Just s -> return s- x <- getImportTx (spenderHash s)+ x <- getImportTxData (spenderHash s) deleteSpender op let u = Unspent@@ -658,6 +672,8 @@ , unspentBlock = transactionBlock t , unspentScript = B.Short.toShort (outputScript o) , unspentPoint = op+ , unspentAddress =+ eitherToMaybe (scriptToAddressBS (outputScript o)) } insertUnspent u case scriptToAddressBS (outputScript o) of@@ -668,7 +684,7 @@ a BlockTx { blockTxHash = spenderHash s- , blockTxBlock = transactionBlock x+ , blockTxBlock = txDataBlock x } increaseBalance (confirmed (unspentBlock u))@@ -783,13 +799,6 @@ then throwError (BalanceNotFound (addrText net a)) else return b setBalance b {balanceTxCount = f (balanceTxCount b)}--txAddresses :: Transaction -> [Address]-txAddresses t =- nub . rights $- map (scriptToAddressBS . inputPkScript)- (filter (not . isCoinbase) (transactionInputs t)) <>- map (scriptToAddressBS . outputScript) (transactionOutputs t) txDataAddresses :: TxData -> [Address] txDataAddresses t =