packages feed

haskoin-store-data 1.8.1 → 1.9.0

raw patch · 11 files changed

+3521/−877 lines, 11 filesdep −mtldep −scottydep ~QuickCheckdep ~aesondep ~basesetup-changedPVP ok

version bump matches the API change (PVP)

Dependencies removed: mtl, scotty

Dependency ranges changed: QuickCheck, aeson, base, binary, bytes, bytestring, cereal, containers, data-default, deepseq, hashable, haskoin-core, hspec, http-client, http-types, lens, network, string-conversions, text, time, unordered-containers, vector, wreq

API changes (from Hackage documentation)

- Haskoin.Store.Data: instance Web.Scotty.Action.Parsable Haskoin.Store.Data.BinfoBlockId
- Haskoin.Store.Data: instance Web.Scotty.Action.Parsable Haskoin.Store.Data.BinfoDate
- Haskoin.Store.Data: instance Web.Scotty.Action.Parsable Haskoin.Store.Data.BinfoFilter
- Haskoin.Store.Data: instance Web.Scotty.Action.Parsable Haskoin.Store.Data.BinfoTxId
- Haskoin.Store.Data: instance Web.Scotty.Action.Parsable Haskoin.Store.Data.DeriveType
+ Haskoin.Store.Data: [redis] :: HealthCheck -> !Maybe Bool
+ Haskoin.Store.Data: parseBinfoBlockId :: Text -> Maybe BinfoBlockId
+ Haskoin.Store.Data: parseBinfoDate :: Text -> Maybe BinfoDate
+ Haskoin.Store.Data: parseBinfoFilter :: Text -> Maybe BinfoFilter
+ Haskoin.Store.Data: parseBinfoTxId :: Text -> Maybe BinfoTxId
- Haskoin.Store.Data: HealthCheck :: !BlockHealth -> !TimeHealth -> !TimeHealth -> !MaxHealth -> !CountHealth -> !String -> !String -> !Word64 -> HealthCheck
+ Haskoin.Store.Data: HealthCheck :: !BlockHealth -> !TimeHealth -> !TimeHealth -> !MaxHealth -> !CountHealth -> !String -> !String -> !Word64 -> !Maybe Bool -> HealthCheck
- Haskoin.Store.WebClient: apiBatch :: (Batchable a b, MonadIO m, MonadError Except m) => Ctx -> Natural -> ApiConfig -> a -> m b
+ Haskoin.Store.WebClient: apiBatch :: Batchable a b => Ctx -> Natural -> ApiConfig -> a -> IO (Either Except b)
- Haskoin.Store.WebClient: apiCall :: (ApiResource a b, MonadIO m, MonadError Except m) => Ctx -> ApiConfig -> a -> m b
+ Haskoin.Store.WebClient: apiCall :: ApiResource a b => Ctx -> ApiConfig -> a -> IO (Either Except b)
- Haskoin.Store.WebCommon: capturePath :: ApiResource a b => Proxy a -> RoutePattern
+ Haskoin.Store.WebCommon: capturePath :: ApiResource a b => Proxy a -> Text

Files

