haskoin-store 1.14.0 → 1.15.0

raw patch · 14 files changed

+418/−57 lines, 14 filesdep ~haskoin-coredep ~haskoin-store-dataPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: haskoin-core, haskoin-store-data

API changes (from Hackage documentation)

Files

• CHANGELOG.md +37/−0
• README.md +1/−0
• bench/Main.hs +23/−8
• haskoin-store.cabal +15/−13
• src/Haskoin/Store/Common.hs +10/−3
• src/Haskoin/Store/Database/Query.hs +36/−8
• src/Haskoin/Store/Database/Query/Layered.hs +18/−0
• src/Haskoin/Store/Database/Query/Pooled.hs +18/−0
• src/Haskoin/Store/Database/Slices.hs +152/−0
• src/Haskoin/Store/Web.hs +35/−22
• src/Haskoin/Store/Web/Pieces.hs +3/−2
• swagger.yaml +1/−1
• test/Haskoin/Store/Database/SlicesSpec.hs +65/−0
• test/Haskoin/Store/IntegrationSpec.hs +4/−0

@@ -4,6 +4,43 @@ 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) +## [1.15.0] - 2026-11-14++Answers decode less of what they read, and write hex faster.++### Changed+- **Raw answers send the transactions as stored.** A raw transaction,+  raw block, or the raw transactions of a block, were decoded, built into+  their JSON form, with addresses and ids, turned back and serialized+  again; and the spenders of their outputs were read for nothing. Now the+  bytes of each transaction are found in its stored value and written as+  they are. The raw block of 3,011 transactions of the load test takes 21+  ms of CPU where it took 60, and its raw transactions 24 ms where they+  took 65. This covers `/transaction/:txid/raw`, `/transactions/raw`,+  `/transactions/block/:block/raw`, the five `/block/…/raw` routes, and+  the hex of `/blockchain/rawtx` and `/blockchain/rawblock`.+- **A block's list of transactions is decoded when it is used.** Reading+  a block decoded the hashes of all its transactions, 180 µs for a block+  of 3,000, for the many reads that want its height or its header: the+  health check, the best block of a request, the median time of a new+  transaction, blocks without their transactions. `/block/best?notx=true`+  on a block of 3,011 transactions takes 0.06 ms of CPU where it took+  0.24, and `/block/latest?notx=true` 31% less.+- **Transactions in JSON are built without serializing them.** Their size+  and weight are counted from their parts, and the id of a transaction+  read by its id is not computed again (haskoin-store-data's+  `toTransactionWithId`). With the faster hex of haskoin-core, 5,000 full+  transactions of an address take 20% less CPU, and the 3,011 of a block+  21% less.+- **Hex is written faster** (haskoin-core): from a table of digit pairs,+  and the hashes of transactions and blocks in one step, five times as+  fast. A list of 100 transactions of an address takes 12% less CPU.+- `StoreRead` has `getManyTxBytes`, the transactions as stored, and the+  new module `Haskoin.Store.Database.Slices` reads stored values in part.+- The load test's last block holds 3,000 more transactions, when the chain+  has 400 blocks or more, and `scripts/bench-web.sh` measures the raw+  answers.+ ## [1.14.0] - 2026-11-14  Long answers are encoded on several cores, addresses are written faster,

@@ -733,6 +733,7 @@ | `Haskoin.Store.Logic.Layered` | The rules that import blocks and transactions | | `Haskoin.Store.Database.Mempool` | The keys of the mempool area, and what it does to balances | | `Haskoin.Store.Database.Query.Layered` | The queries over both areas, each on a snapshot |+| `Haskoin.Store.Database.Slices` | Stored blocks and transactions read in part, for what an answer needs | | `Haskoin.Store.Database.Migrate` | The migrations from versions 20 and 21 | | `Haskoin.Store.Cache` | The Redis cache of a server alone | | `Haskoin.Store.Fleet.Member`, `Haskoin.Store.Fleet.XPub` | A fleet, and its cache |

