haskoin-store 0.26.0 → 0.26.1
raw patch · 5 files changed
+80/−85 lines, 5 filesdep ~haskoin-store-data
Dependency ranges changed: haskoin-store-data
Files
- haskoin-store.cabal +5/−5
- src/Haskoin/Store/BlockStore.hs +32/−9
- src/Haskoin/Store/Cache.hs +9/−4
- src/Haskoin/Store/Common.hs +12/−11
- src/Haskoin/Store/Logic.hs +22/−56
haskoin-store.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 513e05388b9aeae3b17af94550d0da07c8f48cd45bc7dd191c39ac4ba296fbaa+-- hash: 5311cf67a21f834e0890ad311ec5a86ad5678aacdf47bd4e63e0c36ed240332c name: haskoin-store-version: 0.26.0+version: 0.26.1 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.26.0+ , haskoin-store-data ==0.26.1 , 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.26.0+ , haskoin-store-data ==0.26.1 , 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.26.0+ , haskoin-store-data ==0.26.1 , hedis >=0.12.13 , hspec >=2.7.1 , http-types >=0.12.3
src/Haskoin/Store/BlockStore.hs view
@@ -45,13 +45,18 @@ mapMaybe) import Data.String (fromString) import Data.String.Conversions (cs)+import Data.Text (Text)+import Data.Time.Clock.POSIX (posixSecondsToUTCTime) import Data.Time.Clock.System (getSystemTime, systemSeconds)+import Data.Time.Format (defaultTimeLocale, formatTime,+ iso8601DateFormat) import Haskoin (Block (..), BlockHash (..),- BlockHeight, BlockNode (..),- GetData (..), InvType (..),- InvVector (..), Message (..),- Network (..), OutPoint (..),- Tx (..), TxHash (..), TxIn (..),+ BlockHeader (..), BlockHeight,+ BlockNode (..), GetData (..),+ InvType (..), InvVector (..),+ Message (..), Network (..),+ OutPoint (..), Tx (..),+ TxHash (..), TxIn (..), blockHashToHex, headerHash, txHash, txHashToHex) import Haskoin.Node (OnlinePeer (..), Peer,@@ -272,11 +277,14 @@ checkpeer blocknode <- getblocknode p' <- managerPeerText peer =<< asks (blockConfManager . myConfig)+ $(logDebugS) "BlockStore" $+ "Processing block from peer " <> p' <> ": " <>+ blockText blocknode (blockTxns block) lift (runImport (importBlock block blocknode)) >>= \case Right deletedtxids -> do listener <- asks (blockConfListener . myConfig) $(logInfoS) "BlockStore" $- "Best block indexed: " <> hexhash <> " from peer " <> p'+ "Best block: " <> blockText blocknode (blockTxns block) atomically $ do mapM_ (listener . StoreTxDeleted) deletedtxids listener (StoreBestBlock blockhash)@@ -620,10 +628,10 @@ $(logDebugS) "BlockStore" $ "Requesting block " <> cs (show i) <> "/" <> cs (show (length vectors)) <>- ": " <>- blockHashToHex (headerHash (nodeHeader bn)) <> " from peer " <>- p'+ p' <>+ ": " <>+ blockText bn [] MGetData (GetData vectors) `sendMessage` peer where checksyncingpeer =@@ -800,3 +808,18 @@ blockStoreTxHashSTM :: Peer -> [TxHash] -> BlockStore -> STM () blockStoreTxHashSTM peer txhashes store = BlockTxAvailable peer txhashes `sendSTM` store++blockText :: BlockNode -> [Tx] -> Text+blockText bn txs+ | null txs = height <> sep <> time <> sep <> hash+ | otherwise = height <> sep <> time <> sep <> txcount <> sep <> hash+ where+ height = cs $ show (nodeHeight bn)+ systime =+ posixSecondsToUTCTime (fromIntegral (blockTimestamp (nodeHeader bn)))+ time =+ cs $+ formatTime defaultTimeLocale (iso8601DateFormat (Just "%H:%M")) systime+ hash = blockHashToHex (headerHash (nodeHeader bn))+ txcount = cs (show (length txs)) <> " txs"+ sep = " | "
src/Haskoin/Store/Cache.hs view
@@ -960,14 +960,17 @@ MonadLoggerIO m => [Address] -> CacheT m [Maybe AddressXPub] cacheGetAddrsInfo as = runRedis (redisGetAddrsInfo as) -redisAddToMempool :: RedisCtx m f => [BlockTx] -> m (f Integer)+redisAddToMempool :: (Applicative f, RedisCtx m f) => [BlockTx] -> m (f Integer)+redisAddToMempool [] = return (pure 0) redisAddToMempool btxs = zadd mempoolSetKey $ map (\btx -> (blockRefScore (blockTxBlock btx), encode (blockTxHash btx))) btxs -redisRemFromMempool :: RedisCtx m f => [TxHash] -> m (f Integer)-redisRemFromMempool = zrem mempoolSetKey . map encode+redisRemFromMempool ::+ (Applicative f, RedisCtx m f) => [TxHash] -> m (f Integer)+redisRemFromMempool [] = return (pure 0)+redisRemFromMempool xs = zrem mempoolSetKey $ map encode xs redisSetAddrInfo :: (Functor f, RedisCtx m f) => Address -> AddressXPub -> m (f ())@@ -1016,7 +1019,9 @@ zadd (txSetPfx <> encode xpub) $ map (\t -> (blockRefScore (blockTxBlock t), encode (blockTxHash t))) btxs -redisRemXPubTxs :: RedisCtx m f => XPubSpec -> [TxHash] -> m (f Integer)+redisRemXPubTxs ::+ (Applicative f, RedisCtx m f) => XPubSpec -> [TxHash] -> m (f Integer)+redisRemXPubTxs _ [] = return (pure 0) redisRemXPubTxs xpub txhs = zrem (txSetPfx <> encode xpub) (map encode txhs) redisAddXPubUnspents ::
src/Haskoin/Store/Common.hs view
@@ -32,8 +32,9 @@ import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Data.ByteString (ByteString) import Data.Function (on)+import qualified Data.HashSet as H import Data.IntMap.Strict (IntMap)-import Data.List (nub, partition, sortBy)+import Data.List (nub, sortBy) import Data.Maybe (listToMaybe) import Data.Serialize (Serialize (..)) import Data.Word (Word32, Word64)@@ -322,14 +323,14 @@ applyLimitC (Just l) = takeC (fromIntegral l) sortTxs :: [Tx] -> [(Word32, Tx)]-sortTxs txs = go $ zip [0 ..] txs+sortTxs txs = go [] thset $ zip [0 ..] txs where- go [] = []- go ts =- let (is, ds) =- partition- (all ((`notElem` map (txHash . snd) ts) .- outPointHash . prevOutput) .- txIn . snd)- ts- in is <> go ds+ thset = H.fromList (map txHash txs)+ go [] _ [] = []+ go orphans ths [] = go [] ths orphans+ go orphans ths ((i, tx):xs) =+ let ops = map (outPointHash . prevOutput) (txIn tx)+ orp = any (`H.member` ths) ops+ in if orp+ then go ((i, tx) : orphans) ths xs+ else (i, tx) : go orphans (txHash tx `H.delete` ths) xs
src/Haskoin/Store/Logic.hs view
@@ -43,11 +43,9 @@ sortTxs) import Haskoin.Store.Data (Balance (..), BlockData (..), BlockRef (..), BlockTx (..),- Prev (..), Spender (..),- StoreOutput (..), Transaction (..),- TxData (..), UnixTime, Unspent (..),- confirmed, nullBalance, toTransaction,- transactionData)+ Prev (..), Spender (..), TxData (..),+ UnixTime, Unspent (..), confirmed,+ nullBalance) import UnliftIO (Exception) data ImportException@@ -575,23 +573,6 @@ throwError $ TxDeleted (txHashToHex th) | otherwise -> return d -getImportTx ::- (StoreRead m, MonadLogger m, MonadError ImportException m)- => TxHash- -> m Transaction-getImportTx 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 -> do- sm <- getSpenders th- return $ toTransaction d sm- getTxOut :: Word32 -> Tx@@ -600,25 +581,6 @@ guard (fromIntegral i < length (txOut tx)) return $ txOut tx !! fromIntegral i -getTxOutput ::- (MonadLogger m, MonadError ImportException m)- => Word32- -> Transaction- -> m StoreOutput-getTxOutput i tx = do- unless (fromIntegral i < length (transactionOutputs tx)) $ do- $(logErrorS) "BlockStore" $- "Output out of range: " <> txHashToHex (txHash (transactionData tx)) <>- " " <>- fromString (show i)- throwError . OutputOutOfRange . cs $- show- OutPoint- { outPointHash = txHash (transactionData tx)- , outPointIndex = i- }- return $ transactionOutputs tx !! fromIntegral i- spendOutput :: ( StoreRead m , StoreWrite m@@ -653,10 +615,16 @@ => OutPoint -> m () unspendOutput op = do- t <- getImportTx (outPointHash op)- o <- getTxOutput (outPointIndex op) t+ t <- getImportTxData (outPointHash op)+ o <-+ case getTxOut (outPointIndex op) (txData t) of+ Nothing -> do+ $(logErrorS) "BlockStore" $+ "Output out of range: " <> cs (show op)+ throwError (OutputOutOfRange (cs (show op)))+ Just o -> return o s <-- case outputSpender o of+ getSpender op >>= \case Nothing -> do $(logErrorS) "BlockStore" $ "Output already unspent: " <> txHashToHex (outPointHash op) <>@@ -666,31 +634,29 @@ Just s -> return s x <- getImportTxData (spenderHash s) deleteSpender op+ let m = eitherToMaybe (scriptToAddressBS (scriptOutput o)) let u = Unspent- { unspentAmount = outputAmount o- , unspentBlock = transactionBlock t- , unspentScript = B.Short.toShort (outputScript o)+ { unspentAmount = outValue o+ , unspentBlock = txDataBlock t+ , unspentScript = B.Short.toShort (scriptOutput o) , unspentPoint = op- , unspentAddress =- eitherToMaybe (scriptToAddressBS (outputScript o))+ , unspentAddress = m } insertUnspent u- case scriptToAddressBS (outputScript o) of- Left _ -> return ()- Right a -> do+ case m of+ Nothing -> return ()+ Just a -> do insertAddrUnspent a u deleteAddrTx a BlockTx- { blockTxHash = spenderHash s- , blockTxBlock = txDataBlock x- }+ {blockTxHash = spenderHash s, blockTxBlock = txDataBlock x} increaseBalance (confirmed (unspentBlock u)) False a- (outputAmount o)+ (outValue o) reduceBalance :: ( StoreRead m