+ CHANGELOG.md view
@@ -0,0 +1,2241 @@+# Changelog+All notable changes to this project will be documented in this file.++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)++## [Unreleased]++## [1.9.0] - 2026-11-10++### Changed++- Breaking, version 1.9.0: `HealthCheck` has a field `redis`, whether the+  Redis cache of the store answers, `Nothing` for a store without one. Code+  that builds a `HealthCheck` has to give it. In JSON it is+  `"redis": {"ok": true}`, left out when there is no cache; in the binary+  encoding it is one more byte at the end. Both may be missing when read,+  so old output still decodes, and old clients read new output. It does not+  count towards `isOK`: a store without its Redis answers from its own+  database and is fit to serve.+- Breaking, version 1.9.0: `apiCall` and `apiBatch` run in plain `IO` and+  return `Either Except` the response, instead of working in any monad with+  `MonadIO` and `MonadError Except`. Where you wrote+  `runExceptT (apiCall ctx cfg req)`, write `apiCall ctx cfg req`; in an+  `ExceptT` of your own, wrap it with `ExceptT`. `apiBatch` stops at the+  first error. The package no longer depends on mtl.+- Breaking, version 1.9.0: no dependency on Scotty. `capturePath` gives the+  route pattern as `Text`, such as `/block/:block`, instead of a Scotty+  `RoutePattern`. The `Parsable` instances of `DeriveType`, `BinfoBlockId`,+  `BinfoTxId`, `BinfoFilter` and `BinfoDate` are replaced by the functions+  `textToDeriveType`, `parseBinfoBlockId`, `parseBinfoTxId`,+  `parseBinfoFilter` and `parseBinfoDate`, which give `Maybe` the value.+- Version 1.9.0: legacy addresses are called `legacy` in the `derive`+  parameter, and `deriveTypeToText DeriveNormal` is `"legacy"`.+  `textToDeriveType` still reads `normal`, the old name, so old URLs keep+  working. Clients never send the default, legacy, so requests stay+  readable by older servers.+- haskoin-store-data has its own repository,+  [jprupp/haskoin-store-data](https://github.com/jprupp/haskoin-store-data),+  and its own releases. Up to 1.8.1 it was released from the haskoin-store+  repository together with haskoin-store, with the same version number; the+  entries below that version describe both packages.+- GHC2024 edition, with `DuplicateRecordFields`, `NoFieldSelectors`,+  `OverloadedRecordDot` and `OverloadedStrings` on for every module, and+  explicit deriving strategies. The API is unchanged.+- `Haskoin.Store.WebCommon` has an explicit export list, with the same+  exports as before.+- The package has a full description, PVP upper bounds on every dependency,+  and no `Setup.hs`. It builds with the same warnings as haskoin-store.++### Added++- Tests checked by law for every type: binary encodings round-trip and agree+  between Serial, cereal and binary; JSON round-trips and the fast encoders+  write the same JSON as `toJSON`; the wire format of the basic types is+  pinned. Types whose encoding depends on the network get a random network+  for each case, so every network is covered without running each law once+  per network. The suite runs in about 4 seconds instead of nearly four+  minutes.++## [1.8.1] - 2026-11-07++### Changed++- Documentation: the README explains the purpose and design of the store, with+  installation steps, a full configuration reference, monitoring and a+  tutorial, and the Haddock of every module and function says why it works the+  way it does.+- Build against nqe 0.6.9, rocksdb-haskell-jprupp 2.6.1, rocksdb-query 0.6.1,+  statsd-rupp 0.5.0.2, secp256k1-haskell 2.0.1, haskoin-node 2.3.1 and+  Stackage nightly-2026-11-07.++## [1.8.0] - 2026-11-07++### Changed++- Index the mempool by the time each transaction entered it. `/mempool`,+  `/blockchain/unconfirmed-transactions` and the health check read only the+  page they return, newest first, instead of loading and sorting the whole+  mempool on every request. Data version 20: a version 18 or 19 database is+  migrated when it is opened, with no resync.+- The block store no longer reads the whole mempool to publish mempool+  events, to set the mempool gauge or to find expired transactions. Each+  import reports which transactions it added to the mempool or removed from+  it; pruning reads only the oldest entries of the index. Before, every+  block, every batch of new transactions and every clock tick (several per+  second) read the whole mempool at least once.+- Count the transactions of an xpub without building the list of all of them+  when the cache is not used.+- Keep the derived addresses of the 512 to 1024 most recently queried xpubs+  in memory. Every xpub query derived each address again before reading a+  balance. Addresses depend only on the xpub, so the cache never goes stale.+- Page the unspent outputs of an xpub by merging its addresses in order of+  block, stopping once the page is full, instead of decoding up to offset+  plus limit outputs of every address and sorting them all. The pages are+  the same.+- Count the transactions of an xpub by merging the raw keys of its+  addresses, without decoding keys or reading values.+- Open the iterators of a query over many addresses in one bracket instead+  of one bracket each. Every call into RocksDB walked the stack past one+  frame per address.+- Double the page, up to 1024 rows, when streaming a source by offset, as+  `/blockchain/unspent` does. The rows read and skipped grew with the square+  of the rows returned.+- Check that an xpub is cached in the same Redis round trip as the read of+  its balances, transaction count, or a page of its transactions or unspent+  outputs that does not start at a transaction.+- Serialize a transaction at most twice to compute its id, size and weight,+  and stop looking up its witnesses with a quadratic list index.+- Build on haskoin-core 1.6.1, which encodes CashAddr and Base58 addresses+  faster: about 10% less CPU per request on endpoints that return many+  addresses.+- The executable uses every core of the host by default (`-N` instead of+  `-N4`). Set `+RTS -N<n> -RTS` on the command line to choose a number.+- Read the balances of many addresses, and lists of transactions, with one+  RocksDB multi-get instead of one read per key. `StoreReadBase` has a new+  method, `getManyTxData`, which defaults to reading the transactions one by+  one; `getTransactions` reads many transactions with it.+- Give RocksDB a block cache of 1 GiB by default, shared by all column+  families, and keep their index and filter blocks in it at high priority,+  with those of level 0 pinned. Before, each column family had RocksDB's+  default cache of 32 MiB, and index and filter blocks stayed in memory+  outside any cache for every open file. Set the size with `--block-cache-mb`+  or `BLOCK_CACHE_MB`; 0 restores the RocksDB defaults. `StoreConfig` and+  `withDatabaseReader` take the size in bytes. Requires rocksdb-haskell-jprupp+  2.6.0.++### Added++- `store/bench`: a benchmark server that syncs a synthetic regtest chain and+  serves the web API on it, and times the encoding of a response with the+  argument `micro`. `scripts/bench-web.sh` runs wrk against it and reports+  the CPU time of the server per request.++## [1.7.0] - 2026-11-06++### Changed++- Build on haskoin-core 1.6.0 and haskoin-node 2.3.0, the releases with the+  fixes of the November 2026 security review. Their changelogs list the+  changes to message parsing, header validation and peer handling that the+  store now runs with.+- An output has an address only when the network defines one for its script,+  as in haskoin-core 1.6.0. A SegWit-shaped output has no address on Bitcoin+  Cash. A 256-bit script hash output (`OP_HASH256`, a push of 32 bytes,+  `OP_EQUAL`) has none on Bitcoin. Such an output is no longer indexed under+  an address, and its `address` is `null`. Entries that an older version+  wrote under such an address stay in the database. No request can name them,+  since the address has no text form on the network.+- `POST /transactions` takes a body that holds one transaction and nothing+  else. Bytes after the transaction are refused, as Bitcoin Core does for a+  raw transaction. They used to be ignored.+- `POST /transactions` takes the transaction in the format that peers of the+  network read. A network without SegWit, such as Bitcoin Cash, has the+  format without witness only.+- `GET /peers` gives the `version` of a peer as a signed number, as+  haskoin-core 1.6.0 reads it. A peer that sends version ffffffff has version+  -1, where it used to appear as 4294967295.+- Breaking, in `haskoin-store-data`: `toTransaction` takes the `Network` as+  its first argument, and the `version` field of `PeerInfo` is an `Int32`.+  The binary form of `PeerInfo` is the same bytes as before.+- From haskoin-node 2.3.0: a peer is disconnected when it sends more than+  50000 entries in an `inv` or `getdata` message. On Bitcoin Cash a message+  may be at most 2 MiB, unless it carries block content. Transactions from+  Bitcoin Cash peers are read in the format without witness only.++### Fixed++- A response no longer fails on a transaction with an output that has no+  address on the network. Since haskoin-core 1.5.0 the JSON encoder of such+  an address threw, which cut the response off. One such output is in Bitcoin+  block 211997 (transaction+  `a4bfa8ab6435ae5f25dae9d89e4eb67dfa94283ca751f393c1ddc5a837bbc31b`,+  output 0).++## [1.6.5] - 2026-11-04++### Fixed++- Build on haskoin-core 1.5.1, which evaluates the ASERT difficulty rule at the+  parent block. With 1.5.0 the store rejected a valid block on Bitcoin Cash+  mainnet at height 975899.++## [1.6.4] - 2026-11-04++### Added++- Support Bitcoin testnet4 (`NET=btctest4`), from haskoin-core 1.4.0.+- Option `--block-window` (`BLOCK_WINDOW`) to set how many blocks to request+  from the syncing peer at a time.+- Option `--write-buffer-mb` (`WRITE_BUFFER_MB`) to cap RocksDB memtables+  across all column families, 256 MiB by default (0 = unlimited). Without a+  cap the nine column families can keep up to 1.1 GiB of memtables.+- Option `--max-wal-mb` (`MAX_WAL_MB`), 1024 MiB by default (0 = RocksDB+  default), to bound the RocksDB write-ahead log: once it is larger, the+  column families holding its oldest file are flushed so the file can be+  deleted.+- `/dbstats` starts with the memory RocksDB uses outside the GHC heap:+  memtables and table readers for each column family, and the block cache.+- The mempool is kept in its own column family, one key per transaction,+  instead of as a single list value that every import batch read, loaded+  into a hash table and wrote back whole. Data version 19: a version 18+  database is migrated when it is opened, with no resync.++### Changed++- Replace monad-logger with the fast-logger `Logger` from haskoin-node 2.0.0.+- Request 64 blocks at a time from the syncing peer instead of 500, and ask+  for more once fewer than 16 remain, to bound memory use while catching up.+- haskoin-store-data builds against secp256k1-haskell 2.0.0, which hides the+  raw `PubKey` constructor: `XPubSpec` reads its stored key with `pubKey`,+  which checks it.+- Build on haskoin-core 1.5.0, haskoin-node 2.1.2 and secp256k1-haskell 2.0.0.+  `genesisBlock` no longer takes a context.+- A pay-to-public-key output has no address any more, as in haskoin-core+  1.5.0. Its coins cannot be spent with the input script of the P2PKH address+  of the same key, so they are no longer counted under that address.+- The block store no longer reads the whole mempool four extra times on every+  internal ping: it compares mempool snapshots only when there are pending+  transactions to import or expired ones to delete.+- Run with four capabilities (`-N4`) instead of one per core (`-N`), so that+  memory overhead does not grow with the size of the host. Override with+  `+RTS -N<n> -RTS`.+- Docker image: pin the base image to Debian trixie (RocksDB 9.10) by digest+  instead of `debian:latest`, and run with `MALLOC_ARENA_MAX=2` to limit+  malloc fragmentation from RocksDB.+- Each `/events` client, websocket or HTTP stream, gets a queue of at most+  10,000 events and is disconnected when it fills up, instead of the queue+  growing for as long as the client stays connected. Store events that+  `/events` does not show are no longer queued for its clients.+- A request waiting for another to load an xpub into the cache retries for+  about 30 seconds, with at most 5 seconds between attempts, and then serves+  the xpub from the database. It used to retry forever with a delay that+  doubled each time.++- Continuous integration on GitHub Actions: build, run both test suites,+  and check that the heap stays flat while syncing 6000 regtest blocks.++### Fixed++- Support full-RBF: accept replacements of transactions that do not signal BIP125.+- Correct various space leaks.+- `Unspent` implements `coinInputKind`, new in haskoin-core 1.5.0, from its+  output script, so coin selection with it no longer fails at run time.++### Added++- Support for testnet4 on both networks.++## [1.6.3] - 2026-08-31++### Added++- Allow disabling web server to sync block chain only.++## [1.6.2] - 2026-08-13++### Fixed++- Fix upstream regressions in haskoin-node.++## [1.6.1] - 2026-08-13++### Fixed++- Support latest version of haskoin-node.++## [1.6.0] - 2026-08-12++### Fixed++- Support for Bitcoin Cash 256-bit scripts.+- Address parsing now allows only correct lengths.++## [1.5.16] - 2025-05-08++### Changed++- Move to personal repository.++### Removed++- Disable `NO_SLOW` as an option.++### Added++- Allow to set `NO_XPUB` to disable extended public keys.++## [1.5.14] - 2024-12-04++### Changed++- Move `/dbstats` and `/mempool` to slow endpoints section.++### Added++- Cull old transactions from mempool automatically.++## [1.5.13] - 2024-10-25++### Changed++- Dummy release: update upstream LTS Haskell dependency in `stack.yaml` file.++## [1.5.12] - 2024-07-22++### Added++- Metric to track time to import a new block.+- Parameter `no_compact` allowed for backwards compatiblity.++## [1.5.11] - 2024-05-24++### Fixed++- Parameter `noCompact` corrected for `multiaddr` endpoint.++## [1.5.10] - 2024-05-24++### Fixed++- Prune obsolete transactions from outgoing peer requests.+- Remove unnecessary module imports.++## [1.5.9] - 2024-05-23++### Fixed++- Only sync mempool once for each peer.++## [1.5.8] - 2024-05-23++### Fixed++- Dummy release to bump upstream dependency on `haskoin-node`.++## [1.5.7] - 2024-05-23++### Fixed++- Dummy release to bump upstream dependency on `statsd-rupp`.++## [1.5.6] - 2024-05-22++### Changed++- Allow to toggle RocksDB Bloom filters off.++### Fixed++- Correct command-line option behaviour for some rarely-used parametres.++## [1.5.5] - 2024-05-19++### Changed++- Lock Redis before checking if the database needs to be pruned, rather than after.+- Lock xpub in Redis to avoid computing derivations multiple times.++### Fixed++- Rename redis-min-gap to redis-min-addrs to match environment config variable.++## [1.5.4] - 2024-05-07++### Fixed++- Fix Redis bug where old keys weren't pruned quickly enough.++### Changed++- Remove Nomad-specific environment variable parsing for statsd.++## [1.5.2] - 2024-04-24++### Changed++- Use default GHC garbage collector.++## [1.5.1] - 2024-04-23++### Changed++- Compile with GHC 9.8.2.+- Enable optimisations.++## [1.5.0] - 2024-04-06++### Fixed++- Use an optimised topological sort for importing transactions in bulk.++## [1.4.0] - 2024-03-27++### Changed++- Use default optimisation settings.+- Use default RocksDB parameters.++## [1.3.0] - 2024-03-14++### Changed++- Bump upstream dependencies.++## [1.2.5] - 2023-01-31++### Fixed++- Test suite now working again.++## [1.2.4] - 2023-01-31++### Changed++- Bump upstream dependencies.++## [1.2.3] - 2023-12-06++### Changed++- Transactions received via POST are just forwarded to every peer without delay or validation.+- Bump dependency on NQE to resolve async issue.++## [1.2.2] - 2023-10-21++### Fixed++- Fix comparison function for unspent outputs.++### Changed++- Avoid deprecated `param` function from Scotty.++## [1.2.1] - 2023-10-04++### Fixed++- Correct web exception output format (JSON).+- Correct block path parsing order.++## [1.2.0] - 2023-10-03++### Changed++- Upgrade `scotty` dependency and fix incompatibilities.++## [1.1.0] - 2023-09-15++### Added++- Add cache height stats.+- Add database iterator stats.++### Changed++- Detect xpub gap more strictly.+- Use statsd-rupp instead of ekg-stats.+- All stat reporting keys changed.++### Removed++- Remove unsafeInterleaveIO from Web.hs.+- Remove unnecessary WAI middlewares.+- Remove server and client error reporting per endpoint.++## [1.0.2] - 2023-08-25++### Changed++- Code refactoring and simplification.+- Improve logging output.++### Removed++- Do not impose time limits on REST API responses.++### Fixed++- Remove loop in Blockchain.info unspents function.+- Correct documentation for /blockchain/rawblock endpoint.+- Fix no match in record selector address for coinbases.++## [1.0.1] - 2023-08-03++### Changed++- Add compatibility with latest nightly LTS Haskell.++## [1.0.0] - 2023-07-28++### Changed++- Compatibility with latest haskoin-core and haskoin-node packages.+- Use DuplicateRecordFields and OverloadedRecordDot language extensions.+- Modernize package in a backwards-incompatible manner.+- Refactor package extensively.++## [0.65.10] - 2023-05-12++### Changed++- Revert to older LTS Haskell to attempt to resolve memory leak.++### Removed++- Remove unnecessary lock release.++## [0.65.9] - 2023-05-09++### Changed++- Be more aggressive caching individual transactions.+- Introduce a periodic cache mempool sync task.++## [0.65.8] - 2023-05-08++### Changed++- Perform health check in separate thread.++## [0.65.7] - 2023-05-05++### Changed++- Do not sync mempool to Redis if node is not up-to-date.++## [0.65.6] - 2023-05-04++### Changed++- Improve caching ingestion performance.++## [0.65.5] - 2022-09-19++### Added++- Fee field added to Blockchain.info-style export-history endpoint.++### Changed++- Bump version due to Git mistake.++## [0.65.3] - 2022-04-13++### Added++- IPv6 peer support.++## [0.65.2] - 2022-04-13++### Fixed++- Correct lazy bytestring deserialization algorithm for web client.++## [0.65.1] - 2022-04-13++### Changed++- Simplify function in Cache module.+- Bump depenedencies.++## [0.65.0] - 2022-02-03++### Changed++- Spenders now embedded into tx objects in database for performance.+- Use faster IORef instead of slow TVar when ingesting.+- Use mutable hash tables when ingesting.+- Allow to disable unscalable API endpoints.++## [0.64.19] - 2022-02-01++### Added++- Allow to set query timeouts.++## [0.64.18] - 2022-01-21++### Fixed++- Off-by-one error when importing change addresses to cache.++## [0.64.17] - 2022-01-21++### Fixed++- Add change addresses to cache when necessary.++## [0.64.16] - 2022-01-10++### Fixed++- Correct fee calculation for blocks that do not claim all rewards.++## [0.64.15] - 2022-01-07++### Fixed++- Correct scale of cache pruning code.++## [0.64.14] - 2022-01-07++### Fixed++- Always prune to 80% of max cache size.++## [0.64.13] - 2022-01-07++### Fixed++- Avoid doing a hissy fit on transient cache issue.++## [0.64.12] - 2022-01-07++### Fixed++- Prune a little more cache to allow for new keys.++## [0.64.11] - 2022-01-06++### Fixed++- Prune cache more often.++## [0.64.10] - 2021-12-30++### Changed++- Return empty addresses in xpub balances call.++## [0.64.9] - 2021-12-29++### Fixed++- Avoid notifying same transactions in mempool.++## [0.64.8] - 2021-12-26++### Changed++- Use better Fourmolu format.+- Be more precise when counting retrieved items.++### Fixed++- Avoid transactions duplicated in xpub data.+- Refactor some functions to make them more robust.++## [0.64.7] - 2021-12-26++### Fixed++- Optimisations for various Blockchain endpoints.+- More accurate item counts for various web endpoints.++## [0.64.6] - 2021-12-25++### Fixed++- Record cache index time just once per xpub.++## [0.64.5] - 2021-12-25++### Changed++- Add suffix cached to cache entries to avoid conflicts with data entries.++## [0.64.4] - 2021-12-25++### Fixed+- Bring dots back and avoid stats hacks.++## [0.64.3] - 2021-12-25++### Fixed++- Fix typo.++## [0.64.2] - 2021-12-25++### Changed++- Replace dots for underscores in metrics.++## [0.64.1] - 2021-12-25++### Changed++- Automatic formatting.+- Improve cache debug logging.++### Fixed++- Add item count to 'all' query metrics.++## [0.64.0] - 2021-12-25++### Changed++- Improve metrics.++### Fixed++- Get lock before importing transactions to cache.++## 0.63.0+### Fixed+- Make cache updates lightweight.++## 0.62.1+### Fixed+- Fix idempotent transaction elimination bug.++## 0.62.0+### Added+- Configurable Blockchain price URLs.+- Reuse HTTP connections with wreq sessions.++## 0.61.1+### Changed+- Upstream improvements on Base58 performance.++## 0.61.0+### Fixed+- Fixed recursion bug in Blockchain format conversion function.++## 0.60.0+### Fixed+- Correct notifications subsystem.++## 0.59.0+### Fixed+- Correct internal dependency.++## 0.58.0+### Fixed+- Correct output freeing algorithm.++## 0.57.0+### Changed+- Report errors freeing outputs.++## 0.56.0+### Changed+- Report all deleted mempool transactions.+- Crash on certain data corruption.++## 0.55.0+### Changed+- Always have a previous output object in Blockchain inputs.++## 0.54.0+### Added+- WebSocket support.+- Testnet4 support.++## 0.53.11+### Changed+- Dummy version increase to signal upstream update of Haskoin Core.++## 0.53.10+### Fixed+- Correct test that was reversed in previous version.++## 0.53.9+### Removed+- Mempool is no longer synced by default to fix public Bitcoin Core regression.++## 0.53.8+### Changed+- Put derivations stat inside database.++## 0.53.7+### Added+- Added counters for database retrievals.+- Added counter for xpub derivations.++### Changed+- Removed some buggy or unnecessary stats.++## 0.53.6+### Changed+- Improve web server statistics.++## 0.53.5+### Addded+- Endpoint to delete an xpub from cache.++## 0.53.4+### Added+- Debugging when reverting block.++### Fixed+- Negative (headers - blocks) diff shown incorrectly.+- Infinite loop when removing a block's coinbase transaction.++## 0.53.3+### Added+- Blockchain.info endpoint: `q/pubkeyhash/:addr`.+- Blockchain.info endpoint: `q/getsentbyaddress/:addr`.+- Blockchain.info endpoint: `q/pubkeyaddr/:addr`.+- Configurable request body limit size.++## 0.53.2+### Fixed+- Return output in satoshi for some endpoints.++## 0.53.1+### Fixed+- Return 404 in case of bad address.++## 0.53.0+### Added+- Blockchain.info endpoint: `q/addresstohash/:addr`.+- Blockchain.info endpoint: `q/addrpubkey/:pubkey`.+- Blockchain.info endpoint: `q/hashpubkey/:pubkey`.+- Blockchain.info endpoint: `q/getblockcount`.+- Blockchain.info endpoint: `q/latesthash`.+- Blockchain.info endpoint: `q/bcperblock`.+- Blockchain.info endpoint: `q/txtotalbtcoutput/:txid`.+- Blockchain.info endpoint: `q/txtotalbtcinput/:txid`.+- Blockchain.info endpoint: `q/txfee/:txid`.+- Blockchain.info endpoint: `q/txresult/:txhash/:addr`.+- Blockchain.info endpoint: `q/getreceivedbyaddress/:addr`.+- Blockchain.info endpoint: `q/addressbalance/:addr`.+- Blockchain.info endpoint: `q/addressfirstseen/:addr`.+- Support xpubs in `blockchain/rawaddr` endpoint.++### Fixed+- Various latest blocks endpoint fixes.+- Allow empty parameters in Blockchain.info POST requests.++## 0.52.13+### Fixed+- Upstream fixes for unknown inv types.++## 0.52.12+### Fixed+- Fix limits for legacy endpoints.++## 0.52.11+### Added+- Alias for Blockchain.info raw address endpoint.++### Fixed+- Fix unknown message types without payload upstream.+- Randomise peer timeouts upstream.++## 0.52.10+### Fixed+- Fix binary search algorithm for blocks upstream.++## 0.52.9+### Added+- Add Blockchain.info latest block endpoint.+- Add Blockchain.info unconfirmed-transactions endpoint.+- Add Blockchain.info blocks for one day endpoint.++## 0.52.8+### Fixed+- Fix special case for zero limit.++## 0.52.7+### Fixed+- Fix cache bug when too many transactions in mempool.++## 0.52.6+### Changed+- Use rationals for Blockchain.info export-history endpoint arithmetics.++## 0.52.5+### Added+- Support for Blockchain.info export-history endpoint.++### Fixed+- Use strict bytestring decoder for HTTP API client.++## 0.52.4+### Fixed+- Use Base58 addresses by default in Blockchain.info balance querios.++## 0.52.3+### Fixed+- Errors should also contain CORS headers.++## 0.52.2+### Fixed+- Blockchain.info raw address limit should use `limit` parametre and not `n`.++## 0.52.1+### Changed+- Stream multiple transactions when requested.++### Fixed+- Fix missing unspent outputs.++## 0.52.0+### Changed+- Remove unnecessary performance optimisations.++### Fixed+- Reduce balance retrievals for xpubs.+- Hack UTXO ordering to avoid unwanted behaviours.+- Do not merge conduits when there are too many.++## 0.51.0+### Fixed+- Data type for RequestTooLarge was missing.++## 0.50.3+### Added+- Log HTTP request bodies.++### Removed+- Remove web request timeout.++### Fixed+- Do not ignore unknown start tx anchors in conduits.+- Use fast transaction counting in cache.++### Changed+- Use WAI middlewares to manage stats.++## 0.50.2+### Fixed+- Do not use lazy parsers for incoming data that may throw exceptions.++## 0.50.1+### Fixed+- Do not allow incoming POST requests of unlimited body size.++## 0.50.0+### Added+- Limit number of simultaneous xpubs being cached.++## 0.49.0+### Changed+- Improve conduit merging algorithm.++## 0.48.0+### Added+- Timeouts and token bucket for web requests.+- Configurable price fetch interval.++## 0.47.6+### Fixed+- Fix web.all stat.++## 0.47.5+### Changed+- Simplify stats.++## 0.47.4+### Added+- Implement Blockchain.info block height.+- Implement Blockchain.info raw address.+- Implement Blockchain.info balances.++### Fixed+- Make Blockchain.info unspent endpoint more efficient.+- Make Blockchain.info xpubs endpoint more efficient.++### Changed+- Use compact JSON serialization by default everywhere.++## 0.47.3+### Fixed+- Fix serialization bug with unspents.++## 0.47.2+### Fixed+- Fix serialization bug for health check.++## 0.47.1+### Fixed+- Fix serialization bugs for web data types.++## 0.47.0+### Added+- Support for legacy block endpoints.++### Changed+- Serialization now uses bytes library and does interleaved IO.++## 0.46.6+### Added+- Allow comma-separated values in multiaddr.++## 0.46.5+### Changed+- Throw error when offset exceeded instead of truncating it.++## 0.46.4+### Fixed+- Do not compute balances separately for loose addresses when part of an xpub.++### Changed+- Do not fetch entire transaction list for loose addresses.+- Transaction count in wallet object is just a synonym for filtered tx count.+- Use conduits to prevent over-fetching transactions from database.++## 0.46.3+### Fixed+- Make hex value encoding compatible with Java BigInteger decoder.++## 0.46.2+### Changed+- Allow negative confirmations for compatibility with old API.++## 0.46.1+### Added+- Filters for transactions in multiaddr endpoint.++## 0.46.0+### Fixed+- Release to fix unintentional upload.++## 0.45.0+### Added+- Using a tx_index that results in a txid conflict returns a 409 - Conflict.++## 0.44.0+### Changed+- Numeric txid now 53 bits long and doesn't return transactions when hashes collide.++## 0.43.1+### Fixed+- Do not overcount statistics.++## 0.43.0+### Changed+- Transaction index now simply encodes txid as a long number (sorry JS users).++## 0.42.4+### Changed+- Optimise encoding of JSON data for Blockchain.info API.++## 0.42.3+### Changed+- Narrow down the balance for transactions to onlyShow set.++## 0.42.2+### Changed+- Make unspent algorithm more efficient.++## 0.42.1+### Added+- Support for Blockchain.info API unspent endpoint.++### Fixed+- Fix RBF transactions on Blockchain.info API.++## 0.42.0+### Removed+- No more pruning of old mempool transactions.++## 0.41.4+### Fixed+- Correct error computing wallet balances.++## 0.41.3+### Changed+- Use whole active set when computing results for multiaddr.+- Compute correct count of transactions for wallet.++## 0.41.2+### Changed+- Caching mempool is not much slower when pruning, so reversing that change.++## 0.41.1+### Changed+- Only prune mempool every ten minutes or so.++## 0.41.0+### Removed+- No more cache eviction endpoint.++## 0.40.22+### Added+- More metrics for cache.++## 0.40.21+### Added+- Support HTTP GET for multiaddr endpoint.++## 0.40.20+### Added+- Prefix 'app.' in statsd when using Nomad variables.++## 0.40.19+### Added+- Statsd support and pleny of statistics.++### Removed+- Removed use of sync lock for importing xpubs in cache due to volume.++## 0.40.18+### Added+- New options to control cache lock retry count and delay.++### Changed+- Cache xpubs asyncrhonously.+- Mempool syncs fully every refresh cycle.++## 0.40.17+### Changed+- Delete more than 1000 xpubs from Redis if needed.+- Attempt to get lock ten times in order to index a new xpub.++## 0.40.16+### Fixed+- Fix best block not set.++## 0.40.15+### Fixed+- Do not update cache best block if it is higher.++## 0.40.14+### Fixed+- Always respond to cache pings to avoid getting stuck.++## 0.40.13+### Added+- Be more careful about importing blocks to the cache.++### Removed+- Reduce excessive cache logging.++## 0.40.12+### Fixed+- Correct bad arithmetics in cache cooldown.++## 0.40.11+### Added+- Debug log cache cooldown.++### Fixed+- Unlimited retry lock acquisition now works.+- Make locking tighter++## 0.40.10+### Changed+- Reduce the number of things that cache do when pinged.++## 0.40.9+### Fixed+- Avoid filling the cache actor mailbox with pings.++## 0.40.8+### Fixed+- Correct a typo in cache code.++## 0.40.7+### Changed+- Improve cache mempool sync algorithm.++## 0.40.6+### Changed+- Make cache cooldown a number.++## 0.40.5+### Added+- Log every non-successful query.++## 0.40.4+### Fixed+- Use Redis TTL for cache cooldown.++## 0.40.3+### Fixed+- Mempool no longer gets saved in cache when node is not in sync.++## 0.40.2+### Changed+- Change source of price data to https://blockchain.info/ticker.++## 0.40.1+### Removed+- Do not expose Paths_haskoin_store module explicitly.++## 0.40.0+### Added+- Blockchain.info API compatibility for multiaddr and rawtx endpoints.++### Changed+- Segwit fields are no longer omitted on incompatible networks.++## 0.39.0+### Changed+- Upgrade Haskoin Core to support higher version on witness addresses.++## 0.38.4+### Fixed+- Fix block search by timestamp.++## 0.38.3+### Changed+- Disable low latency garbage collector by default.++## 0.38.2+### Changed+- Use GHC 8.10 and its low latency garbage collector.++## 0.38.1+### Changed+- Optimise algorithm for fork safety check.++## 0.38.0+### Added+- Support for Bitcoin Cash hard fork.++## 0.37.5+### Added+- Configurable cache refresh time.++## 0.37.4+### Fixed+- Now request mempool when connecting even if already in sync.++### Changed+- Add a delay to mempool sync to allow for block headers to catch up.+- Attempt to sync mempool whenever syncing is done or a new peer connects.++## 0.37.3+### Changed+- Correct logic error when deleting superseded transactions.++## 0.37.2+### Changed+- Simplify multiple algorithms to hopefully solve corruption bug.+- Allow to disable mempool transaction indexing via command line.++## 0.37.1+### Changed+- Better locking around caching operations.+- Have a global cooldown on cache mempool updates.++### Fixed+- Fix address unspent retrieval using correct column family.++## 0.37.0+### Added+- Add support for column families and prefixes breaking database backwards compatibility.++## 0.36.2+### Fixed+- Fix another place where mempool sorting was wrong.++## 0.36.1+### Fixed+- Fix wrong sorting of mempool transactions in database.++## 0.36.0+### Changed+- Do not use STM transactions because it is impossible to reason about preloading.+- Make importing blocks after mempool is populated faster.++## 0.35.2+### Changed+- Reduce frequency of cache mempool updates.++## 0.35.1+### Changed+- Remove cache lock retries.+- Do not use lock when caching a new xpub.++## 0.35.0+### Changed+- Use new RocksDB Haskell bindings.+- Make headers - blocks diff configurable in health check.+- Simplify locking in cache.++## 0.34.8+### Changed+- Minor refactoring.+- Only send one mempool message ever.++## 0.34.7+### Changed+- Fix block heights endpoint URL.++## 0.34.6+### Removed+- Remove asynchronous database retrieval permanently due to instability.++## 0.34.5+### Added+- Preload memory before freeing outputs.++## 0.34.4+### Added+- Asynchronous preloading only for blocks.++## 0.34.3+### Removed+- Disable asynchronous preloading to prevent segmentation fault error.++## 0.34.2+### Removed+- No more upper limit for mempool call.++### Fixed+- Health check uses minimum between last block and mempool tx.++## 0.34.1+### Added+- Pending mempool transactions health check.++### Removed+- No more upper limit for mempool call.++## 0.34.0+### Changed+- New format for health check.++## 0.33.1+### Changed+- Upload with updated Cabal files.++## 0.33.0+### Fixed+- Fix outputs showing up as both spent and unspent.++### Changed+- Simplify data structures used to hold uncommitted changes.+- Split StoreRead class in two.+- Improve pre-loading algorithms.++## 0.32.3+### Fixed+- Fix command line argument mappings to env vars.++## 0.32.2+### Fixed+- Do not complain when deleting non-existent unconfirmed txs.++## 0.32.1+### Fixed+- Fix corruption bug when deleting transactions during some reorgs.+- Fix tests on data package.+- Rename upstream address string functions.++## 0.32.0+### Changed+- Concurrently load dependencies when importing transaction data.+- Import each transaction using STM.+- Rework logging.+- Refactor all block chain importing algorithms.+- Use peer locking when importing data.+- Change license to MIT.++### Added+- Make max peer count configurable.++### Fixed+- Prevent premature peer timeouts when importing blocks.++## 0.31.0+### Added+- Add Haskell web client code to data library.+- Use type-safe definitions for web paths and parameters.+- Support JSON pretty encoding and enable by default for some endpoints.+- Allow environment variables for configuration.++### Changed+- Change command-line arguments to better fit GNU style.+- Refactor code to manipulate address balances.+- Improve logging.+- Rate-limit mempool importing.+- Do not add xpubs to cache if node not in sync.+- Do not import transactions to cache if no xpubs in cache.+- Refactor transaction importing logic extremely.+- Refactor memory database and writer.++### Fixed+- Fix BTC double-count transaction bug.+- Add missing xpub derive parameter to xpub evict documentation.++## 0.30.1+### Changed+- Limit mempool API endpoint list.++## 0.30.0+### Changed+- Raw JSON values are now wrapped in an object with a result property.+- Better logging when importing transactions into mempool.++### Fixed+- Transaction limit by block height works now.++## 0.29.3+### Changed+- Revert concurrent retrieval changes from 0.29.1 and 0.29.0 to solve stability+  issues.+- Bitcoin Cash (BCH) replaces BTC as default network in CLI.+- Peer discovery enabled automatically if no peers specified in CLI.+- Use separate Stack configuration file for data package.++## 0.29.2+### Changed+- Increase timeouts for manager and chain health checks.++## 0.29.1+### Added+- Perform xpub operations concurrently.++## 0.29.0+### Changed+- BlockTx renamed to TxRef.+- Remove unnecessary monad transformers to simplify import code.++### Added+- Retrieve balances and unspent outputs concurrently when importing.+- Coin instance for Unspent in data package.++## 0.28.0+### Changed+- Change the way that limits, start, and offset values are handled.++### Fixed+- Fix incorrect limit responses.++## 0.27.0+### Added+- Complete support for offset.++### Changed+- Improve monad stack for cache.++## 0.26.6+### Added+- Support for offset in all endpoints where it makes sense.++## 0.26.5+### Fixed+- Sort after using the nub function or use Data.List.nub in exceptional cases.++## 0.26.4+### Changed+- Don't do certain validity checks on confirmed transactions.++### Fixed+- Do not crash when syncing the blockchain from scratch on a populated cache.++## 0.26.3+### Changed+- Replace nub function everywhere with faster version written using hash sets.++### Fixed+- Fix shared cache locking.++## 0.26.2+### Changed+- Simplify cache block import code.+- Improve cache import performance.++## 0.26.1+### Fixed+- Do not call zadd or zrem in Redis with incorrect argument count.++### Changed+- Do not use slow Transaction type in Logic.+- Improve logging while importing blocks.+- Better transaction import algorithm.++## 0.26.0+### Changed+- Add information to some binary types for feature parity with JSON.++## 0.25.4+### Changed+- Hide segwit data on non-segwit networks.++### Fixed+- Fix work which now always serialises as a number literal.++## 0.25.3+### Changed+- Fix version display on health check.++## 0.25.2+### Changed+- Fix wrong version of Haskoin Store Data dependency.++## 0.25.1+### Changed+- Improve code organisation.+- Split data definitions and serialisation into its own package.++## 0.24.0+### Changed+- Use mocking to simulate peers instead of connecting to the network while testing.+- Depend on latest version of Haskoin Core for faster JSON serialisation.+- Clean up confusing JSON encoding/decoding codebase.++## 0.23.24+### Changed+- Implement faster JSON encoding using toEncoding from the Aeson library.++## 0.23.23+### Changed+- Do not read full mempool so often from cache code.++## 0.23.22+### Changed+- Depend on latest Haskoin Node that fixes debugging regression.++## 0.23.21+### Changed+- Reduce non-debug log verbosity.++## 0.23.20+### Changed+- Better Haskoin Node logging.++## 0.23.19+### Changed+- Use set peer timeout instead of constant in block store. ++## 0.23.18+### Changed+- Allow setting peer timeouts in command line.++### Fixed+- Bump Haskoin Node dependency to fix another premature timeout condition.++## 0.23.17+### Fixed+- Touch syncing peer whenever we process one of its blocks to avoid premature timeout.++## 0.23.16+### Changed+- Better algorithm to avoid importing transaction multiple times in cache.+- Depend on latest Haskoin Node.++## 0.23.15+### Changed+- Do not storm the cache with mempool transactions.++## 0.23.13+### Fixed+- Do not ignore deleted incoming transactions.++## 0.23.12+### Fixed+- Do not do RBF checks when replacing a mempool transaction with a confirmed one.++## 0.23.11+### Fixed+- Streamline mempool transaction importing.++## 0.23.10+### Fixed+- Fix transactions not recorded in cache mempool set.+- Fix transactions being downloaded multiple times.++### Removed+- Do not store orphan transactions in database.++### Changed+- Use sets for incoming transactions instead of lists.+- Do not do anything to the cache if there are no xpubs in it.++## 0.23.9+### Fixed+- Wiping mempool fixed.++## 0.23.8+### Added+- Chunk transactions to be deleted from mempool.++## 0.23.7+### Added+- Mempool improvements.++## 0.23.6+### Added+- Ability to wipe mempool at start.+- Improvements to mempool processing code.++## 0.23.5+### Changed+- Tighten the locking loop to avoid slow cache building.++## 0.23.5+### Fixed+- Wrong error in cache when acquiring lock.++## 0.23.4+### Added+- Add extra debug logging for cache code.++### Fixed+- Fix a bug with xpub growing algorithm.++### Changed+- Use locks instead of transactions to update cache.++## 0.23.3+### Fixed+- Reduce contention when many instances of Haskoin Store share a cache.++## 0.23.2+### Added+- Allow retrieving xpub data without using cache.++## 0.23.1+### Added+- Allow xpub eviction from cache via API.+- Clarify cache address addition code.++### Fixed+- Balances were incorrectly computed in cache when new transactions arrived.++## 0.23.0+### Added+- Support for Redis transactions.+- Use a smaller initial gap for empty xpubs.++### Changed+- Remove custom JSON encoding class.+- Refactor and code simplification.++## 0.22.5+### Fixed+- Cache was being completely pruned.++## 0.22.4+### Fixed+- Cache now prunes correctly.++## 0.22.3+### Fixed+- Bug was making cache get stuck when pruning.++## 0.22.2+### Changed+- More efficient algorithms for caching and cache misses.+- Better debug logging of cache hits and misses.++## 0.22.1+### Added+- More debug logging for cache hits.++### Fixed+- Bug using maximum against empty list.++## 0.22.0+### Changed+- Extreme code refactoring.+- Move all code to Haskoin and drop Network from modules.++### Added+- Use Redis pipelining when importing multiple transactions into cache.+- Implement configurable LRU for Redis cache.+- Import xpubs directly into cache from web worker thread when a key is requested.++### Removed+- Only expose a few modules to external API.++## 0.21.7+### Changed+- Improve build configuration.++### Fixed+- Use minimum used addresses instead of minimum index for xpub cache decision.++## 0.21.6+### Fixed+- Fix missing xpub unspent outputs when using cache.++## 0.21.5+### Added+- Only store xpubs in cache if they have more than a threshold addresses used.++## 0.21.4+### Fixed+- Fix shared cache case where head is set beyond header chain by another node.++## 0.21.3+### Fixed+- Fix bug where best head was not being registered in cache.+- Fix best head in cache being decoded incorrectly.++## 0.21.2+### Added+- Complete support for Redis xpub cache.++## 0.21.1+### Fixed+- Latest version of secp256k1-haskell works with Debian 9.++## 0.21.0+### Fixed+- Fix output of web API calls when issuing limits with offsets.++### Changed+- Massive refactoring of entire codebase.++### Added+- Work in progress Redis caching for extended public keys.++## 0.20.2+### Changed+- Filter xpub address balances on web API to show only addresses that have been used.++### Removed+- Remove paths and addresses from xpub summary.++## 0.20.1+### Changed+- Refactor code greatly.+- Depend on new Haskoin Store package to avoid missing tx broadcasts.+- Merge StoreStream class into StoreRead.+- Move former streaming functions to use lists instead of conduits.+- Remove excessively verbose debugging.++## 0.20.0+### Added+- Set minimum version bounds for some dependencies.+- Now compatible with GHC 8.8.+- Extended key caching system using Redis.++### Changed+- Massively refactored codebase.+- Less verbose debug logging.++### Removed+- Removed conduits for faster queries.++## 0.19.6+### Added+- Use a parallel strategy to compute key derivations.++### Fixed+- Do not fail health check upon transaction timeout while syncing.++### Changed+- Do not use conduits for xpub balance streams.+- Multiple minor refactorings.++## 0.19.5+### Changed+- Minor refactor to block import code.++### Fixed+- Minor fix to transaction timeout check.++## 0.19.4+### Fixed+- Clarify and correct health check algorithm.++## 0.19.3+### Changed+- Add address transactions to cache.+- Improve multi-address transaction retrieval algorithms.++## 0.19.2+### Removed+- Cache-Control header turned out to be unnecessary.++### Fixed+- Fix some minor errors in web module.++## 0.19.1+### Added+- Set Cache-Control header to no-cache.++## 0.19.0+### Changed+- Store mempool in single key/value pair.++## 0.18.11+### Changed+- Do not stream mempool.++## 0.18.10+### Removed+- Disable timeout checks for testnets.++## 0.18.9+### Added+- Endpoint to locate a block by unix timestamp.++### Removed+- No more persistence for peers due to dependency on newest haskoin-node.++## 0.18.8+### Added+- Transaction and block timeouts for health check.+- Raw blocks.++## 0.18.7+### Fixed+- Missing tranasctions on xpub listings.++## 0.18.6+### Removed+- Follow Stack advise removing `-O2` GHC option.++## 0.18.5+### Added+- Compatibility with SegWit on extended public key endpoints.++### Changed+- Fix syncing peer not reset after timeout.+- Use simpler monad for streaming data.++## 0.18.4+### Changed+- Bump Haskoin Node to fix peers not stored and excessively verbose logging.++## 0.18.3+### Changed+- Configurable HTTP request logging. Disabled by default.++## 0.18.2+### Changed+- Fix for memory leak.++## 0.18.1+### Removed+- Remove transaction count from xpub summary object.++## 0.18.0+### Changed+- Simplified limits and start point handling on web API.+- Made transaction streaming algorithm faster for xpub transactions.+- Extended public key summary output contains all addresses that have received transactions.++### Added+- Fine-grained control for maximum limits via command line options.+- Transaction hash as starting point.+- Block hash as starting point.+- Timestamp as starting point.+- Configurable xpub gap limit.+- Transaction count added to xpub summary.+- UTXO count added to xpub summary.++### Removed+- Mempool endpoint now has no limits or offsets and always returns full list.+- Extended public key summary output no longer includes any transactions.+- Offsets not allowed for transaction lists involving multiple addresses or xpubs.+- Confusing block position parameter no longer part of web API.++## 0.17.2+### Changed+- Stream address balances and unspent outputs.+- Add configurable max value for limit and offset which defaults at 10000.++## 0.17.1+### Changed+- When posting a transaction to the network, timeout is now five seconds.+- Improve error message when transaction post timeout reached.+- Remove obsolete `not found` error for transaction post.+- Endpoints for retrieving blocks now do streaming for better performance.+- Improve Swagger API documentation.++## 0.17.0+### Added+- Endpoints for retrieving block transactions.+- Endpoint for retrieving set of latest blocks.++### Changed+- Use standardized JSON and binary serialization schemes for raw transaction endpoints.++## 0.16.6+### Changed+- Now logging info messages too by default.+- Consolidated web logging in middleware.++### Removed+- UUIDs for web requests.++## 0.16.5+### Removed+- Remove concurrency from xpub balance requests to prevent RocksDB segfaults.++## 0.16.4+### Removed+- Remove concurrency from requests using iterators to prevent RocksDB from segfaulting.++## 0.16.3+### Added+- Debugging information for web API.++## 0.16.2+### Changed+- Debugging disabled by default (use `--debug` to enable).++## 0.16.1+### Added+- Cache mempool transactions.+- Improve initial syncing performance.++## 0.16.0+### Added+- Orphan transaction support.+- Full address balance cache in RocksDB.+- Full unspent output cache in RocksDB.++### Changed+- Significantly refactor code.+- Move web stuff to its own module.+- Change types related to databases.+- Make xpub balance, transaction and unspent queries fetch data in parallel.++## 0.15.2+### Added+- Internal data types to support orphan transactions.++### Changed+- Do not spam block actor with pings.+- Fix balance/unspent cache not reverting when importing fails.+- Fix transaction sorting algorithm not including transaction position information.+- Fix conflicting mempool transaction preventing block from importing.++## 0.15.1+### Changed+- Fix duplicate coinbase transaction id bug.++## 0.15.0+### Removed+- Removed `PreciseUnixTime` data type.++### Changed+- Use 64 bits for Unix time representation.+- Data model now uses simplified Unix time representation.++## 0.14.9+### Added+- Last external/change index information to xpub summary object.++## 0.14.8+### Added+- Endpoint for xpub summaries.+- Endpoints for full transactions.+- Ability to query by offset/limit.+- More API documentation.++## 0.14.7+### Added+- Debug information for `publishTx`.++### Changed+- Transaction publishing no longer requests mempool.+- Fixed serialization for `TxId` freezing the entire program by infinitely recursing.++## 0.14.6+### Changed+- Enable full threading again as it was deemed not responsible for the freezing behaviour.++## 0.14.5+### Changed+- Enable threading but leave it at a single thread to be able to open more than 1024 files.++## 0.14.4+### Changed+- Target LTS Haskell 13.20 and disable threading in new attempt to fix freezing bug.++## 0.14.3+### Changed+- Remove `-O2`.++## 0.14.2+### Changed+- Target LTS Haskell 12.26 to attempt to fix freezing bug.++## 0.14.1+### Added+- Extra debugging around code that freezes.++### Changed+- Bump dependency on `haskoin-node`.++## 0.14.0+### Removed+- Dump slow protobuf serialization.++### Added+- Add custom serialization.+- Extra debug logging.++### Changed+- Bump `haskoin-core` and `haskoin-node`.++## 0.13.1+### Changed+- Bump `haskoin-node` in `stack.yaml`.+- Do not send empty `getdata` messages.++## 0.13.0+### Added+- Primitive content negotiation for web exceptions.+- Protobuf support for errors.+- Protobuf support for tranasction ids.++### Changed+- Protobuf format changed in non-backwards-compatible manner for transaction ids.++## 0.12.0+### Added+- Support for binary serialization using Protocol Buffers.+- New endpoints for binary raw transactions (not hex-encoded).++### Changed+- Services field now a hex string instead of a number to avoid overflowing signed 64-bit integer.+- Flatten list of block data objects when responding to request for multiple block heights.+- Errors now reported in plain text without container JSON object.+- Transaction broadcasts are responded to with transaction id in plaintext hex (no JSON).+- Remove database snapshots to improve performance.++## 0.11.2+### Changed+- Fix duplicate mempool transaction announcements in event stream.++## 0.11.1+### Removed+- Removed latest block time check.++## 0.11.0+### Changed+- Improve post transactions endpoint.++## 0.10.1+### Changed+- Fix bug where transaction lists from multiple addresses would sort incorrectly.+- Address gap reduced to 20.++## 0.10.0+### Removed+- Remove addresses from transaction lists.+- No longer use container objects for xpub transactions.++## 0.9.3+### Added+- Permissive CORS headers to allow queries from any domain.+- Improved documentation using real-world examples from the BCH testnet.++## 0.9.2+### Added+- HTTP JSON API switch to turn off transaction list when retrieving blocks.++## 0.9.1+### Added+- Total block fees.+- Total block outputs.+- Block subsidy.++### Changed+- Do not consider the blocks less one block away from headers as out of sync in health check.+- Health check now returns HTTP 503 when not OK or out of sync.++## 0.9.0+### Added+- Version to health check output.+- Block weight for segwit.+- Transaction weight for segwit.++## 0.8.1+### Added+- Health check endpoint.++## 0.8.0+### Added+- Limits and skips.+- Add timestamps to transactions.+- Add transaction count to address balance object.+- Add Merkle root to block data.+- Total funds received by an address now shows up in balance.+- Balances for any address that ever had funds show up in xpub endpoints.++### Changed+- Data model update.+- Performance improvement for xpub calls.+- Transactions are returned in reverse mempool/block order (highest or most recent first).+- Balance objects do not get deleted from database ever.++## 0.6.9+### Changed+- Reduce number of coinbase checks to 10,000 ancestors.++## 0.6.8+### Changed+- Further optimize coinbase after height checks.++## 0.6.7+### Changed+- Impose restrictions on recursion for coinbase after height checks.++## 0.6.6+### Added+- Check whether a transaction can be traced back to a coinbase after certain height.++## 0.6.5+### Changed+- Delete transactions in reverse topological order when reverting a block.++## 0.6.4+### Changed+- Do not fail silently when importing orphan transactions into the mempool.++## 0.6.3+### Changed+- Dummy release to bump haskoin-node in stack.yaml.++## 0.6.2+### Changed+- Correct bug where coinbase transactions weren't properly flagged.++## 0.6.1+### Changed+- Compatibility with Bitcoin Cash hard fork.+- Various bug fixes.++## 0.6.0+### Added+- Address balance cache in memory.++### Changed+- Simplify data model further.+- Fix bug importing outputs with UTXO cache.+- Unspent balances cannot be negative.++## 0.5.0+### Added+- Add UTXO cache in memory.+- Get transactions with witness data in segwit networks.++### Changed+- Paths for derivations in xpubs is a list and no longer a string.+- Various bug fixes.++## 0.4.2+### Removed+- Remove extended public key itself from output of relevant endpoints to save bandwidth.++## 0.4.1+### Changed+- Fix bug when deleting coinbase transactions.+- Extended public key API support.++## 0.4.0+### Changed+- Generate events for mempool transactions.+- Respond with entire block data when querying blocks by height.++## 0.3.1+### Changed+- Do not import transactions to mempool while not synced.+- Only sync mempool against a single peer.+- Allow duplicate transactions to fix re-introduced sync bug.++## 0.3.0+### Added+- Update dependencies.+- Keep orphan blocks and deleted transactions in database.+- Add a `mainchain` field for block data and a `deleted` field for transactions.+- Stream records for performance.+- Show witness data for transaction inputs in SegWit network.+- Support RBF in SegWit network.++### Changed+- Refactor all data access code away from actor.+- Refactor import logic away from actor.+- Abstract data access using typeclasses.+- Implement data access using clean layered architecture.+- Make most of import logic code pure.+- Database now in `db` as opposed to `blocks` directory.+- Use latest `haskoin-node`.++### Removed+- Remove some data from peer information output.+- Remove full transaction from address transaction data.+- Remove limits from address transaction data.+- Remove block data from previous output.+- Remove spender from JSON response when output not spent.+- Remove block hash from block reference.++## 0.2.3+### Removed+- Do not send transaction notifications if a block is being imported.++## 0.2.2+### Added+- Peer information endpoint.++### Changed+- Update `haskoin-node`.++## 0.2.1+### Changed+- Fix tests++## 0.2.0+### Added+- Documentation everywhere.+- Ability to retrieve address transactions.++### Changed+- New versions of NQE and Haskoin Node upstream.+- Improve and simplify API.+- Multi-element endpoints return arrays of arrays.+- Database snapshots for all queries are now mandatory.++### Removed+- Retrieving unspent and spent outputs for an address.+- Redundant API endpoints for multiple elements.++## 0.1.3+### Changed+- Fix a bug with transaction notifications.+- Improve handling orphan transactions.++## 0.1.2+### Changed+- Specify dependencies better.++## 0.1.1+### Changed+- Dependency `secp256k1` is now `secp256k1-haskell`.++## 0.1.0+### Added+- New `CHANGELOG.md` file.+- Bitcoin (BTC) and Bitcoin Cash (BCH) compatibility.+- RocksDB database.+- Mempool support.+- HTTP streaming for events.+- CashAddr support.+- Bech32 support.+- Rate limits.++### Changed+- Split out of former `haskoin` repository.+- Use hpack and `package.yaml`.++### Removed+- Removed Stylish Haskell configuration file.+- Remvoed `haskoin-core` and `haskoin-wallet` packages from this repository.
+ README.md view
@@ -0,0 +1,63 @@+# haskoin-store-data++Data types and API client of [Haskoin Store](https://github.com/jprupp/haskoin-store),+an indexer for Bitcoin and Bitcoin Cash with a REST API.++Use this package to talk to a Haskoin Store server from Haskell. It has no+database or network node of its own, so it is small to depend on.++## Modules++- `Haskoin.Store.Data`: the types that the server answers with (blocks,+  transactions, balances, unspent outputs, extended public keys, health+  checks, events, and the Blockchain.info compatible formats), with their+  JSON and binary encodings.+- `Haskoin.Store.WebCommon`: the requests of the API, one type per endpoint,+  with their paths and parameters.+- `Haskoin.Store.WebClient`: `apiCall`, which sends a request and decodes+  the answer.++## Example++```haskell+import Data.Default (def)+import Haskoin (btc, textToAddr, withContext)+import Haskoin.Store.WebClient++main :: IO ()+main = withContext $ \ctx -> do+  let cfg = def {net = btc} -- https://api.haskoin.com/btc/...+      Just addr = textToAddr btc "bc1q…"+  r <- apiCall ctx cfg (GetAddrBalance addr)+  print r+```++The client appends the name of the network to the host, as in the layout of+api.haskoin.com. The binary encoding is used on the wire, as it is smaller and+faster to decode than JSON.++## Building++The package builds with [Stack](https://haskellstack.org) and needs+libsecp256k1 (`libsecp256k1-dev` on Debian and Ubuntu), or Nix with+`stack --nix`:++```sh+stack build+stack test+```++The tests check every type by law: binary encodings round-trip and agree+between Serial, cereal and binary, JSON round-trips, the fast encoders write+the same JSON as `toJSON`, and the wire format of the basic types is pinned.++## Versions++Up to 1.8.1, this package was released from the+[haskoin-store](https://github.com/jprupp/haskoin-store) repository with the+same version number as the server. It now has its own releases; a server+speaks the wire format of the haskoin-store-data version it depends on.++## License++[MIT](LICENSE)
− Setup.hs
@@ -1,2 +0,0 @@-import Distribution.Simple-main = defaultMain
haskoin-store-data.cabal view
@@ -1,25 +1,35 @@-cabal-version: 1.12+cabal-version: 1.18  -- This file has been generated from package.yaml by hpack version 0.39.6. -- -- see: https://github.com/sol/hpack  name:           haskoin-store-data-version:        1.8.1-synopsis:       Data for Haskoin Store-description:    Please see the README on GitHub at <https://github.com/jprupp/haskoin-store#readme>+version:        1.9.0+synopsis:       Data types and API client of Haskoin Store+description:    The types of the data that Haskoin Store serves (blocks, transactions,+                balances, unspent outputs, extended public keys, health checks, events and+                the Blockchain.info compatible formats), with their JSON and binary+                encodings, and a client for its REST API. Use it to talk to a Haskoin Store+                server from Haskell. category:       Bitcoin, Finance, Network-homepage:       http://github.com/jprupp/haskoin-store#readme-bug-reports:    http://github.com/jprupp/haskoin-store/issues+homepage:       https://github.com/jprupp/haskoin-store-data#readme+bug-reports:    https://github.com/jprupp/haskoin-store-data/issues author:         JP Rupp maintainer:     jprupp@protonmail.ch+copyright:      (c) Haskoin Developers license:        MIT license-file:   LICENSE build-type:     Simple+tested-with:+    GHC == 9.12.4+extra-doc-files:+    README.md+    CHANGELOG.md  source-repository head   type: git-  location: https://github.com/jprupp/haskoin-store.git+  location: https://github.com/jprupp/haskoin-store-data  library   exposed-modules:@@ -30,68 +40,77 @@       Paths_haskoin_store_data   hs-source-dirs:       src+  default-extensions:+      DuplicateRecordFields+      NoFieldSelectors+      OverloadedRecordDot+      OverloadedStrings+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wno-name-shadowing -Wno-partial-fields   build-depends:-      aeson >=1.4.7.1-    , base >=4.9 && <5-    , binary >=0.8.8.0-    , bytes >=0.17-    , bytestring >=0.10.10.0-    , cereal >=0.5.8.1-    , containers >=0.6.2.1-    , data-default >=0.7.1.1-    , deepseq >=1.4.4.0-    , hashable >=1.3.0.0-    , haskoin-core >=1.6.0-    , http-client >=0.6.4.1-    , http-types >=0.12.3-    , lens >=4.18.1-    , mtl >=2.2.2-    , network >=3.1.1.1-    , scotty >=0.20-    , string-conversions >=0.4.0.1-    , text >=1.2.3.0-    , time >=1.9.3-    , unordered-containers >=0.2.10-    , vector >=0.13.0.0-    , wreq >=0.5.3.2-  default-language: Haskell2010+      aeson >=2.2.5.1 && <2.3+    , base >=4.21.2.0 && <4.22+    , binary >=0.8.9.3 && <0.9+    , bytes >=0.17.5 && <0.18+    , bytestring >=0.12.2.0 && <0.13+    , cereal >=0.5.8.3 && <0.6+    , containers ==0.7.*+    , data-default >=0.8.0.2 && <0.9+    , deepseq >=1.5.1.0 && <1.6+    , hashable >=1.5.1.0 && <1.6+    , haskoin-core >=1.6.1 && <1.7+    , http-client >=0.7.19 && <0.8+    , http-types >=0.12.6 && <0.13+    , lens >=5.3.6 && <5.4+    , network >=3.2.12.0 && <3.3+    , string-conversions >=0.4.0.1 && <0.5+    , text >=2.1.4 && <2.2+    , time ==1.14.*+    , unordered-containers >=0.2.21 && <0.3+    , vector >=0.13.2.0 && <0.14+    , wreq >=0.5.4.5 && <0.6+  default-language: GHC2024  test-suite spec   type: exitcode-stdio-1.0   main-is: Spec.hs   other-modules:       Haskoin.Store.DataSpec+      Haskoin.Store.Gen+      Haskoin.Store.Laws       Haskoin.Store.WebCommonSpec       Paths_haskoin_store_data   hs-source-dirs:       test-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  default-extensions:+      DuplicateRecordFields+      NoFieldSelectors+      OverloadedRecordDot+      OverloadedStrings+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -Wno-name-shadowing -Wno-partial-fields -threaded -rtsopts -with-rtsopts=-N   build-depends:-      QuickCheck >=2.13.2-    , aeson >=1.4.7.1-    , base >=4.9 && <5-    , binary >=0.8.8.0-    , bytes >=0.17-    , bytestring >=0.10.10.0-    , cereal >=0.5.8.1-    , containers >=0.6.2.1-    , data-default >=0.7.1.1-    , deepseq >=1.4.4.0-    , hashable >=1.3.0.0-    , haskoin-core >=1.6.0+      QuickCheck >=2.17.1.0 && <2.18+    , aeson >=2.2.5.1 && <2.3+    , base >=4.21.2.0 && <4.22+    , binary >=0.8.9.3 && <0.9+    , bytes >=0.17.5 && <0.18+    , bytestring >=0.12.2.0 && <0.13+    , cereal >=0.5.8.3 && <0.6+    , containers ==0.7.*+    , data-default >=0.8.0.2 && <0.9+    , deepseq >=1.5.1.0 && <1.6+    , hashable >=1.5.1.0 && <1.6+    , haskoin-core >=1.6.1 && <1.7     , haskoin-store-data-    , hspec >=2.7.1-    , http-client >=0.6.4.1-    , http-types >=0.12.3-    , lens >=4.18.1-    , mtl >=2.2.2-    , network >=3.1.1.1-    , scotty >=0.20-    , string-conversions >=0.4.0.1-    , text >=1.2.3.0-    , time >=1.9.3-    , unordered-containers >=0.2.10-    , vector >=0.13.0.0-    , wreq >=0.5.3.2-  default-language: Haskell2010+    , hspec >=2.11.18 && <2.12+    , http-client >=0.7.19 && <0.8+    , http-types >=0.12.6 && <0.13+    , lens >=5.3.6 && <5.4+    , network >=3.2.12.0 && <3.3+    , string-conversions >=0.4.0.1 && <0.5+    , text >=2.1.4 && <2.2+    , time ==1.14.*+    , unordered-containers >=0.2.21 && <0.3+    , vector >=0.13.2.0 && <0.14+    , wreq >=0.5.4.5 && <0.6+  default-language: GHC2024   build-tool-depends: hspec-discover:hspec-discover
src/Haskoin/Store/Data.hs view
@@ -1,17 +1,5 @@ {-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE NoFieldSelectors #-}  -- | -- Module      : Haskoin.Store.Data@@ -103,9 +91,12 @@     -- * Blockchain.info API     BinfoInfo (..),     BinfoBlockId (..),+    parseBinfoBlockId,     BinfoTxId (..),+    parseBinfoTxId,     encodeBinfoTxId,     BinfoFilter (..),+    parseBinfoFilter,     BinfoMultiAddr (..),     BinfoShortBal (..),     BinfoBalance (..),@@ -135,6 +126,7 @@     BinfoHistory (..),     toBinfoHistory,     BinfoDate (..),+    parseBinfoDate,     BinfoHeader (..),     BinfoMempool (..),     BinfoBlockInfos (..),@@ -144,10 +136,9 @@ import Control.Applicative (optional, (<|>)) import Control.DeepSeq (NFData) import Control.Exception (Exception)-import Control.Monad (guard, join, mzero, unless, (<=<))+import Control.Monad (guard, join, mzero, unless) import Data.Aeson-  ( Encoding,-    FromJSON (..),+  ( FromJSON (..),     ToJSON (..),     Value (..),     (.!=),@@ -163,7 +154,6 @@ import Data.Bool (bool) import Data.ByteString (ByteString) import Data.ByteString qualified as B-import Data.ByteString.Builder qualified as Builder import Data.Bytes.Get import Data.Bytes.Get qualified as Bytes.Get import Data.Bytes.Put@@ -192,9 +182,6 @@ import Data.Text (Text) import Data.Text qualified as T import Data.Text.Encoding qualified as T-import Data.Text.Lazy qualified as LazyText-import Data.Text.Lazy.Encoding qualified as LazyText-import Data.Time (UTCTime (UTCTime), rfc822DateFormat) import Data.Time.Clock.POSIX   ( posixSecondsToUTCTime,     utcTimeToPOSIXSeconds,@@ -204,19 +191,16 @@     formatTime,     parseTimeM,   )-import Data.Time.Format.ISO8601-  ( iso8601ParseM,-    iso8601Show,-  ) import Data.Vector qualified as V import Data.Word (Word32, Word64) import GHC.Generics (Generic) import Haskoin-import Web.Scotty.Trans (Parsable (..))+import Text.Read (readMaybe)  -- | Type of the addresses derived from an extended public key. data DeriveType-  = -- | legacy pay-to-public-key-hash addresses (@normal@)+  = -- | legacy pay-to-public-key-hash addresses (@legacy@, formerly+    -- @normal@)     DeriveNormal   | -- | pay-to-witness-public-key-hash nested in pay-to-script-hash     -- (@compat@)@@ -225,16 +209,26 @@     DeriveP2WPKH   deriving (Show, Eq, Generic, NFData) --- | Parse a derivation type from @normal@, @compat@ or @segwit@.+-- | Parse a derivation type from @legacy@, @compat@ or @segwit@.+--+-- @normal@ is read as @legacy@ too. It was the only name of legacy addresses+-- up to version 1.8, and URLs and programs written then keep working; but+-- "normal" says nothing about the kind of address, and suggests the others+-- are not, which they have long been, hence the new name. textToDeriveType :: Text -> Maybe DeriveType+textToDeriveType "legacy" = Just DeriveNormal textToDeriveType "normal" = Just DeriveNormal textToDeriveType "compat" = Just DeriveP2SH textToDeriveType "segwit" = Just DeriveP2WPKH textToDeriveType _ = Nothing --- | Text form of a derivation type: @normal@, @compat@ or @segwit@.+-- | Text form of a derivation type: @legacy@, @compat@ or @segwit@.+--+-- Clients never send the default type, legacy, in a request (see+-- @noDefBox@ in "Haskoin.Store.WebCommon"), so servers older than version+-- 1.9, which do not know the name @legacy@, still understand every request. deriveTypeToText :: DeriveType -> Text-deriveTypeToText DeriveNormal = "normal"+deriveTypeToText DeriveNormal = "legacy" deriveTypeToText DeriveP2SH = "compat" deriveTypeToText DeriveP2WPKH = "segwit" @@ -261,12 +255,6 @@ instance Default DeriveType where   def = DeriveNormal -instance Parsable DeriveType where-  parseParam txt =-    case textToDeriveType (LazyText.toStrict txt) of-      Nothing -> Left "invalid derivation type"-      Just x -> Right x- -- | Extended public key with the type of the addresses to derive from it. data XPubSpec = XPubSpec   { -- | the extended public key@@ -790,7 +778,7 @@           bool mempty ("weight" `A.pair` A.word32 b.weight) net.segWit         ] -  unmarshalValue net = parseJSON+  unmarshalValue _net = parseJSON  -- | Transaction input with information about the output it spends. data StoreInput@@ -890,7 +878,7 @@         "address" .= (marshalValue net <$> address),         "witness" .= map encodeHex witness       ]-  marshalValue net StoreCoinbase {..} =+  marshalValue _net StoreCoinbase {..} =     A.object       [ "coinbase" .= True,         "txid" .= outpoint.hash,@@ -916,7 +904,7 @@           "address" `A.pair` maybe A.null_ (marshalEncoding net) address,           "witness" `A.pair` A.list (hexEncoding . B.fromStrict) witness         ]-  marshalEncoding net StoreCoinbase {..} =+  marshalEncoding _net StoreCoinbase {..} =     A.pairs $       mconcat         [ "coinbase" .= True,@@ -1842,6 +1830,18 @@  -- | Health of the store, as returned by @\/health@. It is healthy if every check -- passes.+--+-- The check of Redis is not one of them. A store that has a Redis cache and+-- cannot reach it still answers every request, from its own database, so it+-- is fit to serve, and 'isOK' says so. What it lost is that its answers are+-- the ones that the stores sharing that Redis give together. That is worth+-- knowing and not worth taking the store out of service for, so it has a+-- field of its own, and @\/health@ answers 203 instead of 200.+--+-- The field is the last thing in the binary encoding, and may be missing+-- there and in JSON, where it reads as 'Nothing'. So the output of a store+-- from before the field can still be read, and a client from before it+-- reads the output of a new store. data HealthCheck = HealthCheck   { -- | the database keeps up with the headers     blocks :: !BlockHealth,@@ -1858,7 +1858,10 @@     -- | version of the software     version :: !String,     -- | time of the check-    time :: !Word64+    time :: !Word64,+    -- | whether the Redis cache answers; 'Nothing' for a store that has+    -- none+    redis :: !(Maybe Bool)   }   deriving (Show, Eq, Generic, NFData) @@ -1873,6 +1876,10 @@     putLengthBytes $ T.encodeUtf8 $ T.pack h.network     putLengthBytes $ T.encodeUtf8 $ T.pack h.version     putWord64be h.time+    putWord8 $ case h.redis of+      Nothing -> 0x00+      Just False -> 0x01+      Just True -> 0x02   deserialize = do     k <- deserialize     blocks <- deserialize@@ -1883,6 +1890,15 @@     network <- T.unpack . T.decodeUtf8 <$> getLengthBytes     version <- T.unpack . T.decodeUtf8 <$> getLengthBytes     time <- getWord64be+    redis <-+      isEmpty >>= \case+        True -> return Nothing+        False ->+          getWord8 >>= \case+            0x00 -> return Nothing+            0x01 -> return (Just False)+            0x02 -> return (Just True)+            _ -> fail "Cannot decode the health of Redis"     let h = HealthCheck {..}     unless (k == isOK h) $ fail "Inconsistent health check"     return h@@ -1907,7 +1923,7 @@  instance ToJSON HealthCheck where   toJSON h =-    A.object+    A.object $       [ "blocks" .= h.blocks,         "last-block" .= h.lastBlock,         "last-tx" .= h.lastTx,@@ -1918,6 +1934,7 @@         "time" .= show (posixSecondsToUTCTime $ fromIntegral h.time),         "ok" .= isOK h       ]+        <> ["redis" .= A.object ["ok" .= up] | Just up <- [h.redis]]  instance FromJSON HealthCheck where   parseJSON =@@ -1931,6 +1948,7 @@       version <- o .: "version"       utcTime <- read <$> o .: "time"       let time = round $ utcTimeToPOSIXSeconds utcTime+      redis <- o .:? "redis" >>= mapM (.: "ok")       return HealthCheck {..}  -- | Event streamed by @\/events@.@@ -1983,7 +2001,8 @@  -- | Response that wraps a single value, encoded in JSON as @{\"result\": value}@. newtype GenericResult a = GenericResult {get :: a}-  deriving (Show, Eq, Generic, NFData)+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)  instance (Serial a) => Serial (GenericResult a) where   serialize (GenericResult x) = serialize x@@ -2008,7 +2027,8 @@ -- | Response with a value in its peer-to-peer serialization, encoded in JSON as -- a hex string in @{\"result\": hex}@. newtype RawResult a = RawResult {get :: a}-  deriving (Show, Eq, Generic, NFData)+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)  instance (Serial a) => Serial (RawResult a) where   serialize (RawResult x) = serialize x@@ -2039,7 +2059,8 @@  -- | List response. In binary, a length followed by the items. newtype SerialList a = SerialList {get :: [a]}-  deriving (Show, Eq, Generic, NFData)+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)  instance Semigroup (SerialList a) where   SerialList a <> SerialList b = SerialList (a <> b)@@ -2061,7 +2082,8 @@ -- | List of values in their peer-to-peer serialization, encoded in JSON as a -- list of hex strings. newtype RawResultList a = RawResultList {get :: [a]}-  deriving (Show, Eq, Generic, NFData)+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)  instance (Serial a) => Serial (RawResultList a) where   serialize (RawResultList xs) =@@ -2107,7 +2129,8 @@ -- @{\"txid\": hash}@. newtype TxId   = TxId TxHash-  deriving (Show, Eq, Generic, NFData)+  deriving stock (Show, Eq, Generic)+  deriving anyclass (NFData)  instance Serial TxId where   serialize (TxId h) = serialize h@@ -2223,8 +2246,7 @@ toIntTxId :: TxHash -> Word64 toIntTxId h =   let bs = runPutS (serialize h)-      Right w64 = runGetS getWord64be bs-   in w64 `shift` (-11)+   in either error id (runGetS getWord64be bs) `shift` (-11)  -- | Block identified by hash or by height. data BinfoBlockId@@ -2234,14 +2256,12 @@     BinfoBlockIndex !Word32   deriving (Eq, Show, Read, Generic, NFData) -instance Parsable BinfoBlockId where-  parseParam t =-    hex <> igr-    where-      hex = case hexToBlockHash (LazyText.toStrict t) of-        Nothing -> Left "could not decode txid"-        Just h -> Right $ BinfoBlockHash h-      igr = BinfoBlockIndex <$> parseParam t+-- | Read a block identifier from the text of a request parameter: a block+-- hash in hex, or a height.+parseBinfoBlockId :: Text -> Maybe BinfoBlockId+parseBinfoBlockId t =+  (BinfoBlockHash <$> hexToBlockHash t)+    <|> (BinfoBlockIndex <$> readMaybe (cs t))  -- | Transaction identified by hash or by short number; see 'toIntTxId'. data BinfoTxId@@ -2256,15 +2276,12 @@ encodeBinfoTxId False = BinfoTxIdHash encodeBinfoTxId True = BinfoTxIdIndex . toIntTxId -instance Parsable BinfoTxId where-  parseParam t =-    hex <> igr-    where-      hex =-        case hexToTxHash (LazyText.toStrict t) of-          Nothing -> Left "could not decode txid"-          Just h -> Right $ BinfoTxIdHash h-      igr = BinfoTxIdIndex <$> parseParam t+-- | Read a transaction identifier from the text of a request parameter: a+-- transaction hash in hex, or a short number.+parseBinfoTxId :: Text -> Maybe BinfoTxId+parseBinfoTxId t =+  (BinfoTxIdHash <$> hexToTxHash t)+    <|> (BinfoTxIdIndex <$> readMaybe (cs t))  instance ToJSON BinfoTxId where   toJSON (BinfoTxIdHash h) = toJSON h@@ -2293,17 +2310,19 @@     BinfoFilterMempool   deriving (Eq, Show, Generic, NFData) -instance Parsable BinfoFilter where-  parseParam t =-    parseParam t >>= \case-      (0 :: Int) -> return BinfoFilterAll-      1 -> return BinfoFilterSent-      2 -> return BinfoFilterReceived-      3 -> return BinfoFilterMoved-      5 -> return BinfoFilterConfirmed-      6 -> return BinfoFilterAll-      7 -> return BinfoFilterMempool-      _ -> Left "could not parse filter parameter"+-- | Read a filter from the text of a request parameter: the number that+-- Blockchain.info uses for it.+parseBinfoFilter :: Text -> Maybe BinfoFilter+parseBinfoFilter t =+  readMaybe (cs t) >>= \case+    (0 :: Int) -> Just BinfoFilterAll+    1 -> Just BinfoFilterSent+    2 -> Just BinfoFilterReceived+    3 -> Just BinfoFilterMoved+    5 -> Just BinfoFilterConfirmed+    6 -> Just BinfoFilterAll+    7 -> Just BinfoFilterMempool+    _ -> Nothing  -- | Response of @\/blockchain\/multiaddr@. data BinfoMultiAddr = BinfoMultiAddr@@ -2504,7 +2523,7 @@   deriving (Eq, Show, Generic, NFData)  instance MarshalJSON (Network, Ctx) BinfoBalance where-  marshalValue (net, ctx) b@BinfoAddrBalance {} =+  marshalValue (net, _ctx) b@BinfoAddrBalance {} =     A.object       [ "address" .= marshalValue net b.address,         "final_balance" .= b.balance,@@ -2543,7 +2562,7 @@         sent <- o .: "total_sent"         return BinfoAddrBalance {..} -  marshalEncoding (net, ctx) b@BinfoAddrBalance {} =+  marshalEncoding (net, _ctx) b@BinfoAddrBalance {} =     A.pairs $       mconcat         [ "address" `A.pair` marshalEncoding net b.address,@@ -2692,7 +2711,8 @@  -- | Response of @\/blockchain\/unspent@. newtype BinfoUnspents = BinfoUnspents [BinfoUnspent]-  deriving (Eq, Show, Generic, NFData)+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)  instance MarshalJSON (Network, Ctx) BinfoUnspents where   marshalValue (net, ctx) (BinfoUnspents us) =@@ -3391,16 +3411,16 @@ -- | Date given as @DD-MM-YYYY@ or @DD\/MM\/YYYY@ in a request, as seconds -- since the Unix epoch. newtype BinfoDate = BinfoDate Word64-  deriving (Eq, Show, Read, Generic, NFData)+  deriving stock (Eq, Show, Read, Generic)+  deriving anyclass (NFData) -instance Parsable BinfoDate where-  parseParam t =-    maybeToEither "Cannot parse date"-      . fmap (BinfoDate . round . utcTimeToPOSIXSeconds)-      $ p "%d-%m-%Y" <|> p "%d/%m/%Y"-    where-      s = LazyText.unpack t-      p fmt = parseTimeM False defaultTimeLocale fmt s+-- | Read a date from the text of a request parameter, as @dd-mm-yyyy@ or+-- @dd\/mm\/yyyy@.+parseBinfoDate :: Text -> Maybe BinfoDate+parseBinfoDate t =+  BinfoDate . round . utcTimeToPOSIXSeconds <$> (p "%d-%m-%Y" <|> p "%d/%m/%Y")+  where+    p fmt = parseTimeM False defaultTimeLocale fmt (cs t)  -- | Price of the coin of the network in a fiat currency, from the ticker -- service.@@ -3538,7 +3558,7 @@       return txid     outs = mapMaybe f t.outputs     g StoreCoinbase {} = Nothing-    g StoreInput {outpoint = OutPoint h i} = Just h+    g StoreInput {outpoint = OutPoint h _i} = Just h     ins = mapMaybe g t.inputs  -- | Balances of addresses and xpubs in the Blockchain.info format.@@ -3561,7 +3581,7 @@               [m', n] | m == m' -> n + 1               _ -> 0           received = sum $ map f xs-          bal = fromIntegral $ sum $ map g xs+          bal = sum $ map g xs           sent = if bal <= received then received - bal else 0           count = HashMap.lookupDefault 0 k xpubTxs           ax = foldl max 0 $ map (i 0) xs@@ -3776,7 +3796,7 @@  -- | Parse addresses and xpubs separated by pipes or commas. Returns 'Nothing' if any is invalid. parseBinfoAddr :: Network -> Ctx -> Text -> Maybe [BinfoAddr]-parseBinfoAddr net ctx "" = Just []+parseBinfoAddr _net _ctx "" = Just [] parseBinfoAddr net ctx s =   mapM f $     concatMap (filter (not . T.null) . T.splitOn ",") (T.splitOn "|" s)@@ -3831,7 +3851,8 @@  -- | Response of @\/blockchain\/unconfirmed-transactions@. newtype BinfoMempool = BinfoMempool {get :: [BinfoTx]}-  deriving (Eq, Show, Generic, NFData)+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)  instance MarshalJSON (Network, Ctx) BinfoMempool where   marshalValue (net, ctx) (BinfoMempool txs) =@@ -3846,7 +3867,8 @@  -- | List of short block information. newtype BinfoBlockInfos = BinfoBlockInfos {get :: [BinfoBlockInfo]}-  deriving (Eq, Show, Generic, NFData)+  deriving stock (Eq, Show, Generic)+  deriving anyclass (NFData)  instance ToJSON BinfoBlockInfos where   toJSON b = A.object ["blocks" .= b.get]
src/Haskoin/Store/WebClient.hs view
@@ -1,13 +1,3 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE GADTs #-}-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoFieldSelectors #-}- -- | -- Module      : Haskoin.Store.WebClient -- Copyright   : (c) Haskoin Developers@@ -20,15 +10,14 @@ -- -- Build a request value, such as 'GetAddrBalance', and pass it to 'apiCall'. -- The response type follows from the request type. Requests and responses use--- the compact binary encoding of the API. Errors returned by the server are--- thrown as 'Store.Except' in 'MonadError'.+-- the compact binary encoding of the API. A call returns the error that the+-- server answered with, as 'Store.Except', or the response. -- -- @--- import Control.Monad.Except (runExceptT) -- import Data.Default (def) -- -- balance :: Ctx -> Address -> IO (Either Except Balance)--- balance ctx addr = runExceptT $ 'apiCall' ctx def ('GetAddrBalance' addr)+-- balance ctx addr = 'apiCall' ctx def ('GetAddrBalance' addr) -- @ -- -- Requests that take long lists of addresses, transactions or blocks can be@@ -40,6 +29,7 @@     ApiConfig (..),     apiCall,     apiBatch,+     -- * Blocks     GetBlock (..),     GetBlocks (..),@@ -52,6 +42,7 @@     GetBlockHeightRaw (..),     GetBlockTime (..),     GetBlockTimeRaw (..),+     -- * Transactions     GetTx (..),     GetTxs (..),@@ -63,6 +54,7 @@     PostTx (..),     GetMempool (..),     GetEvents (..),+     -- * Addresses     GetAddrTxs (..),     GetAddrsTxs (..),@@ -72,6 +64,7 @@     GetAddrsBalance (..),     GetAddrUnspent (..),     GetAddrsUnspent (..),+     -- * Extended public keys     GetXPub (..),     GetXPubTxs (..),@@ -79,9 +72,11 @@     GetXPubBalances (..),     GetXPubUnspent (..),     DelCachedXPub (..),+     -- * Network     GetPeers (..),     GetHealth (..),+     -- * Parameters     StartParam (..),     OffsetParam (..),@@ -98,10 +93,7 @@ import Control.Arrow (second) import Control.Exception import Control.Lens ((.~), (?~), (^.))-import Control.Monad.Except-import Control.Monad.IO.Class (MonadIO, liftIO) import Data.Aeson qualified as A-import Data.ByteString.Lazy qualified as BL import Data.Bytes.Get import Data.Bytes.Put import Data.Bytes.Serial@@ -157,40 +149,47 @@ -- -- > apiCall ctx def $ GetAddrsUnspent addrs def {limit = Just 10} ----- Only @GET@ and @POST@ endpoints are supported.+-- Only @GET@ and @POST@ endpoints are supported. The result is the error+-- that the server answered with, or the response. apiCall ::-  (ApiResource a b, MonadIO m, MonadError Store.Except m) =>+  (ApiResource a b) =>   Ctx ->   ApiConfig ->   a ->-  m b-apiCall ctx (ApiConfig net apiHost) res = do-  args <- liftEither $ toOptions net ctx res-  let url = apiHost <> net.name <> cs (queryPath net ctx res)-  case resourceMethod $ asProxy res of-    GET -> liftEither =<< liftIO (getBinary args url)-    POST ->-      case resourceBody res of-        Just (PostBox val) ->-          liftEither =<< liftIO (postBinary args url val)-        _ -> throwError $ Store.StringError "Could not post resource"-    _ -> throwError $ Store.StringError "Unsupported HTTP method"+  IO (Either Store.Except b)+apiCall ctx (ApiConfig net apiHost) res =+  case toOptions net ctx res of+    Left e -> return (Left e)+    Right args ->+      let url = apiHost <> net.name <> cs (queryPath net ctx res)+       in case resourceMethod $ asProxy res of+            GET -> getBinary args url+            POST ->+              case resourceBody res of+                Just (PostBox val) -> postBinary args url val+                _ -> return . Left $ Store.StringError "Could not post resource"+            _ -> return . Left $ Store.StringError "Unsupported HTTP method"  -- | Batch commands that have a large list of arguments: -- -- > apiBatch ctx 20 def (GetAddrsTxs addrs def) -- -- The list is split into chunks of the given size, one call is made per chunk,--- and the results are concatenated.+-- and the results are concatenated. The calls stop at the first error. apiBatch ::-  (Batchable a b, MonadIO m, MonadError Store.Except m) =>+  (Batchable a b) =>   Ctx ->   Natural ->   ApiConfig ->   a ->-  m b-apiBatch ctx i conf res =-  mconcat <$> mapM (apiCall ctx conf) (resourceBatch i res)+  IO (Either Store.Except b)+apiBatch ctx i conf res = go mempty (resourceBatch i res)+  where+    go acc [] = return (Right acc)+    go acc (r : rs) =+      apiCall ctx conf r >>= \case+        Left e -> return (Left e)+        Right b -> go (acc <> b) rs  -- | Requests that can be split into several smaller ones whose results are -- concatenated.
src/Haskoin/Store/WebCommon.hs view
@@ -1,14 +1,4 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-}-{-# LANGUAGE GeneralizedNewtypeDeriving #-}-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoFieldSelectors #-}  -- | -- Module      : Haskoin.Store.WebCommon@@ -31,14 +21,78 @@ -- Describing each endpoint once, as a type, keeps the server and the client from -- drifting apart: the path, parameters and response type that the server routes -- are the same ones the client builds requests from.-module Haskoin.Store.WebCommon where+module Haskoin.Store.WebCommon+  ( ApiResource (..),+    PostBox (..),+    ParamBox (..),+    ProxyBox (..),+    GetBlock (..),+    GetBlocks (..),+    GetBlockRaw (..),+    GetBlockBest (..),+    GetBlockBestRaw (..),+    GetBlockLatest (..),+    GetBlockHeight (..),+    GetBlockHeights (..),+    GetBlockHeightRaw (..),+    GetBlockTime (..),+    GetBlockTimeRaw (..),+    GetBlockMTP (..),+    GetBlockMTPRaw (..),+    GetTx (..),+    GetTxs (..),+    GetTxRaw (..),+    GetTxsRaw (..),+    GetTxsBlock (..),+    GetTxsBlockRaw (..),+    GetTxAfter (..),+    PostTx (..),+    GetMempool (..),+    GetEvents (..),+    GetAddrTxs (..),+    GetAddrsTxs (..),+    GetAddrTxsFull (..),+    GetAddrsTxsFull (..),+    GetAddrBalance (..),+    GetAddrsBalance (..),+    GetAddrUnspent (..),+    GetAddrsUnspent (..),+    GetXPub (..),+    GetXPubTxs (..),+    GetXPubTxsFull (..),+    GetXPubBalances (..),+    GetXPubUnspent (..),+    DelCachedXPub (..),+    GetPeers (..),+    GetHealth (..),+    (<:>),+    (<+>),+    (<++>),+    fill,+    noDefBox,+    noMaybeBox,+    asProxy,+    queryPath,+    capturePath,+    paramLabel,+    Param (..),+    StartParam (..),+    OffsetParam (..),+    LimitParam (..),+    LimitsParam (..),+    HeightParam (..),+    HeightsParam (..),+    TimeParam (..),+    NoCache (..),+    NoTx (..),+  )+where  import Control.Applicative ((<|>)) import Control.Monad (guard) import Data.Bytes.Serial import Data.Default (Default, def) import Data.Proxy (Proxy (..))-import Data.String (IsString (..)) import Data.String.Conversions (cs) import Data.Text (Text) import Data.Text qualified as T@@ -57,7 +111,6 @@ import Network.HTTP.Types (StdMethod (..)) import Numeric.Natural (Natural) import Text.Read (readMaybe)-import Web.Scotty.Trans qualified as Scotty  ------------------- -- API Resources --@@ -69,17 +122,21 @@   -- | HTTP method; 'GET' by default.   resourceMethod :: Proxy a -> StdMethod   resourceMethod _ = GET+   -- | Path of the endpoint, given the encoded values of the parameters that   -- are part of the path.   resourcePath :: Proxy a -> ([Text] -> Text)+   -- | Parameters of a request: those that go in the path, and those that go in   -- the query string.   queryParams :: a -> ([ParamBox], [ParamBox]) -- (resource, querystring)   queryParams _ = ([], [])+   -- | Types of the parameters that go in the path, used to build the route   -- pattern of the server.   captureParams :: Proxy a -> [ProxyBox]   captureParams _ = []+   -- | Body of the request, if any.   resourceBody :: a -> Maybe PostBox   resourceBody = const Nothing@@ -98,6 +155,7 @@ --------------------  -- Blocks+ -- | Request for a block by hash: @GET \/block\/:block@. data GetBlock = GetBlock !BlockHash !NoTx @@ -138,6 +196,7 @@ newtype GetBlockMTPRaw = GetBlockMTPRaw TimeParam  -- Transactions+ -- | Request for a transaction: @GET \/transaction\/:txid@. newtype GetTx = GetTx TxHash @@ -169,6 +228,7 @@ data GetEvents = GetEvents  -- Address+ -- | Request for transactions of an address: @GET \/address\/:address\/transactions@. data GetAddrTxs = GetAddrTxs !Address !LimitsParam @@ -194,6 +254,7 @@ data GetAddrsUnspent = GetAddrsUnspent ![Address] !LimitsParam  -- XPubs+ -- | Request for summary of an extended public key: @GET \/xpub\/:xpub@. data GetXPub = GetXPub !XPubKey !Store.DeriveType !NoCache @@ -213,6 +274,7 @@ data DelCachedXPub = DelCachedXPub !XPubKey !Store.DeriveType  -- Network+ -- | Request for connected peers: @GET \/peers@. data GetPeers = GetPeers @@ -479,10 +541,12 @@         Just [res] -> res         _ -> error "Invalid query param" --- | Route pattern of an endpoint for the server, with a named capture for each path parameter.-capturePath :: (ApiResource a b) => Proxy a -> Scotty.RoutePattern+-- | Route pattern of an endpoint for the server, such as+-- @\/block\/:block@: its path, with a capture named after each path+-- parameter, preceded by a colon.+capturePath :: (ApiResource a b) => Proxy a -> Text capturePath proxy =-  fromString $ cs $ f $ toLabel <$> captureParams proxy+  f $ toLabel <$> captureParams proxy   where     f = resourcePath proxy     toLabel (ProxyBox p) = ":" <> proxyLabel p@@ -499,22 +563,24 @@ class Param a where   -- | Name of the parameter in URLs.   proxyLabel :: Proxy a -> Text+   -- | Encode a value as one or more strings. A list parameter is sent as   -- comma-separated values.   encodeParam :: Network -> Ctx -> a -> Maybe [Text]+   -- | Parse a value from one or more strings.   parseParam :: Network -> Ctx -> [Text] -> Maybe a  instance Param Address where   proxyLabel = const "address"-  encodeParam net ctx a = (: []) <$> addrToText net a-  parseParam net ctx [a] = textToAddr net a-  parseParam net ctx _ = Nothing+  encodeParam net _ctx a = (: []) <$> addrToText net a+  parseParam net _ctx [a] = textToAddr net a+  parseParam _net _ctx _ = Nothing  instance Param [Address] where   proxyLabel = const "addresses"-  encodeParam net ctx = mapM (addrToText net)-  parseParam net ctx = mapM (textToAddr net)+  encodeParam net _ctx = mapM (addrToText net)+  parseParam net _ctx = mapM (textToAddr net)  -- | Where a page of results starts. In URLs it is a transaction hash, a block -- height, or a Unix timestamp. Numbers up to 1230768000 are heights and larger@@ -530,7 +596,7 @@  instance Param StartParam where   proxyLabel = const "height"-  encodeParam net ctx p =+  encodeParam _net _ctx p =     case p of       StartParamHash h -> return [txHashToHex (TxHash h)]       StartParamHeight h -> do@@ -539,7 +605,7 @@       StartParamTime t -> do         guard $ t > 1230768000         return [cs $ show t]-  parseParam net ctx [s] =+  parseParam _net _ctx [s] =     parseHash <|> parseHeight <|> parseUnix     where       parseHash = do@@ -554,7 +620,7 @@         x <- readMaybe $ cs s         guard $ x > 1230768000         return $ StartParamTime x-  parseParam net ctx _ = Nothing+  parseParam _net _ctx _ = Nothing  -- | Number of results to skip (@offset@). newtype OffsetParam = OffsetParam {get :: Natural}@@ -565,9 +631,9 @@  instance Param OffsetParam where   proxyLabel = const "offset"-  encodeParam net ctx (OffsetParam o) = Just [cs $ show o]-  parseParam net ctx [s] = OffsetParam <$> readMaybe (cs s)-  parseParam net ctx _ = Nothing+  encodeParam _net _ctx (OffsetParam o) = Just [cs $ show o]+  parseParam _net _ctx [s] = OffsetParam <$> readMaybe (cs s)+  parseParam _net _ctx _ = Nothing  -- | Maximum number of results (@limit@). newtype LimitParam = LimitParam {get :: Natural}@@ -575,9 +641,9 @@  instance Param LimitParam where   proxyLabel = const "limit"-  encodeParam net ctx (LimitParam l) = Just [cs $ show l]-  parseParam net ctx [s] = LimitParam <$> readMaybe (cs s)-  parseParam net ctx _ = Nothing+  encodeParam _net _ctx (LimitParam l) = Just [cs $ show l]+  parseParam _net _ctx [s] = LimitParam <$> readMaybe (cs s)+  parseParam _net _ctx _ = Nothing  -- | Pagination of a list of results. data LimitsParam = LimitsParam@@ -600,9 +666,9 @@  instance Param HeightParam where   proxyLabel = const "height"-  encodeParam net ctx (HeightParam h) = Just [cs $ show h]-  parseParam net ctx [s] = HeightParam <$> readMaybe (cs s)-  parseParam net ctx _ = Nothing+  encodeParam _net _ctx (HeightParam h) = Just [cs $ show h]+  parseParam _net _ctx [s] = HeightParam <$> readMaybe (cs s)+  parseParam _net _ctx _ = Nothing  -- | List of block heights (@heights@). newtype HeightsParam = HeightsParam {get :: [Natural]}@@ -610,8 +676,8 @@  instance Param HeightsParam where   proxyLabel = const "heights"-  encodeParam net ctx (HeightsParam hs) = Just $ cs . show <$> hs-  parseParam net ctx xs = HeightsParam <$> mapM (readMaybe . cs) xs+  encodeParam _net _ctx (HeightsParam hs) = Just $ cs . show <$> hs+  parseParam _net _ctx xs = HeightsParam <$> mapM (readMaybe . cs) xs  -- | Unix timestamp in seconds (@time@). newtype TimeParam = TimeParam {get :: Store.UnixTime}@@ -619,22 +685,22 @@  instance Param TimeParam where   proxyLabel = const "time"-  encodeParam net ctx (TimeParam t) = Just [cs $ show t]-  parseParam net ctx [s] = TimeParam <$> readMaybe (cs s)-  parseParam net ctx _ = Nothing+  encodeParam _net _ctx (TimeParam t) = Just [cs $ show t]+  parseParam _net _ctx [s] = TimeParam <$> readMaybe (cs s)+  parseParam _net _ctx _ = Nothing  instance Param XPubKey where   proxyLabel = const "xpub"   encodeParam net ctx p = Just [xPubExport net ctx p]   parseParam net ctx [s] = xPubImport net ctx s-  parseParam net ctx _ = Nothing+  parseParam _net _ctx _ = Nothing  instance Param Store.DeriveType where   proxyLabel = const "derive"-  encodeParam net ctx p = do+  encodeParam net _ctx p = do     guard (net.segWit || p == Store.DeriveNormal)     Just [Store.deriveTypeToText p]-  parseParam net ctx d = do+  parseParam net _ctx d = do     res <- case d of       [x] -> Store.textToDeriveType x       _ -> Nothing@@ -650,9 +716,9 @@  instance Param NoCache where   proxyLabel = const "nocache"-  encodeParam net ctx (NoCache True) = Just ["true"]-  encodeParam net ctx (NoCache False) = Just ["false"]-  parseParam net ctx = \case+  encodeParam _net _ctx (NoCache True) = Just ["true"]+  encodeParam _net _ctx (NoCache False) = Just ["false"]+  parseParam _net _ctx = \case     ["true"] -> Just $ NoCache True     ["false"] -> Just $ NoCache False     _ -> Nothing@@ -667,31 +733,31 @@  instance Param NoTx where   proxyLabel = const "notx"-  encodeParam net ctx (NoTx True) = Just ["true"]-  encodeParam net ctx (NoTx False) = Just ["false"]-  parseParam net ctx = \case+  encodeParam _net _ctx (NoTx True) = Just ["true"]+  encodeParam _net _ctx (NoTx False) = Just ["false"]+  parseParam _net _ctx = \case     ["true"] -> Just $ NoTx True     ["false"] -> Just $ NoTx False     _ -> Nothing  instance Param BlockHash where   proxyLabel = const "block"-  encodeParam net ctx b = Just [blockHashToHex b]-  parseParam net ctx [s] = hexToBlockHash s-  parseParam net ctx _ = Nothing+  encodeParam _net _ctx b = Just [blockHashToHex b]+  parseParam _net _ctx [s] = hexToBlockHash s+  parseParam _net _ctx _ = Nothing  instance Param [BlockHash] where   proxyLabel = const "blocks"-  encodeParam net ctx bs = Just $ blockHashToHex <$> bs-  parseParam net ctx = mapM hexToBlockHash+  encodeParam _net _ctx bs = Just $ blockHashToHex <$> bs+  parseParam _net _ctx = mapM hexToBlockHash  instance Param TxHash where   proxyLabel = const "txid"-  encodeParam net ctx t = Just [txHashToHex t]-  parseParam net ctx [s] = hexToTxHash s-  parseParam net ctx _ = Nothing+  encodeParam _net _ctx t = Just [txHashToHex t]+  parseParam _net _ctx [s] = hexToTxHash s+  parseParam _net _ctx _ = Nothing  instance Param [TxHash] where   proxyLabel = const "txids"-  encodeParam net ctx ts = Just $ txHashToHex <$> ts-  parseParam net ctx = mapM hexToTxHash+  encodeParam _net _ctx ts = Just $ txHashToHex <$> ts+  parseParam _net _ctx = mapM hexToTxHash
test/Haskoin/Store/DataSpec.hs view
@@ -1,130 +1,224 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE NamedFieldPuns #-}-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE TupleSections #-}-{-# LANGUAGE NoFieldSelectors #-}-{-# OPTIONS_GHC -fno-warn-orphans #-} -module Haskoin.Store.DataSpec (spec, arbitraryDeriveType) where+module Haskoin.Store.DataSpec (spec) where -import Control.Arrow (second) import Control.Monad (forM_)-import Data.Aeson (FromJSON (..), Value)+import Data.Aeson (Value) import Data.Aeson qualified as A+import Data.Aeson.KeyMap qualified as KeyMap import Data.ByteString qualified as B import Data.ByteString.Lazy qualified as BL import Data.Bytes.Put (runPutS)-import Data.Bytes.Serial (serialize)+import Data.Bytes.Serial (Serial, serialize)+import Data.HashMap.Strict qualified as HashMap import Data.IntMap qualified as IntMap-import Data.Maybe (fromJust, isJust)-import Data.String.Conversions (cs)+import Data.Maybe (fromJust)+import Data.Serialize qualified as S+import Data.Text (Text)+import Data.Text.Encoding (encodeUtf8) import Haskoin import Haskoin.Store.Data-import Haskoin.Util+import Haskoin.Store.Gen+import Haskoin.Store.Laws import Haskoin.Util.Arbitrary import Test.Hspec import Test.QuickCheck -identityTests :: Network -> Ctx -> IdentityTests-identityTests net ctx =-  IdentityTests-    { readTests = [],-      marshalTests = [],-      jsonTests =-        [ JsonBox (arbitrary :: Gen TxRef),-          JsonBox (arbitrary :: Gen BlockRef),-          JsonBox (arbitrary :: Gen Spender),-          JsonBox (arbitrary :: Gen XPubSummary),-          JsonBox (arbitrary :: Gen HealthCheck),-          JsonBox (arbitrary :: Gen Event),-          JsonBox (arbitrary :: Gen TxId),-          JsonBox (arbitrary :: Gen PeerInfo),-          JsonBox (arbitrary :: Gen (GenericResult XPubSummary)),-          JsonBox (arbitrary :: Gen (RawResult BlockData)),-          JsonBox (arbitrary :: Gen (RawResultList BlockData)),-          JsonBox (arbitrary :: Gen Except),-          JsonBox (arbitrary :: Gen BinfoWallet),-          JsonBox (arbitrary :: Gen BinfoSymbol),-          JsonBox (arbitrary :: Gen BinfoBlockInfo),-          JsonBox (arbitrary :: Gen BinfoInfo),-          JsonBox (arbitrary :: Gen BinfoSpender),-          JsonBox (arbitrary :: Gen BinfoRate),-          JsonBox (arbitrary :: Gen BinfoTicker),-          JsonBox (arbitrary :: Gen BinfoTxId),-          JsonBox (arbitrary :: Gen BinfoShortBal),-          JsonBox (arbitrary :: Gen BinfoHistory),-          JsonBox (arbitrary :: Gen BinfoHeader),-          JsonBox (arbitrary :: Gen BinfoBlockInfos)-        ],-      serialTests =-        [ SerialBox (arbitraryDeriveType net),-          SerialBox (arbitraryXPubSpec net ctx),-          SerialBox (arbitrary :: Gen BlockRef),-          SerialBox (arbitrary :: Gen TxRef),-          SerialBox (arbitraryBalance net),-          SerialBox (arbitraryUnspent net),-          SerialBox (arbitrary :: Gen BlockData),-          SerialBox (arbitraryStoreInput net),-          SerialBox (arbitrary :: Gen Spender),-          SerialBox (arbitraryStoreOutput net),-          SerialBox (arbitrary :: Gen Prev),-          SerialBox (arbitraryTxData ctx :: Gen TxData),-          SerialBox (arbitraryTransaction net),-          SerialBox (arbitraryXPubBal net),-          SerialBox (arbitraryXPubUnspent net),-          SerialBox (arbitrary :: Gen XPubSummary),-          SerialBox (arbitrary :: Gen HealthCheck),-          SerialBox (arbitrary :: Gen Event),-          SerialBox (arbitrary :: Gen TxId),-          SerialBox (arbitrary :: Gen PeerInfo),-          SerialBox (arbitrary :: Gen (GenericResult BlockData)),-          SerialBox (arbitrary :: Gen (RawResult BlockData)),-          SerialBox (arbitrary :: Gen (RawResultList BlockData))-        ],-      marshalJsonTests =-        [ MarshalJsonBox (withNet net arbitraryBalance),-          MarshalJsonBox (withNet net arbitraryStoreOutput),-          MarshalJsonBox (withNet net arbitraryUnspent),-          MarshalJsonBox (withNet net arbitraryXPubBal),-          MarshalJsonBox (withNet net arbitraryXPubUnspent),-          MarshalJsonBox (withNet net arbitraryStoreInput),-          MarshalJsonBox (withNet net arbitraryBlockData),-          MarshalJsonBox (withNet net arbitraryTransaction),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoMultiAddr),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoBalance),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoBlock),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoTx),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoTxInput),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoTxOutput),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoXPubPath),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoUnspent),-          MarshalJsonBox (withNetCtx net ctx (\net _ -> listOf $ arbitraryBinfoBlock net ctx)),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoRawAddr),-          MarshalJsonBox (withNetCtx net ctx arbitraryBinfoMempool)-        ]-    }+spec :: Spec+spec = prepareContext $ \ctx -> do+  describe "Binary encoding" $ do+    binaryLaws (arbitrary :: Gen BlockRef)+    binaryLaws (arbitrary :: Gen TxRef)+    binaryLaws (arbitrary :: Gen BlockData)+    binaryLaws (arbitrary :: Gen Spender)+    binaryLaws (arbitrary :: Gen Prev)+    binaryLaws (arbitraryTxData ctx)+    binaryLaws (arbitrary :: Gen XPubSummary)+    binaryLaws (arbitrary :: Gen HealthCheck)+    binaryLaws (arbitrary :: Gen Event)+    binaryLaws (arbitrary :: Gen TxId)+    binaryLaws (arbitrary :: Gen PeerInfo)+    binaryLaws (arbitrary :: Gen (GenericResult BlockData))+    binaryLaws (arbitrary :: Gen (RawResult BlockData))+    binaryLaws (arbitrary :: Gen (RawResultList BlockData))+    -- also covered inside the types below, but each has its own cereal and+    -- binary instances+    binaryLaws (anyNet arbitraryBalance)+    binaryLaws (anyNet arbitraryUnspent)+    binaryLaws (anyNet arbitraryStoreInput)+    binaryLaws (anyNet arbitraryStoreOutput)+    binaryLaws (anyNet arbitraryDeriveType)+    binaryLaws (anyNet (`arbitraryXPubSpec` ctx))+    binaryLaws (anyNet arbitraryXPubBal)+    binaryLaws (anyNet arbitraryXPubUnspent)+    binaryLaws (anyNet arbitraryTransaction) -withNetCtx :: Network -> Ctx -> (Network -> Ctx -> Gen a) -> Gen ((Network, Ctx), a)-withNetCtx net ctx g = do-  x <- g net ctx-  return ((net, ctx), x)+  describe "JSON" $ do+    jsonLaws (arbitrary :: Gen TxRef)+    jsonLaws (arbitrary :: Gen BlockRef)+    jsonLaws (arbitrary :: Gen Spender)+    jsonLaws (arbitrary :: Gen XPubSummary)+    jsonLaws (arbitrary :: Gen HealthCheck)+    jsonLaws (arbitrary :: Gen Event)+    jsonLaws (arbitrary :: Gen TxId)+    jsonLaws (arbitrary :: Gen PeerInfo)+    jsonLaws (arbitrary :: Gen (GenericResult XPubSummary))+    jsonLaws (arbitrary :: Gen (RawResult BlockData))+    jsonLaws (arbitrary :: Gen (RawResultList BlockData))+    jsonLaws (arbitrary :: Gen Except)+    jsonLaws (arbitrary :: Gen BinfoWallet)+    jsonLaws (arbitrary :: Gen BinfoSymbol)+    jsonLaws (arbitrary :: Gen BinfoBlockInfo)+    jsonLaws (arbitrary :: Gen BinfoInfo)+    jsonLaws (arbitrary :: Gen BinfoSpender)+    jsonLaws (arbitrary :: Gen BinfoRate)+    jsonLaws (arbitrary :: Gen BinfoTicker)+    jsonLaws (arbitrary :: Gen BinfoTxId)+    jsonLaws (arbitrary :: Gen BinfoShortBal)+    jsonLaws (arbitrary :: Gen BinfoHistory)+    jsonLaws (arbitrary :: Gen BinfoHeader)+    jsonLaws (arbitrary :: Gen BinfoBlockInfos) -withNet :: Network -> (Network -> Gen a) -> Gen (Network, a)-withNet net g = do-  x <- g net-  return (net, x)+  -- Balance, Unspent, StoreInput, StoreOutput and the inputs and outputs of+  -- BinfoTx are encoded through their own instances inside these.+  describe "JSON of a network" $ do+    let withCtx = (,ctx)+    marshalLaws id arbitraryXPubBal+    marshalLaws id arbitraryXPubUnspent+    marshalLaws id arbitraryBlockData+    marshalLaws id arbitraryTransaction+    marshalLaws withCtx (`arbitraryBinfoMultiAddr` ctx)+    marshalLaws withCtx (`arbitraryBinfoBalance` ctx)+    marshalLaws withCtx (`arbitraryBinfoBlock` ctx)+    marshalLaws withCtx (`arbitraryBinfoTx` ctx)+    marshalLaws withCtx (`arbitraryBinfoXPubPath` ctx)+    marshalLaws withCtx (`arbitraryBinfoUnspent` ctx)+    marshalLaws withCtx (`arbitraryBinfoRawAddr` ctx)+    marshalLaws withCtx (`arbitraryBinfoMempool` ctx) -spec :: Spec-spec = do-  forM_ allNets $ \net -> prepareContext (testIdentity . identityTests net)-  prepareContext $ \ctx -> describe "Coin instance of Unspent" $+  describe "Health check" $ do+    let bare =+          HealthCheck+            { blocks = BlockHealth 10 10 2,+              lastBlock = TimeHealth 5 100,+              lastTx = TimeHealth 5 100,+              pendingTxs = MaxHealth 0 100,+              peers = CountHealth 3 1,+              network = "btc",+              version = "1.9.0",+              time = 1700000000,+              redis = Nothing+            }+        without key = \case+          A.Object o -> A.Object (KeyMap.delete key o)+          v -> v+    it "reads what a store wrote before there was a check of Redis" $ do+      -- the check of Redis is the last byte, and its key in JSON+      let old = B.init (runPutS (serialize bare {redis = Just True}))+      S.decode old `shouldBe` Right bare+      A.fromJSON (without "redis" (A.toJSON bare {redis = Just False})) `shouldBe` A.Success bare+    it "is fit to serve without its Redis, and says that it is without" $ do+      isOK bare {redis = Just False} `shouldBe` True+      A.toJSON bare {redis = Just False} `shouldSatisfy` \case+        A.Object o -> KeyMap.lookup "redis" o == Just (A.object ["ok" A..= False])+        _ -> False+      A.toJSON bare `shouldSatisfy` \case+        A.Object o -> not (KeyMap.member "redis" o)+        _ -> False++  -- Other programs read these formats: they must not change by accident.+  describe "Wire format" $ do+    let txid = TxHash (sha256 B.empty)+        txidHex = "55b852781b9995a44c939b64e441ae2724b96f99c8f4fb9a141cfc9842c4b0e3"+        txidRaw = "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"+        burn = fromJust (textToAddr btc "1111111111111111111114oLvT2")+    wire (BlockRef 100 2) "{\"height\":100,\"position\":2}" "01ffffff9bfffffffd"+    wire (MemRef 1700000000) "{\"mempool\":1700000000}" "00ffffffff9aac0eff"+    wire (Spender txid 3) ("{\"txid\":\"" <> txidHex <> "\",\"input\":3}") (txidRaw <> "00000003")+    wire+      (TxRef (BlockRef 100 2) txid)+      ("{\"block\":{\"height\":100,\"position\":2},\"txid\":\"" <> txidHex <> "\"}")+      ("01ffffff9bfffffffd" <> txidRaw)+    it "Balance" $+      marshalValue btc (Balance burn 1 2 3 4 5)+        `shouldBe` json+          "{\"address\":\"1111111111111111111114oLvT2\",\"confirmed\":1,\+          \\"unconfirmed\":2,\"utxo\":3,\"txs\":4,\"received\":5}"+    it "XPubSummary" $+      A.toJSON XPubSummary {confirmed = 1, unconfirmed = 2, received = 3, utxo = 4, change = 5, external = 6}+        `shouldBe` json+          "{\"balance\":{\"confirmed\":1,\"unconfirmed\":2,\"received\":3,\"utxo\":4},\+          \\"indices\":{\"change\":5,\"external\":6}}"++  describe "Blockchain.info helpers" $ do+    it "reads its request parameters" $ do+      let h = TxHash (sha256 B.empty)+          b = BlockHash (sha256 B.empty)+      parseBinfoTxId (txHashToHex h) `shouldBe` Just (BinfoTxIdHash h)+      parseBinfoTxId "8011147086339971" `shouldBe` Just (BinfoTxIdIndex 8011147086339971)+      parseBinfoTxId "nonsense" `shouldBe` Nothing+      parseBinfoBlockId (blockHashToHex b) `shouldBe` Just (BinfoBlockHash b)+      parseBinfoBlockId "100" `shouldBe` Just (BinfoBlockIndex 100)+      map parseBinfoFilter ["0", "1", "2", "3", "4", "5", "6", "7"]+        `shouldBe` [ Just BinfoFilterAll,+                     Just BinfoFilterSent,+                     Just BinfoFilterReceived,+                     Just BinfoFilterMoved,+                     Nothing,+                     Just BinfoFilterConfirmed,+                     Just BinfoFilterAll,+                     Just BinfoFilterMempool+                   ]+      map parseBinfoDate ["09-11-2026", "09/11/2026", "2026-11-09"]+        `shouldBe` [Just (BinfoDate 1794182400), Just (BinfoDate 1794182400), Nothing]+    it "numbers a transaction by the first bits of its hash" $ do+      let h = TxHash (sha256 B.empty)+      encodeBinfoTxId False h `shouldBe` BinfoTxIdHash h+      encodeBinfoTxId True h `shouldBe` BinfoTxIdIndex 8011147086339971+    it "writes values as signed big-endian hexadecimal" $+      map binfoHexValue [0, 1, 127, 128, 255, 256, 65535]+        `shouldBe` ["00", "01", "7f", "0080", "00ff", "0100", "00ffff"]+    it "reads addresses and xpubs separated by bars or commas" $+      forAll (vectorOf 3 (arbitraryAddress btc)) $ \as ->+        forAll (arbitraryXPubKey ctx) $ \x ->+          let txt = mconcat [t <> sep | (a, sep) <- zip as ["|", ",", "|"], Just t <- [addrToText btc a]] <> xPubExport btc ctx x+           in parseBinfoAddr btc ctx txt `shouldBe` Just (map BinfoAddr as <> [BinfoXpub x])+    it "refuses anything that is neither an address nor an xpub" $+      parseBinfoAddr btc ctx "nonsense" `shouldBe` Nothing+    it "reads nothing from nothing" $+      parseBinfoAddr btc ctx "" `shouldBe` Just []+    it "gives the next indices of an xpub and counts only payments to it" $+      forAll (arbitraryXPubSpec btc ctx) $ \x ->+        forAll (vectorOf 3 (arbitraryAddress btc)) $ \as -> case as of+          [a1, a2, a3] ->+            let bal a r c = (zeroBalance a) {received = r, confirmed = c, txs = 1}+                xbals =+                  [ XPubBal [0, 4] (bal a1 100 60),+                    XPubBal [0, 1] (bal a2 50 0),+                    XPubBal [1, 2] (bal a3 30 30)+                  ]+             in case toBinfoAddrs HashMap.empty (HashMap.singleton x xbals) (HashMap.singleton x 7) of+                  [BinfoXPubBalance {..}] ->+                    (external, change, received, balance, sent, txs) `shouldBe` (5, 3, 150, 90, 60, 7)+                  bs -> expectationFailure ("not the balance of one xpub: " <> show bs)+          _ -> discard++  describe "Balances" $+    it "are null only when nothing ever touched the address" $+      forAll (arbitraryBalance btc) $ \b ->+        nullBalance b+          === (b.confirmed == 0 && b.unconfirmed == 0 && b.utxo == 0 && b.txs == 0 && b.received == 0)+          .&&. nullBalance (zeroBalance b.address)++  describe "Derivation types" $+    it "are named legacy, compat and segwit, and read normal as legacy" $ do+      map deriveTypeToText [DeriveNormal, DeriveP2SH, DeriveP2WPKH]+        `shouldBe` ["legacy", "compat", "segwit"]+      map textToDeriveType ["legacy", "normal", "compat", "segwit", "other", "Legacy"]+        `shouldBe` map Just [DeriveNormal, DeriveNormal, DeriveP2SH, DeriveP2WPKH]+          <> [Nothing, Nothing]++  describe "Coin instance of Unspent" $     it "reads the input kind from the output script" $       property $         forAll (arbitraryScriptOutput btc ctx) $ \so ->@@ -140,7 +234,7 @@                         address = Nothing                       }                in coinInputKind u `shouldBe` expectedKind so-  prepareContext $ \ctx -> describe "toTransaction" $ do+  describe "toTransaction" $ do     -- The JSON of the only output of a transaction that pays 1000 satoshi     -- to a script given in hex.     let outputJson net scriptHex =@@ -174,32 +268,25 @@                            fromIntegral (len witless * 3 + len td.tx),                            ws                          )-    it "gives a SegWit output its address on Bitcoin" $-      outputJson btc p2wpkh-        `shouldBe` [ json-                       "{\"address\":\"bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t4\",\-                       \\"pkscript\":\"0014751e76e8199196d454941c45d1b3a323f1433bd6\",\-                       \\"value\":1000,\"spent\":false,\"spender\":null}"-                   ]-    it "gives a SegWit-shaped output no address on Bitcoin Cash, which has no SegWit" $-      outputJson bch p2wpkh-        `shouldBe` [ json-                       "{\"address\":null,\-                       \\"pkscript\":\"0014751e76e8199196d454941c45d1b3a323f1433bd6\",\-                       \\"value\":1000,\"spent\":false,\"spender\":null}"-                   ]-    it "gives a 256-bit hash lock output no address on Bitcoin, which has no such address" $-      outputJson btc hashLock-        `shouldBe` [ json-                       "{\"address\":null,\-                       \\"pkscript\":\"aa20bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb87\",\-                       \\"value\":1000,\"spent\":false,\"spender\":null}"-                   ]+    -- an output has an address only where the network has that kind+    forM_+      [ ("a SegWit output an address on Bitcoin", btc, p2wpkh, "\"bc1qw508d6qejxtdg4y5r3zarvary0c5xw7kv8f3t4\""),+        ("a SegWit-shaped output no address on Bitcoin Cash", bch, p2wpkh, "null"),+        ("a 256-bit hash lock no address on Bitcoin", btc, hashLock, "null")+      ]+      $ \(what, net, script, addr) ->+        it ("gives " <> what) $+          outputJson net script+            `shouldBe` [ json+                           ( "{\"address\":"+                               <> addr+                               <> ",\"pkscript\":\""+                               <> BL.fromStrict (encodeUtf8 script)+                               <> "\",\"value\":1000,\"spent\":false,\"spender\":null}"+                           )+                       ]   where     z = sha256 B.empty-    -- Read a JSON literal.-    json :: BL.ByteString -> Value-    json = fromJust . A.decode     expectedKind = \case       PayPK {} -> InputPK       PayPKHash {} -> InputPKHash@@ -210,449 +297,13 @@       PayWitness 1 bs | B.length bs == 32 -> InputTaproot       _ -> InputPKHash -instance Arbitrary BlockRef where-  arbitrary =-    oneof [BlockRef <$> arbitrary <*> arbitrary, MemRef <$> arbitrary]--instance Arbitrary Prev where-  arbitrary = Prev <$> arbitraryBS1 <*> arbitrary--arbitraryTxData :: Ctx -> Gen TxData-arbitraryTxData ctx =-  TxData-    <$> arbitrary-    <*> arbitraryTx btc ctx-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary--arbitraryStoreInput :: Network -> Gen StoreInput-arbitraryStoreInput net = do-  store <--    oneof-      [ StoreCoinbase-          <$> arbitraryOutPoint-          <*> arbitrary-          <*> arbitraryBS1-          <*> listOf arbitraryBS1,-        StoreInput-          <$> arbitraryOutPoint-          <*> arbitrary-          <*> arbitraryBS1-          <*> arbitraryBS1-          <*> arbitrary-          <*> listOf arbitraryBS1-          <*> arbitraryMaybe (arbitraryAddress net)-      ]-  let res-        | net.segWit = store-        | otherwise = witless store-  return res-  where-    witless StoreInput {..} = StoreInput {witness = [], ..}-    witless StoreCoinbase {..} = StoreCoinbase {witness = [], ..}--instance Arbitrary Spender where-  arbitrary = Spender <$> arbitraryTxHash <*> arbitrary--arbitraryStoreOutput :: Network -> Gen StoreOutput-arbitraryStoreOutput net =-  StoreOutput-    <$> arbitrary-    <*> arbitraryBS1-    <*> arbitrary-    <*> arbitraryMaybe (arbitraryAddress net)--arbitraryTransaction :: Network -> Gen Transaction-arbitraryTransaction net =-  Transaction-    <$> arbitrary-    <*> arbitrary-    <*> arbitrary-    <*> listOf (arbitraryStoreInput net)-    <*> listOf (arbitraryStoreOutput net)-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary-    <*> arbitraryTxHash-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary--instance Arbitrary PeerInfo where-  arbitrary =-    PeerInfo-      <$> (cs <$> listOf arbitraryUnicodeChar)-      <*> listOf arbitraryPrintableChar-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary--instance Arbitrary BlockHealth where-  arbitrary =-    BlockHealth-      <$> arbitrary-      <*> arbitrary-      <*> arbitrary--instance Arbitrary TimeHealth where-  arbitrary =-    TimeHealth-      <$> arbitrary-      <*> arbitrary--instance Arbitrary CountHealth where-  arbitrary =-    CountHealth-      <$> arbitrary-      <*> arbitrary--instance Arbitrary MaxHealth where-  arbitrary =-    MaxHealth-      <$> arbitrary-      <*> arbitrary--instance Arbitrary HealthCheck where-  arbitrary =-    HealthCheck-      <$> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary--instance Arbitrary RejectCode where-  arbitrary =-    elements-      [ RejectMalformed,-        RejectInvalid,-        RejectObsolete,-        RejectDuplicate,-        RejectNonStandard,-        RejectDust,-        RejectInsufficientFee,-        RejectCheckpoint-      ]--arbitraryXPubSpec :: Network -> Ctx -> Gen XPubSpec-arbitraryXPubSpec net ctx = XPubSpec <$> arbitraryXPubKey ctx <*> arbitraryDeriveType net--arbitraryDeriveType :: Network -> Gen DeriveType-arbitraryDeriveType net =-  if net.segWit-    then elements [DeriveNormal, DeriveP2SH, DeriveP2WPKH]-    else return DeriveNormal--instance Arbitrary TxId where-  arbitrary = TxId <$> arbitraryTxHash--instance Arbitrary TxRef where-  arbitrary = TxRef <$> arbitrary <*> arbitraryTxHash--arbitraryBalance :: Network -> Gen Balance-arbitraryBalance net =-  Balance-    <$> arbitraryAddress net-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary-    <*> arbitrary--arbitraryUnspent :: Network -> Gen Unspent-arbitraryUnspent net =-  Unspent-    <$> arbitrary-    <*> arbitraryOutPoint-    <*> arbitrary-    <*> arbitraryBS1-    <*> arbitraryMaybe (arbitraryAddress net)--instance Arbitrary BlockData where-  arbitrary =-    BlockData-      <$> arbitrary-      <*> arbitrary-      <*> (fromInteger <$> suchThat arbitrary (0 <=))-      <*> arbitraryBlockHeader-      <*> arbitrary-      <*> arbitrary-      <*> listOf1 arbitraryTxHash-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary--arbitraryBlockData :: Network -> Gen BlockData-arbitraryBlockData net = do-  dat@BlockData {..} <- arbitrary-  return $ if net.segWit then dat else BlockData {weight = 0, ..}--instance (Arbitrary a) => Arbitrary (GenericResult a) where-  arbitrary = GenericResult <$> arbitrary--instance (Arbitrary a) => Arbitrary (RawResult a) where-  arbitrary = RawResult <$> arbitrary--instance (Arbitrary a) => Arbitrary (RawResultList a) where-  arbitrary = RawResultList <$> arbitrary--arbitraryXPubBal :: Network -> Gen XPubBal-arbitraryXPubBal net = XPubBal <$> arbitrary <*> arbitraryBalance net--arbitraryXPubUnspent :: Network -> Gen XPubUnspent-arbitraryXPubUnspent net = XPubUnspent <$> arbitraryUnspent net <*> arbitrary--instance Arbitrary XPubSummary where-  arbitrary =-    XPubSummary-      <$> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary--instance Arbitrary Event where-  arbitrary =-    oneof-      [ EventBlock <$> arbitraryBlockHash,-        EventTx <$> arbitraryTxHash-      ]--instance Arbitrary Except where-  arbitrary =-    oneof-      [ return ThingNotFound,-        return ServerError,-        return BadRequest,-        UserError <$> arbitrary,-        StringError <$> arbitrary,-        TxIndexConflict <$> listOf1 arbitraryTxHash,-        return ServerTimeout-      ]-------------------------------------------- Blockchain.info API Compatibility --------------------------------------------instance Arbitrary BinfoTxId where-  arbitrary =-    oneof-      [ BinfoTxIdHash <$> arbitraryTxHash,-        BinfoTxIdIndex <$> arbitrary-      ]--arbitraryBinfoMultiAddr :: Network -> Ctx -> Gen BinfoMultiAddr-arbitraryBinfoMultiAddr net ctx = do-  b <- arbitraryBinfoBalance net ctx-  let addresses = [b]-  wallet <- arbitrary-  txs <- listOf $ arbitraryBinfoTx net ctx-  info <- arbitrary-  recommendFee <- arbitrary-  let cashAddr = isJust net.cashAddrPrefix-  return BinfoMultiAddr {..}--arbitraryBinfoRawAddr :: Network -> Ctx -> Gen BinfoRawAddr-arbitraryBinfoRawAddr net ctx = do-  address <--    oneof-      [ BinfoAddr <$> arbitraryAddress net,-        BinfoXpub <$> arbitraryXPubKey ctx-      ]-  balance <- arbitrary-  ntx <- arbitrary-  utxo <- arbitrary-  received <- arbitrary-  sent <- arbitrary-  txs <- listOf $ arbitraryBinfoTx net ctx-  return $ BinfoRawAddr {..}--instance Arbitrary BinfoShortBal where-  arbitrary = BinfoShortBal <$> arbitrary <*> arbitrary <*> arbitrary--arbitraryBinfoBalance :: Network -> Ctx -> Gen BinfoBalance-arbitraryBinfoBalance net ctx = do-  address <- arbitraryAddress net-  txs <- arbitrary-  received <- arbitrary-  sent <- arbitrary-  balance <- arbitrary-  xpub <- arbitraryXPubKey ctx-  external <- arbitrary-  change <- arbitrary-  elements [BinfoAddrBalance {..}, BinfoXPubBalance {..}]--instance Arbitrary BinfoWallet where-  arbitrary = do-    balance <- arbitrary-    txs <- arbitrary-    filtered <- arbitrary-    received <- arbitrary-    sent <- arbitrary-    return BinfoWallet {..}--arbitraryBinfoBlock :: Network -> Ctx -> Gen BinfoBlock-arbitraryBinfoBlock net ctx = do-  hash <- arbitraryBlockHash-  version <- arbitrary-  prev <- arbitraryBlockHash-  merkle <- (.get) <$> arbitraryTxHash-  timestamp <- arbitrary-  bits <- arbitrary-  next <- listOf arbitraryBlockHash-  ntx <- arbitrary-  fee <- arbitrary-  nonce <- arbitrary-  size <- arbitrary-  index <- arbitrary-  main <- arbitrary-  height <- arbitrary-  weight <- arbitrary-  txs <- resize 5 $ listOf $ arbitraryBinfoTx net ctx-  return BinfoBlock {..}--arbitraryBinfoTx :: Network -> Ctx -> Gen BinfoTx-arbitraryBinfoTx net ctx = do-  txid <- arbitraryTxHash-  version <- arbitrary-  inputs <- resize 5 $ listOf1 $ arbitraryBinfoTxInput net ctx-  outputs <- resize 5 $ listOf1 $ arbitraryBinfoTxOutput net ctx-  let inputCount = fromIntegral $ length inputs-      outputCount = fromIntegral $ length outputs-  size <- arbitrary-  weight <- arbitrary-  fee <- arbitrary-  relayed <- cs <$> listOf arbitraryUnicodeChar-  locktime <- arbitrary-  index <- arbitrary-  doubleSpend <- arbitrary-  rbf <- arbitrary-  timestamp <- arbitrary-  blockIndex <- arbitrary-  blockHeight <- arbitrary-  balance <- arbitrary-  return BinfoTx {..}--arbitraryBinfoTxInput :: Network -> Ctx -> Gen BinfoTxInput-arbitraryBinfoTxInput net ctx = do-  sequence <- arbitrary-  witness <- B.pack <$> listOf arbitrary-  script <- B.pack <$> listOf arbitrary-  index <- arbitrary-  output <- arbitraryBinfoTxOutput net ctx-  return BinfoTxInput {..}--arbitraryBinfoTxOutput :: Network -> Ctx -> Gen BinfoTxOutput-arbitraryBinfoTxOutput net ctx = do-  typ <- arbitrary-  spent <- arbitrary-  value <- arbitrary-  index <- arbitrary-  txidx <- arbitrary-  script <- B.pack <$> listOf arbitrary-  spenders <- arbitrary-  address <- arbitraryMaybe (arbitraryAddress net)-  xpub <- arbitraryMaybe $ arbitraryBinfoXPubPath net ctx-  return BinfoTxOutput {..}--instance Arbitrary BinfoSpender where-  arbitrary = do-    txidx <- arbitrary-    input <- arbitrary-    return BinfoSpender {..}--arbitraryBinfoXPubPath :: Network -> Ctx -> Gen BinfoXPubPath-arbitraryBinfoXPubPath net ctx = do-  key <- arbitraryXPubKey ctx-  deriv <- arbitrarySoftPath-  return BinfoXPubPath {..}--instance Arbitrary BinfoInfo where-  arbitrary = do-    connected <- arbitrary-    conversion <- arbitrary-    fiat <- arbitrary-    crypto <- arbitrary-    head <- arbitrary-    return BinfoInfo {..}--instance Arbitrary BinfoBlockInfo where-  arbitrary = do-    hash <- arbitraryBlockHash-    height <- arbitrary-    timestamp <- arbitrary-    index <- arbitrary-    return BinfoBlockInfo {..}--instance Arbitrary BinfoSymbol where-  arbitrary = do-    code <- cs <$> listOf1 arbitraryUnicodeChar-    symbol <- cs <$> listOf1 arbitraryUnicodeChar-    name <- cs <$> listOf1 arbitraryUnicodeChar-    conversion <- arbitrary-    after <- arbitrary-    local <- arbitrary-    return BinfoSymbol {..}--instance Arbitrary BinfoRate where-  arbitrary = BinfoRate <$> arbitrary <*> arbitrary <*> arbitrary--instance Arbitrary BinfoTicker where-  arbitrary = do-    fifteen <- arbitrary-    sell <- arbitrary-    buy <- arbitrary-    last <- arbitrary-    symbol <- cs <$> listOf1 arbitraryUnicodeChar-    return BinfoTicker {..}--instance Arbitrary BinfoHistory where-  arbitrary = do-    date <- cs <$> listOf1 arbitraryUnicodeChar-    time <- cs <$> listOf1 arbitraryUnicodeChar-    typ <- cs <$> listOf1 arbitraryUnicodeChar-    amount <- arbitrary-    valueThen <- arbitrary-    valueNow <- arbitrary-    rateThen <- arbitrary-    txid <- arbitraryTxHash-    fee <- arbitrary-    return BinfoHistory {..}--arbitraryBinfoUnspent :: Network -> Ctx -> Gen BinfoUnspent-arbitraryBinfoUnspent net ctx = do-  txid <- arbitraryTxHash-  index <- arbitrary-  script <- B.pack <$> listOf arbitrary-  value <- arbitrary-  confirmations <- arbitrary-  txidx <- arbitrary-  xpub <- arbitraryMaybe $ arbitraryBinfoXPubPath net ctx-  return BinfoUnspent {..}--arbitraryBinfoUnspents :: Network -> Ctx -> Gen BinfoUnspents-arbitraryBinfoUnspents net ctx =-  fmap BinfoUnspents $ listOf $ arbitraryBinfoUnspent net ctx--instance Arbitrary BinfoHeader where-  arbitrary =-    BinfoHeader-      <$> arbitraryBlockHash-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary-      <*> arbitrary--arbitraryBinfoMempool :: Network -> Ctx -> Gen BinfoMempool-arbitraryBinfoMempool net ctx =-  fmap BinfoMempool $ listOf $ arbitraryBinfoTx net ctx+-- | A value has this JSON and these bytes.+wire :: (Show a, A.ToJSON a, Serial a) => a -> BL.ByteString -> Text -> Spec+wire x j h =+  it (takeWhile (/= ' ') (show x)) $ do+    A.toJSON x `shouldBe` json j+    encodeHex (runPutS (serialize x)) `shouldBe` h -instance Arbitrary BinfoBlockInfos where-  arbitrary = BinfoBlockInfos <$> arbitrary+-- | Read a JSON literal.+json :: BL.ByteString -> Value+json = fromJust . A.decode
+ test/Haskoin/Store/Gen.hs view
@@ -0,0 +1,499 @@+{-# LANGUAGE RecordWildCards #-}+{-# OPTIONS_GHC -Wno-orphans #-}++-- |+-- Generators of the data of the store, for property tests. Collections of+-- large values (transactions, blocks, inputs, outputs) are kept to three+-- elements: a round trip of one element tests the encoding as well as a round+-- trip of a hundred, and big values made the tests take minutes.+module Haskoin.Store.Gen+  ( small,+    small1,+    arbitraryTxData,+    arbitraryStoreInput,+    arbitraryStoreOutput,+    arbitraryTransaction,+    arbitraryXPubSpec,+    arbitraryDeriveType,+    arbitraryBalance,+    arbitraryUnspent,+    arbitraryBlockData,+    arbitraryXPubBal,+    arbitraryXPubUnspent,+    arbitraryBinfoMultiAddr,+    arbitraryBinfoRawAddr,+    arbitraryBinfoBalance,+    arbitraryBinfoBlock,+    arbitraryBinfoTx,+    arbitraryBinfoTxInput,+    arbitraryBinfoTxOutput,+    arbitraryBinfoXPubPath,+    arbitraryBinfoUnspent,+    arbitraryBinfoUnspents,+    arbitraryBinfoMempool,+  )+where++import Data.ByteString qualified as B+import Data.Maybe (isJust)+import Data.String.Conversions (cs)+import Haskoin+import Haskoin.Store.Data+import Haskoin.Util.Arbitrary+import Test.QuickCheck++-- | Up to three values.+small :: Gen a -> Gen [a]+small g = choose (0, 3) >>= (`vectorOf` g)++-- | One to three values.+small1 :: Gen a -> Gen [a]+small1 g = choose (1, 3) >>= (`vectorOf` g)++instance Arbitrary BlockRef where+  arbitrary =+    oneof [BlockRef <$> arbitrary <*> arbitrary, MemRef <$> arbitrary]++instance Arbitrary Prev where+  arbitrary = Prev <$> arbitraryBS1 <*> arbitrary++arbitraryTxData :: Ctx -> Gen TxData+arbitraryTxData ctx =+  TxData+    <$> arbitrary+    <*> arbitraryTx btc ctx+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++arbitraryStoreInput :: Network -> Gen StoreInput+arbitraryStoreInput net = do+  store <-+    oneof+      [ StoreCoinbase+          <$> arbitraryOutPoint+          <*> arbitrary+          <*> arbitraryBS1+          <*> listOf arbitraryBS1,+        StoreInput+          <$> arbitraryOutPoint+          <*> arbitrary+          <*> arbitraryBS1+          <*> arbitraryBS1+          <*> arbitrary+          <*> listOf arbitraryBS1+          <*> arbitraryMaybe (arbitraryAddress net)+      ]+  let res+        | net.segWit = store+        | otherwise = witless store+  return res+  where+    witless StoreInput {..} = StoreInput {witness = [], ..}+    witless StoreCoinbase {..} = StoreCoinbase {witness = [], ..}++instance Arbitrary Spender where+  arbitrary = Spender <$> arbitraryTxHash <*> arbitrary++arbitraryStoreOutput :: Network -> Gen StoreOutput+arbitraryStoreOutput net =+  StoreOutput+    <$> arbitrary+    <*> arbitraryBS1+    <*> arbitrary+    <*> arbitraryMaybe (arbitraryAddress net)++arbitraryTransaction :: Network -> Gen Transaction+arbitraryTransaction net =+  Transaction+    <$> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> small1 (arbitraryStoreInput net)+    <*> small1 (arbitraryStoreOutput net)+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitraryTxHash+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++instance Arbitrary PeerInfo where+  arbitrary =+    PeerInfo+      <$> (cs <$> listOf arbitraryUnicodeChar)+      <*> listOf arbitraryPrintableChar+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary++instance Arbitrary BlockHealth where+  arbitrary =+    BlockHealth+      <$> arbitrary+      <*> arbitrary+      <*> arbitrary++instance Arbitrary TimeHealth where+  arbitrary =+    TimeHealth+      <$> arbitrary+      <*> arbitrary++instance Arbitrary CountHealth where+  arbitrary =+    CountHealth+      <$> arbitrary+      <*> arbitrary++instance Arbitrary MaxHealth where+  arbitrary =+    MaxHealth+      <$> arbitrary+      <*> arbitrary++instance Arbitrary HealthCheck where+  arbitrary =+    HealthCheck+      <$> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary++instance Arbitrary RejectCode where+  arbitrary =+    elements+      [ RejectMalformed,+        RejectInvalid,+        RejectObsolete,+        RejectDuplicate,+        RejectNonStandard,+        RejectDust,+        RejectInsufficientFee,+        RejectCheckpoint+      ]++arbitraryXPubSpec :: Network -> Ctx -> Gen XPubSpec+arbitraryXPubSpec net ctx = XPubSpec <$> arbitraryXPubKey ctx <*> arbitraryDeriveType net++arbitraryDeriveType :: Network -> Gen DeriveType+arbitraryDeriveType net =+  if net.segWit+    then elements [DeriveNormal, DeriveP2SH, DeriveP2WPKH]+    else return DeriveNormal++instance Arbitrary TxId where+  arbitrary = TxId <$> arbitraryTxHash++instance Arbitrary TxRef where+  arbitrary = TxRef <$> arbitrary <*> arbitraryTxHash++arbitraryBalance :: Network -> Gen Balance+arbitraryBalance net =+  Balance+    <$> arbitraryAddress net+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary+    <*> arbitrary++arbitraryUnspent :: Network -> Gen Unspent+arbitraryUnspent net =+  Unspent+    <$> arbitrary+    <*> arbitraryOutPoint+    <*> arbitrary+    <*> arbitraryBS1+    <*> arbitraryMaybe (arbitraryAddress net)++instance Arbitrary BlockData where+  arbitrary =+    BlockData+      <$> arbitrary+      <*> arbitrary+      <*> (fromInteger <$> suchThat arbitrary (0 <=))+      <*> arbitraryBlockHeader+      <*> arbitrary+      <*> arbitrary+      <*> listOf1 arbitraryTxHash+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary++arbitraryBlockData :: Network -> Gen BlockData+arbitraryBlockData net = do+  dat@BlockData {..} <- arbitrary+  return $ if net.segWit then dat else BlockData {weight = 0, ..}++instance (Arbitrary a) => Arbitrary (GenericResult a) where+  arbitrary = GenericResult <$> arbitrary++instance (Arbitrary a) => Arbitrary (RawResult a) where+  arbitrary = RawResult <$> arbitrary++instance (Arbitrary a) => Arbitrary (RawResultList a) where+  arbitrary = RawResultList <$> arbitrary++arbitraryXPubBal :: Network -> Gen XPubBal+arbitraryXPubBal net = XPubBal <$> arbitrary <*> arbitraryBalance net++arbitraryXPubUnspent :: Network -> Gen XPubUnspent+arbitraryXPubUnspent net = XPubUnspent <$> arbitraryUnspent net <*> arbitrary++instance Arbitrary XPubSummary where+  arbitrary =+    XPubSummary+      <$> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary++instance Arbitrary Event where+  arbitrary =+    oneof+      [ EventBlock <$> arbitraryBlockHash,+        EventTx <$> arbitraryTxHash+      ]++instance Arbitrary Except where+  arbitrary =+    oneof+      [ return ThingNotFound,+        return ServerError,+        return BadRequest,+        UserError <$> arbitrary,+        StringError <$> arbitrary,+        TxIndexConflict <$> listOf1 arbitraryTxHash,+        return ServerTimeout+      ]++---------------------------------------+-- Blockchain.info API Compatibility --+---------------------------------------++instance Arbitrary BinfoTxId where+  arbitrary =+    oneof+      [ BinfoTxIdHash <$> arbitraryTxHash,+        BinfoTxIdIndex <$> arbitrary+      ]++arbitraryBinfoMultiAddr :: Network -> Ctx -> Gen BinfoMultiAddr+arbitraryBinfoMultiAddr net ctx = do+  b <- arbitraryBinfoBalance net ctx+  let addresses = [b]+  wallet <- arbitrary+  txs <- small (arbitraryBinfoTx net ctx)+  info <- arbitrary+  recommendFee <- arbitrary+  let cashAddr = isJust net.cashAddrPrefix+  return BinfoMultiAddr {..}++arbitraryBinfoRawAddr :: Network -> Ctx -> Gen BinfoRawAddr+arbitraryBinfoRawAddr net ctx = do+  address <-+    oneof+      [ BinfoAddr <$> arbitraryAddress net,+        BinfoXpub <$> arbitraryXPubKey ctx+      ]+  balance <- arbitrary+  ntx <- arbitrary+  utxo <- arbitrary+  received <- arbitrary+  sent <- arbitrary+  txs <- small (arbitraryBinfoTx net ctx)+  return $ BinfoRawAddr {..}++instance Arbitrary BinfoShortBal where+  arbitrary = BinfoShortBal <$> arbitrary <*> arbitrary <*> arbitrary++arbitraryBinfoBalance :: Network -> Ctx -> Gen BinfoBalance+arbitraryBinfoBalance net ctx = do+  address <- arbitraryAddress net+  txs <- arbitrary+  received <- arbitrary+  sent <- arbitrary+  balance <- arbitrary+  xpub <- arbitraryXPubKey ctx+  external <- arbitrary+  change <- arbitrary+  elements [BinfoAddrBalance {..}, BinfoXPubBalance {..}]++instance Arbitrary BinfoWallet where+  arbitrary = do+    balance <- arbitrary+    txs <- arbitrary+    filtered <- arbitrary+    received <- arbitrary+    sent <- arbitrary+    return BinfoWallet {..}++arbitraryBinfoBlock :: Network -> Ctx -> Gen BinfoBlock+arbitraryBinfoBlock net ctx = do+  hash <- arbitraryBlockHash+  version <- arbitrary+  prev <- arbitraryBlockHash+  merkle <- (.get) <$> arbitraryTxHash+  timestamp <- arbitrary+  bits <- arbitrary+  next <- small arbitraryBlockHash+  ntx <- arbitrary+  fee <- arbitrary+  nonce <- arbitrary+  size <- arbitrary+  index <- arbitrary+  main <- arbitrary+  height <- arbitrary+  weight <- arbitrary+  txs <- small (arbitraryBinfoTx net ctx)+  return BinfoBlock {..}++arbitraryBinfoTx :: Network -> Ctx -> Gen BinfoTx+arbitraryBinfoTx net ctx = do+  txid <- arbitraryTxHash+  version <- arbitrary+  inputs <- small1 (arbitraryBinfoTxInput net ctx)+  outputs <- small1 (arbitraryBinfoTxOutput net ctx)+  let inputCount = fromIntegral $ length inputs+      outputCount = fromIntegral $ length outputs+  size <- arbitrary+  weight <- arbitrary+  fee <- arbitrary+  relayed <- cs <$> listOf arbitraryUnicodeChar+  locktime <- arbitrary+  index <- arbitrary+  doubleSpend <- arbitrary+  rbf <- arbitrary+  timestamp <- arbitrary+  blockIndex <- arbitrary+  blockHeight <- arbitrary+  balance <- arbitrary+  return BinfoTx {..}++arbitraryBinfoTxInput :: Network -> Ctx -> Gen BinfoTxInput+arbitraryBinfoTxInput net ctx = do+  sequence <- arbitrary+  witness <- B.pack <$> listOf arbitrary+  script <- B.pack <$> listOf arbitrary+  index <- arbitrary+  output <- arbitraryBinfoTxOutput net ctx+  return BinfoTxInput {..}++arbitraryBinfoTxOutput :: Network -> Ctx -> Gen BinfoTxOutput+arbitraryBinfoTxOutput net ctx = do+  typ <- arbitrary+  spent <- arbitrary+  value <- arbitrary+  index <- arbitrary+  txidx <- arbitrary+  script <- B.pack <$> listOf arbitrary+  spenders <- arbitrary+  address <- arbitraryMaybe (arbitraryAddress net)+  xpub <- arbitraryMaybe $ arbitraryBinfoXPubPath net ctx+  return BinfoTxOutput {..}++instance Arbitrary BinfoSpender where+  arbitrary = do+    txidx <- arbitrary+    input <- arbitrary+    return BinfoSpender {..}++arbitraryBinfoXPubPath :: Network -> Ctx -> Gen BinfoXPubPath+arbitraryBinfoXPubPath _net ctx = do+  key <- arbitraryXPubKey ctx+  deriv <- arbitrarySoftPath+  return BinfoXPubPath {..}++instance Arbitrary BinfoInfo where+  arbitrary = do+    connected <- arbitrary+    conversion <- arbitrary+    fiat <- arbitrary+    crypto <- arbitrary+    head <- arbitrary+    return BinfoInfo {..}++instance Arbitrary BinfoBlockInfo where+  arbitrary = do+    hash <- arbitraryBlockHash+    height <- arbitrary+    timestamp <- arbitrary+    index <- arbitrary+    return BinfoBlockInfo {..}++instance Arbitrary BinfoSymbol where+  arbitrary = do+    code <- cs <$> listOf1 arbitraryUnicodeChar+    symbol <- cs <$> listOf1 arbitraryUnicodeChar+    name <- cs <$> listOf1 arbitraryUnicodeChar+    conversion <- arbitrary+    after <- arbitrary+    local <- arbitrary+    return BinfoSymbol {..}++instance Arbitrary BinfoRate where+  arbitrary = BinfoRate <$> arbitrary <*> arbitrary <*> arbitrary++instance Arbitrary BinfoTicker where+  arbitrary = do+    fifteen <- arbitrary+    sell <- arbitrary+    buy <- arbitrary+    last <- arbitrary+    symbol <- cs <$> listOf1 arbitraryUnicodeChar+    return BinfoTicker {..}++instance Arbitrary BinfoHistory where+  arbitrary = do+    date <- cs <$> listOf1 arbitraryUnicodeChar+    time <- cs <$> listOf1 arbitraryUnicodeChar+    typ <- cs <$> listOf1 arbitraryUnicodeChar+    amount <- arbitrary+    valueThen <- arbitrary+    valueNow <- arbitrary+    rateThen <- arbitrary+    txid <- arbitraryTxHash+    fee <- arbitrary+    return BinfoHistory {..}++arbitraryBinfoUnspent :: Network -> Ctx -> Gen BinfoUnspent+arbitraryBinfoUnspent net ctx = do+  txid <- arbitraryTxHash+  index <- arbitrary+  script <- B.pack <$> listOf arbitrary+  value <- arbitrary+  confirmations <- arbitrary+  txidx <- arbitrary+  xpub <- arbitraryMaybe $ arbitraryBinfoXPubPath net ctx+  return BinfoUnspent {..}++arbitraryBinfoUnspents :: Network -> Ctx -> Gen BinfoUnspents+arbitraryBinfoUnspents net ctx =+  BinfoUnspents <$> small (arbitraryBinfoUnspent net ctx)++instance Arbitrary BinfoHeader where+  arbitrary =+    BinfoHeader+      <$> arbitraryBlockHash+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary+      <*> arbitrary++arbitraryBinfoMempool :: Network -> Ctx -> Gen BinfoMempool+arbitraryBinfoMempool net ctx =+  BinfoMempool <$> small (arbitraryBinfoTx net ctx)++instance Arbitrary BinfoBlockInfos where+  arbitrary = BinfoBlockInfos <$> small arbitrary
+ test/Haskoin/Store/Laws.hs view
@@ -0,0 +1,76 @@+-- |+-- Laws that every encoding of the data of the store must obey, as specs that+-- take a generator. One line per type in a test table, instead of a block of+-- near-identical code per type and encoding.+--+-- Types whose encoding depends on the network get a random network for each+-- case ('anyNet'), so that every network is covered without running each law+-- once per network: the networks differ only in their address prefixes.+module Haskoin.Store.Laws+  ( anyNet,+    binaryLaws,+    jsonLaws,+    marshalLaws,+  )+where++import Data.Aeson (FromJSON, ToJSON, Value)+import Data.Aeson qualified as A+import Data.Aeson.Encoding (encodingToLazyByteString)+import Data.Aeson.Types (parseMaybe)+import Data.Binary (Binary)+import Data.Binary qualified as Binary+import Data.ByteString.Lazy qualified as BL+import Data.Bytes.Get (runGetS)+import Data.Bytes.Put (runPutS)+import Data.Bytes.Serial (Serial (..))+import Data.Proxy (Proxy (..))+import Data.Serialize (Serialize)+import Data.Serialize qualified as Cereal+import Data.Typeable (Typeable, typeRep)+import Haskoin (Network (..), allNets)+import Haskoin.Util (MarshalJSON (..))+import Test.Hspec (Spec)+import Test.Hspec.QuickCheck (prop)+import Test.QuickCheck (Gen, counterexample, elements, forAll, (.&&.), (===))++-- | Name of the type of a generator, for the description of a test.+name :: forall a. (Typeable a) => Gen a -> String+name _ = show (typeRep (Proxy @a))++-- | The value comes back from its bytes, and the three binary classes+-- ('Serial', cereal and binary) agree on the bytes.+binaryLaws :: forall a. (Eq a, Show a, Typeable a, Serial a, Serialize a, Binary a) => Gen a -> Spec+binaryLaws g = prop (name g) . forAll g $ \x ->+  let bytes = runPutS (serialize x)+   in runGetS deserialize bytes === Right x+        .&&. Cereal.encode x === bytes+        .&&. BL.toStrict (Binary.encode x) === bytes+        .&&. Cereal.decode bytes === Right x++-- | The value comes back from its JSON, and the fast encoder ('A.toEncoding')+-- writes the same JSON as 'A.toJSON': the two are written by hand and could+-- drift apart.+jsonLaws :: forall a. (Eq a, Show a, Typeable a, ToJSON a, FromJSON a) => Gen a -> Spec+jsonLaws g = prop (name g) . forAll g $ \x ->+  A.fromJSON (A.toJSON x) === A.Success x+    .&&. (A.decode (A.encode x) :: Maybe Value) === Just (A.toJSON x)++-- | A value of a random network.+anyNet :: (Network -> Gen a) -> Gen a+anyNet g = elements allNets >>= g++-- | Like 'jsonLaws', for JSON that depends on the network, which is random+-- for each case; @s@ is what the encoding takes, made from the network.+marshalLaws ::+  forall s a.+  (Eq a, Show a, Typeable a, MarshalJSON s a) =>+  (Network -> s) ->+  (Network -> Gen a) ->+  Spec+marshalLaws mk g = prop (name (g undefined)) . forAll (elements allNets) $ \net ->+  let s = mk net+   in counterexample net.name . forAll (g net) $ \x ->+        parseMaybe (unmarshalValue s) (marshalValue s x) === Just x+          .&&. (A.decode (encodingToLazyByteString (marshalEncoding s x)) :: Maybe Value)+            === Just (marshalValue s x)
test/Haskoin/Store/WebCommonSpec.hs view
@@ -1,76 +1,86 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE ExistentialQuantification #-}-{-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE NoFieldSelectors #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -Wno-orphans #-}  module Haskoin.Store.WebCommonSpec (spec) where -import Control.Monad (forM_)-import Data.Proxy+import Data.ByteString qualified as B+import Data.Maybe (fromJust)+import Data.Proxy (Proxy (..)) import Data.String.Conversions (cs)-import Data.Word+import Data.Text (Text)+import Data.Word (Word64) import Haskoin-import Haskoin.Store.Data-import Haskoin.Store.DataSpec (arbitraryDeriveType)+import Haskoin.Store.Data (DeriveType (..))+import Haskoin.Store.Gen (arbitraryDeriveType) import Haskoin.Store.WebCommon-import Haskoin.Util import Haskoin.Util.Arbitrary import Test.Hspec-import Test.Hspec.QuickCheck+import Test.Hspec.QuickCheck (prop) import Test.QuickCheck -data GenBox = forall p. (Show p, Eq p, Param p) => GenBox (Gen p)+spec :: Spec+spec = prepareContext $ \ctx -> do+  -- each case on a random network: they differ in their address prefixes+  describe "Parameters" $ do+    roundTrip ctx arbitraryAddress+    roundTrip ctx (listOf . arbitraryAddress)+    roundTrip ctx (const (arbitrary :: Gen StartParam))+    roundTrip ctx (const (arbitrarySizedNatural :: Gen OffsetParam))+    roundTrip ctx (const (arbitrarySizedNatural :: Gen LimitParam))+    roundTrip ctx (const (arbitrarySizedNatural :: Gen HeightParam))+    roundTrip ctx (const (arbitrary :: Gen HeightsParam))+    roundTrip ctx (const (arbitrarySizedNatural :: Gen TimeParam))+    roundTrip ctx (const (arbitraryXPubKey ctx))+    roundTrip ctx arbitraryDeriveType+    roundTrip ctx (const (NoCache <$> arbitrary))+    roundTrip ctx (const (NoTx <$> arbitrary))+    roundTrip ctx (const (listOf arbitraryBlockHash))+    roundTrip ctx (const (listOf arbitraryTxHash)) -params :: Network -> Ctx -> [GenBox]-params net ctx =-  [ GenBox (arbitraryAddress net),-    GenBox (listOf (arbitraryAddress net)),-    GenBox (arbitrary :: Gen StartParam),-    GenBox (arbitrarySizedNatural :: Gen OffsetParam),-    GenBox (arbitrarySizedNatural :: Gen LimitParam),-    GenBox (arbitrarySizedNatural :: Gen HeightParam),-    GenBox (arbitrary :: Gen HeightsParam),-    GenBox (arbitrarySizedNatural :: Gen TimeParam),-    GenBox (arbitraryXPubKey ctx :: Gen XPubKey),-    GenBox (arbitraryDeriveType net),-    GenBox (NoCache <$> arbitrary :: Gen NoCache),-    GenBox (NoTx <$> arbitrary :: Gen NoTx),-    GenBox arbitraryBlockHash,-    GenBox (listOf arbitraryBlockHash),-    GenBox arbitraryTxHash,-    GenBox (listOf arbitraryTxHash)-  ]+  describe "Start of a page" $ do+    it "is a transaction hash, a height up to 1230768000, or a later time" $ do+      parse ["1230768000"] `shouldBe` Just (StartParamHeight 1230768000)+      parse ["1230768001"] `shouldBe` Just (StartParamTime 1230768001)+      parse [txHashToHex z] `shouldBe` Just (StartParamHash z.get)+    it "refuses anything else" $+      parse ["yesterday"] `shouldBe` Nothing -spec :: Spec-spec = prepareContext $ \ctx -> forM_ allNets $ \net ->-  describe "Parameter encoding" $-    forM_ (params net ctx) $-      \(GenBox g) -> testParam net ctx g+  describe "Derivation" $+    it "is only normal on networks without SegWit" $ do+      encodeParam bch ctx DeriveP2WPKH `shouldBe` Nothing+      encodeParam btc ctx DeriveP2WPKH `shouldBe` Just ["segwit"] -testParam :: (Eq a, Show a, Param a) => Network -> Ctx -> Gen a -> Spec-testParam net ctx pGen =-  prop ("encodeParam/parseParam identity for parameter " <> name) $-    forAll pGen $ \p ->-      case encodeParam net ctx p of-        Just txts -> parseParam net ctx txts `shouldBe` Just p-        _ -> expectationFailure "Param encoding failed"+  describe "Paths" $ do+    let addr = fromJust (textToAddr btc "1111111111111111111114oLvT2")+        path :: (ApiResource a b) => a -> String+        path = cs . queryPath btc ctx+    it "of a block" $ do+      path (GetBlockBest (NoTx False)) `shouldBe` "/block/best"+      path (GetBlockHeight (HeightParam 5) (NoTx False)) `shouldBe` "/block/height/5"+    it "of a transaction" $+      path (GetTx z) `shouldBe` "/transaction/" <> cs (txHashToHex z)+    it "of an address" $+      path (GetAddrBalance addr) `shouldBe` "/address/1111111111111111111114oLvT2/balance"+    prop "of an xpub" $+      forAll (arbitraryXPubKey ctx) $ \x ->+        path (GetXPubBalances x DeriveNormal (NoCache False))+          `shouldBe` "/xpub/" <> cs (xPubExport btc ctx x) <> "/balances"   where-    name = cs $ proxyLabel $ proxy pGen-    proxy :: Gen a -> Proxy a-    proxy = const Proxy+    z = TxHash (sha256 B.empty)+    parse = parseParam btc undefined :: [Text] -> Maybe StartParam +-- | A parameter comes back from its encoding in a URL, on a random network.+roundTrip :: forall a. (Eq a, Show a, Param a) => Ctx -> (Network -> Gen a) -> Spec+roundTrip ctx g =+  prop (cs (proxyLabel (Proxy :: Proxy a))) . forAll (elements allNets) $ \net ->+    counterexample net.name . forAll (g net) $ \p ->+      (encodeParam net ctx p >>= parseParam net ctx) `shouldBe` Just p+ instance Arbitrary StartParam where   arbitrary =     oneof       [ StartParamHash <$> arbitraryHash256,-        StartParamHeight . fromIntegral-          <$> (choose (0, 1230768000) :: Gen Word64),-        StartParamTime . fromIntegral-          <$> (choose (1230768000, maxBound) :: Gen Word64)+        StartParamHeight . fromIntegral <$> (choose (0, 1230768000) :: Gen Word64),+        StartParamTime <$> choose (1230768001, maxBound)       ]  instance Arbitrary HeightsParam where