@@ -13,7 +13,8 @@ -- output of each transaction pay the "hot" address, so it gains eleven -- transactions per block. Nine outputs per block go to the first 100 -- external and change addresses of the benchmark xpub, in turn. Both are--- printed once the chain is synced.+-- printed once the chain is synced. With 400 blocks or more, the last one+-- also holds 3,000 transactions that spend outputs of the hot address. module Main (main) where  import Conduit@@ -175,18 +176,32 @@ scriptOf :: Ctx -> Address -> ByteString scriptOf ctx = fromMaybe (error "script") . addressToScriptBS ctx --- | Blocks at heights 1 to n on top of the regtest genesis.+-- | Blocks at heights 1 to n on top of the regtest genesis. The last block+-- of a chain of 400 blocks or more also spends 3,000 outputs that earlier+-- blocks paid to the hot address, one transaction each, so that there is a+-- large block to answer about. chain :: Ctx -> Network -> Int -> [Block]-chain ctx net n = go 1 net.genesisHeader Nothing+chain ctx net n = go 1 net.genesisHeader   where     hot = scriptOf ctx (hotAddr ctx)-    go h parent prevcb+    coinbase h = Tx 1 [TxIn nullOutPoint (encode (fromIntegral h :: Word32)) maxBound] [TxOut 5000000000 hot] [] 0+    -- the transactions of the block at a height, after its coinbase+    regular h+      | h <= 1 = []+      | otherwise = spends h (txHash (coinbase (h - 1)))+    go h parent       | h > n = []       | otherwise =-          let cb = Tx 1 [TxIn nullOutPoint (encode (fromIntegral h :: Word32)) maxBound] [TxOut 5000000000 hot] [] 0-              txs = maybe [] (spends h) prevcb-              block = mine net parent (cb : txs)-           in block : go (h + 1) block.header (Just (txHash cb))+          let extra = if h == n && n >= 400 then wide else []+              block = mine net parent (coinbase h : regular h <> extra)+           in block : go (h + 1) block.header+    -- the outputs to the hot address of the transactions of blocks 2 to+    -- 335, nine a block, each spent by a transaction of its own+    wide =+      [ Tx 1 [TxIn (OutPoint (txHash t) 1) "" maxBound] [TxOut 98990000 hot] [] 0+      | h <- [2 .. 335],+        t <- drop 1 (regular h)+      ]     spends h cb =       let t1 = Tx 1 [TxIn (OutPoint cb 0) "" maxBound] (replicate 9 (TxOut 500000000 hot)) [] 0           tk k =

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-store-version:        1.14.0+version:        1.15.0 synopsis:       Storage and index for Bitcoin and Bitcoin Cash description:    An indexer for Bitcoin and Bitcoin Cash. It downloads blocks and mempool                 transactions from the peer-to-peer network, indexes them in RocksDB, and@@ -63,6 +63,7 @@       Haskoin.Store.Database.Query.Layered       Haskoin.Store.Database.Query.Pooled       Haskoin.Store.Database.Reader+      Haskoin.Store.Database.Slices       Haskoin.Store.Database.Types       Haskoin.Store.Database.Views       Haskoin.Store.Database.Writer@@ -108,9 +109,9 @@     , file-embed >=0.0.16.0 && <0.1     , hashable >=1.5.1.0 && <1.6     , hashtables >=1.4.2 && <1.5-    , haskoin-core >=1.6.3 && <1.7+    , haskoin-core >=1.6.4 && <1.7     , haskoin-node >=2.5.1 && <2.6-    , haskoin-store-data >=2.0.1 && <2.1+    , haskoin-store-data >=2.0.2 && <2.1     , hedis >=0.16.4 && <0.17     , http-types >=0.12.6 && <0.13     , lens >=5.3.6 && <5.4@@ -172,9 +173,9 @@     , file-embed >=0.0.16.0 && <0.1     , hashable >=1.5.1.0 && <1.6     , hashtables >=1.4.2 && <1.5-    , haskoin-core >=1.6.3 && <1.7+    , haskoin-core >=1.6.4 && <1.7     , haskoin-node >=2.5.1 && <2.6-    , haskoin-store-data >=2.0.1 && <2.1+    , haskoin-store-data >=2.0.2 && <2.1     , hedis >=0.16.4 && <0.17     , http-types >=0.12.6 && <0.13     , lens >=5.3.6 && <5.4@@ -234,10 +235,10 @@     , filepath >=1.5.5.0 && <1.6     , hashable >=1.5.1.0 && <1.6     , hashtables >=1.4.2 && <1.5-    , haskoin-core >=1.6.3 && <1.7+    , haskoin-core >=1.6.4 && <1.7     , haskoin-node >=2.5.1 && <2.6     , haskoin-store-    , haskoin-store-data >=2.0.1 && <2.1+    , haskoin-store-data >=2.0.2 && <2.1     , hedis >=0.16.4 && <0.17     , http-types >=0.12.6 && <0.13     , lens >=5.3.6 && <5.4@@ -278,6 +279,7 @@       Haskoin.Store.CommonSpec       Haskoin.Store.Database.MigrateSpec       Haskoin.Store.Database.Query.LayeredSpec+      Haskoin.Store.Database.SlicesSpec       Haskoin.Store.Database.ViewsSpec       Haskoin.Store.Fleet.MemberSpec       Haskoin.Store.Fleet.PoolSpec@@ -325,10 +327,10 @@     , file-embed >=0.0.16.0 && <0.1     , hashable >=1.5.1.0 && <1.6     , hashtables >=1.4.2 && <1.5-    , haskoin-core >=1.6.3 && <1.7+    , haskoin-core >=1.6.4 && <1.7     , haskoin-node >=2.5.1 && <2.6     , haskoin-store-    , haskoin-store-data >=2.0.1 && <2.1+    , haskoin-store-data >=2.0.2 && <2.1     , hedis >=0.16.4 && <0.17     , hspec >=2.11.18 && <2.12     , http-types >=0.12.6 && <0.13@@ -391,10 +393,10 @@     , file-embed >=0.0.16.0 && <0.1     , hashable >=1.5.1.0 && <1.6     , hashtables >=1.4.2 && <1.5-    , haskoin-core >=1.6.3 && <1.7+    , haskoin-core >=1.6.4 && <1.7     , haskoin-node >=2.5.1 && <2.6     , haskoin-store-    , haskoin-store-data >=2.0.1 && <2.1+    , haskoin-store-data >=2.0.2 && <2.1     , hedis >=0.16.4 && <0.17     , http-types >=0.12.6 && <0.13     , lens >=5.3.6 && <5.4@@ -454,10 +456,10 @@     , file-embed >=0.0.16.0 && <0.1     , hashable >=1.5.1.0 && <1.6     , hashtables >=1.4.2 && <1.5-    , haskoin-core >=1.6.3 && <1.7+    , haskoin-core >=1.6.4 && <1.7     , haskoin-node >=2.5.1 && <2.6     , haskoin-store-    , haskoin-store-data >=2.0.1 && <2.1+    , haskoin-store-data >=2.0.2 && <2.1     , hedis >=0.16.4 && <0.17     , http-types >=0.12.6 && <0.13     , integration

@@ -113,6 +113,7 @@     XPubUnspent (..),     nullBalance,     toTransaction,+    toTransactionWithId,     zeroBalance,   ) @@ -184,6 +185,11 @@     -- | data of many transactions, in the order of their hashes, read     -- together     getManyTxData :: [TxHash] -> IO [Maybe TxData],+    -- | many transactions as stored, in the format of the network, in the+    -- order of their hashes, read together, and left out where+    -- 'getManyTxData' leaves them out. Nothing of them is decoded, and the+    -- spenders of their outputs are not read: this is for raw answers+    getManyTxBytes :: [TxHash] -> IO [Maybe ByteString],     -- | transaction input that spends an output, if it is spent     getSpender :: OutPoint -> IO (Maybe Spender),     -- | balance of an address, or 'Nothing' if it was never used@@ -413,11 +419,12 @@  -- | Transaction with its metadata, or 'Nothing' if it is unknown. getTransaction :: StoreRead -> TxHash -> IO (Maybe Transaction)-getTransaction r h = fmap (toTransaction r.net r.ctx) <$> r.getTxData h+getTransaction r h = fmap (toTransactionWithId r.net r.ctx h) <$> r.getTxData h --- | Many transactions, in the order of their hashes, read together.+-- | Many transactions, in the order of their hashes, read together. Each is+-- read by its id, so its id is not computed again ('toTransactionWithId'). getTransactions :: StoreRead -> [TxHash] -> IO [Maybe Transaction]-getTransactions r hs = map (fmap (toTransaction r.net r.ctx)) <$> r.getManyTxData hs+getTransactions r hs = zipWith (fmap . toTransactionWithId r.net r.ctx) hs <$> r.getManyTxData hs  -- | Transactions that match a short numeric identifier; see 'getNumTxData'. getNumTransaction :: StoreRead -> Word64 -> IO [Transaction]

@@ -42,6 +42,8 @@     getTxData,     getTxRecord,     getManyTxData,+    getManyTxBytes,+    liveTxBytes,     getChainSpender,     getChainSpenders,     withChainSpenders,@@ -77,6 +79,7 @@     count,     withManyIters,     retrieveManyCF,+    retrieveManyBytesCF,     joinConduits,     usedAddresses,   )@@ -98,6 +101,7 @@   ) import Control.Monad (forM, (>=>)) import Data.Bits ((.&.))+import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.Default (def) import Data.Functor ((<&>))@@ -156,6 +160,7 @@   ) import Haskoin.Store.Data import Haskoin.Store.Database.Reader+import Haskoin.Store.Database.Slices (blockData, txBytes) import Haskoin.Store.Database.Types import System.Metrics.StatsD (decrementGauge, incrementCounter, incrementGauge) import UnliftIO@@ -182,6 +187,7 @@       getBlock = getBlock r,       getTxData = fmap notDeleted . getTxData r,       getManyTxData = fmap (map notDeleted) . getManyTxData r,+      getManyTxBytes = getManyTxBytes r,       getSpender = getSpender r,       getBalance = getBalance r,       getUnspent = getUnspent r,@@ -236,14 +242,16 @@   rows <- matchingAsListCF r.db (heightCF r.db) (ReplacedAtKeyH h)   return [t | (ReplacedAtKey _ t, ()) <- rows] --- | Data of a block.+-- | Data of a block. Its list of transactions is decoded when it is used,+-- as "Haskoin.Store.Database.Slices" explains: most reads of a block want+-- its height or its header. getBlock :: DatabaseReader -> BlockHash -> IO (Maybe BlockData) getBlock r h =-  retrieveCF r.db (blockCF r.db) (BlockKey h) >>= \case+  getCF r.db (blockCF r.db) (encode (BlockKey h)) >>= \case     Nothing -> return Nothing-    Just b -> do+    Just bytes -> do       count r $ \s -> incrementCounter s.dataBlockCount 1-      return (Just b)+      return (Just (either error id (blockData bytes)))  ------------------------------------------------------------------------------- -- Transactions@@ -280,6 +288,22 @@     fill (Nothing : more) tds = Nothing : fill more tds     fill _ _ = [] +-- | Transactions as stored, in the format of the network, without the+-- deleted ones: slices of their values ("Haskoin.Store.Database.Slices"),+-- without the spenders of their outputs.+getManyTxBytes :: DatabaseReader -> [TxHash] -> IO [Maybe ByteString]+getManyTxBytes r ths = do+  found <- map (>>= liveTxBytes) <$> retrieveManyBytesCF r.db (txCF r.db) (map TxKey ths)+  count r $ \s -> incrementCounter s.dataTxCount (length (catMaybes found))+  return found++-- | The transaction of a stored 'TxData', unless it is deleted.+liveTxBytes :: ByteString -> Maybe ByteString+liveTxBytes value = case txBytes value of+  Right (bytes, False) -> Just bytes+  Right (_, True) -> Nothing+  Left e -> error ("liveTxBytes: " <> e)+ -- | The input of a block that spends an output, if one does: one read by -- key, of the group of outputs that it is in, in a database of version 22. getChainSpender :: DatabaseReader -> OutPoint -> IO (Maybe Spender)@@ -698,10 +722,14 @@ -- way to read one key, and most requests about one transaction or one -- address ask for one. retrieveManyCF :: (Serialize key, Serialize value) => DB -> ColumnFamily -> [key] -> IO [Maybe value]-retrieveManyCF _ _ [] = return []-retrieveManyCF db cf [key] = pure . fmap (either error id . decode) <$> getCF db cf (encode key)-retrieveManyCF db cf keys =-  map (fmap (either error id . decode)) <$> multiGetCF db cf (map encode keys)+retrieveManyCF db cf keys = map (fmap (either error id . decode)) <$> retrieveManyBytesCF db cf keys++-- | The bytes of the values of many keys, as 'retrieveManyCF' reads them,+-- for values that are read in part ("Haskoin.Store.Database.Slices").+retrieveManyBytesCF :: (Serialize key) => DB -> ColumnFamily -> [key] -> IO [Maybe ByteString]+retrieveManyBytesCF _ _ [] = return []+retrieveManyBytesCF db cf [key] = pure <$> getCF db cf (encode key)+retrieveManyBytesCF db cf keys = multiGetCF db cf (map encode keys)  -- | Merge streams sorted newest first, drop duplicates, and apply the offset -- and limit.

@@ -79,6 +79,7 @@     -- * Transactions     getTxData,     getManyTxData,+    getManyTxBytes,     getNumTxData,     getSpender, @@ -119,6 +120,7 @@   ) import Control.Monad (forM) import Data.Bits ((.&.))+import Control.Applicative ((<|>)) import Data.ByteString qualified as BS import Data.Functor ((<&>)) import Data.HashMap.Strict (HashMap)@@ -243,6 +245,7 @@       getBlock = getBlock v,       getTxData = fmap notDeleted . getTxData v,       getManyTxData = fmap (map notDeleted) . getManyTxData v,+      getManyTxBytes = getManyTxBytes v,       getSpender = getSpender v,       getBalance = getBalance v,       getUnspent = getUnspent v,@@ -279,6 +282,7 @@       getBlock = \h -> one (\q -> q.getBlock h),       getTxData = \h -> one (\q -> q.getTxData h),       getManyTxData = \hs -> one (\q -> q.getManyTxData hs),+      getManyTxBytes = \hs -> one (\q -> q.getManyTxBytes hs),       getSpender = \p -> one (\q -> q.getSpender p),       getBalance = \a -> one (\q -> q.getBalance a),       getUnspent = \p -> one (\q -> q.getUnspent p),@@ -343,6 +347,20 @@   let tds = [withSpenders spent h <$> Map.lookup h found | h <- hs]   Q.count r $ \s -> incrementCounter s.dataTxCount (length (catMaybes tds))   return tds++-- | Transactions as stored, in the format of the network, from the mempool+-- area or the chain, as 'getManyTxData' finds them, without the deleted+-- ones and without reading the spenders of their outputs.+getManyTxBytes :: View -> [TxHash] -> IO [Maybe BS.ByteString]+getManyTxBytes (View r) hs = do+  unconfirmed <- look (mempoolCF r.db) hs+  chain <- look (txCF r.db) (filter (`Map.notMember` unconfirmed) hs)+  let found = [Map.lookup h unconfirmed <|> Map.lookup h chain >>= Q.liveTxBytes | h <- hs]+  Q.count r $ \s -> incrementCounter s.dataTxCount (length (catMaybes found))+  return found+  where+    look _ [] = return Map.empty+    look cf ks = Map.fromList . catMaybes . zipWith (fmap . (,)) ks <$> Q.retrieveManyBytesCF r.db cf (map TxKey ks)  -- | Transactions whose hash, read as a number, matches a short identifier of -- the Blockchain.info API, in the order of their hashes. There may be more

@@ -61,6 +61,9 @@   ) import Control.Monad (forM) import Data.Bits ((.&.))+import Control.Applicative ((<|>))+import Data.Bytes.Put (runPutS)+import Data.Bytes.Serial (serialize) import Data.ByteString qualified as BS import Data.Functor ((<&>)) import Data.HashMap.Strict qualified as HashMap@@ -179,6 +182,7 @@       getBlock = Q.getBlock r,       getTxData = \h -> only <$> getManyTxData r pool [h],       getManyTxData = getManyTxData r pool,+      getManyTxBytes = getManyTxBytes r pool,       getSpender = getSpender r pool,       getBalance = getBalance r pool,       getUnspent = getUnspent r pool,@@ -221,6 +225,20 @@ getManyTxData r pool hs = do   found <- known r pool hs   return [Map.lookup h found | h <- hs]++-- | Transactions in the format of the network: those that the pool has,+-- serialized from what it gives, and those that the chain has, as stored,+-- for the others, without the deleted ones and without spenders.+getManyTxBytes :: DatabaseReader -> PoolReads -> [TxHash] -> IO [Maybe BS.ByteString]+getManyTxBytes _ _ [] = return []+getManyTxBytes r pool hs = do+  inPool <- zip hs <$> pool.bodies hs+  let unconfirmed = Map.fromList [(h, runPutS (serialize td.tx)) | (h, (Just td, _)) <- inPool]+      rest = filter (`Map.notMember` unconfirmed) hs+  chain <-+    Map.fromList . catMaybes . zipWith (\h v -> (,) h <$> (v >>= Q.liveTxBytes)) rest+      <$> Q.retrieveManyBytesCF r.db (txCF r.db) (map TxKey rest)+  return [Map.lookup h unconfirmed <|> Map.lookup h chain | h <- hs]  -- | The data of transactions by hash: those that the pool has, and those -- that the chain has for the others, each with the spenders that blocks

@@ -0,0 +1,152 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedRecordDot #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module      : Haskoin.Store.Database.Slices+-- Copyright   : No rights reserved+-- License     : MIT+-- Maintainer  : jprupp@protonmail.ch+-- Stability   : experimental+-- Portability : POSIX+--+-- Stored values read in part: what an answer needs, and nothing more.+--+-- A value of the database is decoded whole, as a rule, into the type that+-- it stores. Two of them are often read for a small part of what they hold:+--+-- * A block ('BlockData') holds the hash of every one of its transactions.+--   Most reads of a block want its height, its header or its time: the+--   health check, the best block of a request, a block without its+--   transactions. Decoding the hashes took 180 µs for a block of 3,000+--   transactions and 2.4 ms for one of 20,000, where the rest took less+--   than a microsecond.+--+-- * A transaction ('TxData') holds the transaction in the format of the+--   network, which is what a raw answer sends. Building the transaction to+--   serialize it again took ten times as long as finding its bytes, and+--   read the spenders of its outputs, which a raw answer does not need.+--+-- 'blockData' gives the block whole, with its list of transactions decoded+-- the first time that it is used: the type stays the same, and every caller+-- gains. 'txBytes' gives the bytes of the transaction, a slice of the value,+-- found by skipping over the parts of the transaction rather than building+-- them. Both are held to the full decoders by the tests.+module Haskoin.Store.Database.Slices+  ( blockData,+    txBytes,+  )+where++import Control.Monad (replicateM, replicateM_, unless, when)+import Data.ByteString (ByteString)+import Data.ByteString qualified as B+import Data.Bytes.Get (runGetS)+import Data.Bytes.Serial (deserialize)+import Data.Serialize.Get+  ( Get,+    getBytes,+    getWord32be,+    getWord64be,+    getWord8,+    lookAhead,+    remaining,+    runGet,+    skip,+  )+import Haskoin (BlockHeader, TxHash, VarInt (..), getInteger)+import Haskoin.Store.Data (BlockData (..), BlockRef)++-- | A block as stored, decoded with its list of transactions left as bytes+-- until it is used. The list is then decoded at once, as the full decoder+-- would have: what the block holds is the same either way. Its bytes were+-- checked to be there, so decoding them later cannot fail.+blockData :: ByteString -> Either String BlockData+blockData = runGet $ do+  height <- getWord32be+  main <- deserialize+  work <- getInteger+  header <- deserialize :: Get BlockHeader+  size <- getWord32be+  weight <- getWord32be+  n <- count+  left <- remaining+  when (n > left `div` 32) $ fail "blockData: fewer bytes than transactions"+  hashes <- getBytes (32 * n)+  outputs <- getWord64be+  fee <- getWord64be+  subsidy <- getWord64be+  return BlockData {txs = later n hashes, ..}+  where+    -- the first cell of the list is made at once, as the field is strict;+    -- its head, the coinbase, which a block without its transactions still+    -- shows, is decoded by itself, and the tail all at once when it is used+    later :: Int -> ByteString -> [TxHash]+    later 0 _ = []+    later n hashes =+      decoded deserialize (B.take 32 hashes)+        : decoded (replicateM (n - 1) deserialize) (B.drop 32 hashes)+    decoded :: Get a -> ByteString -> a+    decoded parser bytes = either error id (runGetS parser bytes)++-- | The transaction of a stored 'TxData', in the format of the network, as+-- 'Data.Bytes.Serial.serialize' wrote it there, and whether the transaction+-- is deleted. The parts of the transaction are skipped over by their+-- lengths, as the decoder of haskoin-core reads them, without building+-- them; the checks of that decoder were made when the value was written.+txBytes :: ByteString -> Either String (ByteString, Bool)+txBytes value = flip runGet value $ do+  _ <- deserialize :: Get BlockRef+  before <- remaining+  skipTx+  after <- remaining+  -- the outputs that the inputs spend: a key and a script and a value each+  entries <- count+  replicateM_ entries (skip 8 >> count >>= skip >> skip 8)+  deleted <- deserialize+  let start = B.length value - before+  return (B.take (before - after) (B.drop start value), deleted)++-- | Skip a transaction in the format of the network: the old one, or the+-- one with a witness of BIP 144, told apart as the decoder of haskoin-core+-- tells them, by the flags after a marker of zero.+skipTx :: Get ()+skipTx = do+  skip 4+  flags <- lookAhead $ do+    marker <- getWord8+    if marker == 0 then Just <$> getWord8 else return Nothing+  case flags of+    Just 0x01 -> do+      skip 2+      inputs <- varCount+      replicateM_ inputs input+      varCount >>= flip replicateM_ output+      replicateM_ inputs (varCount >>= flip replicateM_ (varCount >>= skip))+      skip 4+    Just 0x00 -> legacy+    Nothing -> legacy+    Just other -> fail ("txBytes: unknown flags " <> show other)+  where+    legacy = do+      varCount >>= flip replicateM_ input+      varCount >>= flip replicateM_ output+      skip 4+    -- an outpoint, a script and a sequence+    input = skip 36 >> varCount >>= skip >> skip 4+    -- a value and a script+    output = skip 8 >> varCount >>= skip++-- | A count of the network's format, as a variable integer.+varCount :: Get Int+varCount = do+  VarInt n <- deserialize+  unless (n <= fromIntegral (maxBound :: Int)) $ fail "txBytes: count too large"+  return (fromIntegral n)++-- | A 64-bit count of the store's format, that must fit an 'Int'.+count :: Get Int+count = do+  n <- getWord64be+  unless (n <= fromIntegral (maxBound :: Int)) $ fail "count too large"+  return (fromIntegral n)

@@ -125,7 +125,8 @@   ) import Data.Aeson.Types (parseMaybe) import Data.ByteString.Base16 (decodeBase16, parseBase16)-import Data.ByteString.Builder (lazyByteString)+import Data.ByteString (ByteString)+import Data.ByteString.Builder (Builder, lazyByteString) import Data.ByteString.Char8 qualified as C import Data.ByteString.Lazy qualified as L import Data.Bytes.Get@@ -139,7 +140,7 @@ import Data.HashSet qualified as HashSet import Data.Int (Int64) import Data.List qualified-import Data.List (nub)+import Data.List (intersperse, nub) import Data.Maybe   ( catMaybes,     fromJust,@@ -256,6 +257,7 @@     getRequestBodyChunk,     mapResponseHeaders,     modifyResponse,+    responseBuilder,     responseLBS,     responseStatus,     responseStream,@@ -1063,7 +1065,7 @@     marshalled ["notx"] (\r -> GetBlockMTP <$> cap r <*> dflt r) (handleBlockMTP st),     marshalled ["notx"] (\r -> GetBlock <$> cap r <*> dflt r) (handleBlock st),     marshalled [] (\r -> GetTx <$> cap r) (handleTx st),-    plain [] (\r -> GetTxRaw <$> cap r) (handleTxRaw st),+    pieces (.txRaw) [] (\r -> GetTxRaw <$> cap r) (handleTxRaw st),     pathPosted [] (\r -> PostTx <$> parseTxBody st r) (handlePostTx st),     plainList limits (\r -> GetAddrTxs <$> cap r <*> lim r) (handleAddrTxs st),     marshalled [] (\r -> GetAddrBalance <$> cap r) (handleAddrBalance st),@@ -1080,7 +1082,7 @@     pieces (.blockRaw) [] (\r -> GetBlockTimeRaw <$> cap r) (handleBlockTimeRaw st),     pieces (.blockRaw) [] (\r -> GetBlockMTPRaw <$> cap r) (handleBlockMTPRaw st),     marshalledList ["txids"] (\r -> GetTxs <$> need r) (handleTxs st),-    plain ["txids"] (\r -> GetTxsRaw <$> need r) (handleTxsRaw st),+    pieces (.txRaw) ["txids"] (\r -> GetTxsRaw <$> need r) (handleTxsRaw st),     marshalledPieces (.txBlock) [] (\r -> GetTxsBlock <$> cap r) (handleTxsBlock st),     pieces (.txBlockRaw) [] (\r -> GetTxsBlockRaw <$> cap r) (handleTxsBlockRaw st),     plain [] (\r -> GetTxAfter <$> cap r <*> cap r) (handleTxAfter st),@@ -1362,8 +1364,14 @@ rawBlock :: StoreRead -> BlockData -> [Piece] rawBlock q b =   around (hexOf b.header <> hexOf (VarInt (fromIntegral (length b.txs)))) mempty $-    map piece (pieced pieceSize (fmap (foldMap (hexOf . transactionData) . catMaybes) . C.getTransactions q) b.txs)+    map piece (pieced pieceSize (fmap (foldMap rawHex . catMaybes) . q.getManyTxBytes) b.txs) +-- | The hex of bytes as stored, such as a transaction in the format of the+-- network: read as they are, and written with the table of haskoin-core's+-- 'hexBuilder'.+rawHex :: ByteString -> Builder+rawHex = hexBuilder . L.fromStrict+ -- | The pieces of the JSON of a 'RawResult', from those of the hexadecimal. rawResult :: [Piece] -> [Piece] rawResult = around "{\"result\":\"" "\"}"@@ -1499,23 +1507,24 @@ handleTxRaw ::   WebState ->   GetTxRaw ->-  IO (RawResult Tx)+  IO [Piece] handleTxRaw st (GetTxRaw txid) =-  withMetrics st (.txRaw) $-    C.getTransaction st.query txid-      >>= \case-        Nothing -> notFoundTx st txid-        Just tx -> return $ RawResult (transactionData tx)+  st.query.getManyTxBytes [txid] >>= \case+    [Just bytes] -> return (rawResult [piece (return (rawHex bytes))])+    _ -> notFoundTx st txid --- | Handler for @GET \/transactions\/raw?txids=…@: several transactions, serialized.+-- | Handler for @GET \/transactions\/raw?txids=…@: several transactions, serialized. The client names+-- them, so they are all read before the answer begins, in one piece. handleTxsRaw ::   WebState ->   GetTxsRaw ->-  IO (RawResultList Tx)-handleTxsRaw st (GetTxsRaw txids) =-  withMetrics st (.txRaw) $-    RawResultList . map transactionData . catMaybes-      <$> C.getTransactions st.query (nub txids)+  IO [Piece]+handleTxsRaw st (GetTxsRaw txids) = do+  found <- catMaybes <$> st.query.getManyTxBytes (nub txids)+  return [piece (return (listOf (map quoted found)))]+  where+    listOf items = "[" <> mconcat (intersperse "," items) <> "]"+    quoted bytes = "\"" <> rawHex bytes <> "\""  -- | The hashes of the transactions of a block. Responds with an error if -- not found.@@ -1529,9 +1538,9 @@ -- | Handler for @GET \/transactions\/block\/:block\/raw@: the transactions of a block, serialized, in pieces. handleTxsBlockRaw :: WebState -> GetTxsBlockRaw -> IO [Piece] handleTxsBlockRaw st (GetTxsBlockRaw h) =-  listPieces hex . transactionPieces st.query =<< getTxsBlock st h+  listPieces hex . pieced pieceSize (fmap catMaybes . st.query.getManyTxBytes) =<< getTxsBlock st h   where-    hex t = unsafeToEncoding ("\"" <> hexOf (transactionData t) <> "\"")+    hex bytes = unsafeToEncoding ("\"" <> rawHex bytes <> "\"")  -- GET TransactionAfterHeight -- @@ -3144,7 +3153,7 @@     [t] -> return $ Right t     [] -> return $ Left ThingNotFound     ts ->-      let tids = map (txHash . transactionData) ts+      let tids = map (.txid) ts        in return $ Left (TxIndexConflict tids)  -- | Handler for @GET \/blockchain\/rawtx\/:txid@: a transaction, as Blockchain.info.@@ -3164,8 +3173,12 @@       let net = st.config.store.net       let ctx = st.config.store.ctx       streamEncoding $ marshalEncoding (net, ctx) $ toBinfoTxSimple numtxid t-    hx t = do-      textResponse . encodeHexLazy . runPutL . serialize $ transactionData t+    -- the bytes as stored, of the transaction that the id names+    hx t =+      st.query.getManyTxBytes [t.txid] >>= \case+        [Just bytes] -> return (responseBuilder status200 textType (rawHex bytes))+        _ -> raise st ThingNotFound+    textType = [(hContentType, "text/plain; charset=utf-8")]  -- | Handler for @GET \/blockchain\/q\/txtotalbtcoutput\/:txid@: total value of the outputs of a transaction. handleBinfoTotalOut :: WebState -> Req -> IO Response

@@ -90,10 +90,11 @@  import Control.Exception (evaluate) import Data.Aeson.Encoding (Encoding, fromEncoding)-import Data.ByteString.Builder (Builder, lazyByteString, lazyByteStringHex, toLazyByteString)+import Data.ByteString.Builder (Builder, lazyByteString, toLazyByteString) import Data.ByteString.Lazy qualified as L import Data.Bytes.Put (runPutL) import Data.Bytes.Serial (Serial (..))+import Haskoin.Util (hexBuilder) import Data.IORef (modifyIORef', newIORef, readIORef, writeIORef) import Data.List (intersperse) import Data.Sequence (Seq (..), (|>))@@ -204,4 +205,4 @@  -- | The serialization of a value, in hexadecimal. hexOf :: (Serial a) => a -> Builder-hexOf = lazyByteStringHex . runPutL . serialize+hexOf = hexBuilder . runPutL . serialize

@@ -11,7 +11,7 @@   - url: './'  info:-  version: &version 1.14.0+  version: &version 1.15.0   title: Haskoin   contact:     name: JP Rupp

@@ -0,0 +1,65 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE OverloadedRecordDot #-}++-- | The stored values read in part, held to the full decoders on random+-- values: a block whose transactions are decoded when used, and the bytes+-- of a stored transaction, which must be those that the raw answers sent+-- when they built the transaction and serialized it again.+module Haskoin.Store.Database.SlicesSpec (spec) where++import Data.ByteString qualified as B+import Data.Bytes.Put (runPutS)+import Data.Bytes.Serial (serialize)+import Data.IntMap.Strict qualified as IntMap+import Data.Serialize (encode)+import Haskoin+import Haskoin.Store.Data+import Haskoin.Store.Database.Slices (blockData, txBytes)+import Haskoin.Util.Arbitrary+import Test.Hspec+import Test.Hspec.QuickCheck (modifyMaxSuccess)+import Test.QuickCheck++spec :: Spec+spec = do+  ctx <- runIO createContext+  modifyMaxSuccess (const 500) $ describe "stored values read in part" $ do+    it "read a block as the full decoder does" $+      forAll arbitraryBlockData $ \b -> blockData (encode b) `shouldBe` Right b+    it "refuse a block that has fewer bytes than its count of transactions" $+      forAll arbitraryBlockData $ \b ->+        let bytes = encode b+            cut = B.take (B.length bytes - 25) bytes+         in not (null b.txs) ==> either (const True) (const False) (blockData cut)+    it "find the transaction of a stored one, and whether it is deleted" $+      forAll (arbitraryTxData ctx) $ \td ->+        txBytes (encode td) `shouldBe` Right (runPutS (serialize td.tx), td.deleted)+    it "give the bytes that building and serializing the transaction gave" $+      forAll (arbitraryTxData ctx) $ \td ->+        fmap fst (txBytes (encode td))+          `shouldBe` Right (runPutS (serialize (transactionData (toTransaction btc ctx td))))++arbitraryBlockData :: Gen BlockData+arbitraryBlockData =+  BlockData+    <$> arbitrary+    <*> arbitrary+    <*> oneof [choose (0, 2 ^ (31 :: Int)), choose (2 ^ (31 :: Int), 2 ^ (100 :: Int))]+    <*> arbitraryBlockHeader+    <*> arbitrary+    <*> arbitrary+    <*> oneof [listOf arbitraryTxHash, vectorOf 300 arbitraryTxHash]+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++arbitraryTxData :: Ctx -> Gen TxData+arbitraryTxData ctx =+  TxData+    <$> oneof [MemRef <$> arbitrary, BlockRef <$> arbitrary <*> arbitrary]+    <*> oneof [arbitraryTx btc ctx, arbitraryWitnessTx btc ctx, arbitraryLegacyTx btc ctx]+    <*> (IntMap.fromList <$> listOf ((,) <$> choose (0, 1000) <*> (Prev <$> arbitraryBS <*> arbitrary)))+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> (IntMap.fromList <$> listOf ((,) <$> choose (0, 1000) <*> (Spender <$> arbitraryTxHash <*> arbitrary)))

@@ -1156,6 +1156,10 @@   rawNode <- rpc env.node "getrawtransaction" [String t1, Bool False]   raw <- plainJSON env ("/transaction/" <> cs t1 <> "/raw")   field "result" raw `shouldBe` Just rawNode+  -- the same bytes as a list of one, and as the text of Blockchain.info+  plainJSON env ("/transactions/raw?txids=" <> cs t1) `shouldReturn` toJSON [rawNode]+  rawText <- Wreq.get (env.plain <> "/blockchain/rawtx/" <> cs t1 <> "?format=hex")+  String (cs (rawText ^. Wreq.responseBody)) `shouldBe` rawNode   bal <- plainJSON env ("/address/" <> cs a <> "/balance")   num "confirmed" bal `shouldBe` 400000   num "unconfirmed" bal `shouldBe` 50000