diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -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 -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 -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. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -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) diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,2 +0,0 @@ -import Distribution.Simple -main = defaultMain diff --git a/haskoin-store-data.cabal b/haskoin-store-data.cabal --- a/haskoin-store-data.cabal +++ b/haskoin-store-data.cabal @@ -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 +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 diff --git a/src/Haskoin/Store/Data.hs b/src/Haskoin/Store/Data.hs --- a/src/Haskoin/Store/Data.hs +++ b/src/Haskoin/Store/Data.hs @@ -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] diff --git a/src/Haskoin/Store/WebClient.hs b/src/Haskoin/Store/WebClient.hs --- a/src/Haskoin/Store/WebClient.hs +++ b/src/Haskoin/Store/WebClient.hs @@ -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. diff --git a/src/Haskoin/Store/WebCommon.hs b/src/Haskoin/Store/WebCommon.hs --- a/src/Haskoin/Store/WebCommon.hs +++ b/src/Haskoin/Store/WebCommon.hs @@ -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 diff --git a/test/Haskoin/Store/DataSpec.hs b/test/Haskoin/Store/DataSpec.hs --- a/test/Haskoin/Store/DataSpec.hs +++ b/test/Haskoin/Store/DataSpec.hs @@ -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 diff --git a/test/Haskoin/Store/Gen.hs b/test/Haskoin/Store/Gen.hs new file mode 100644 --- /dev/null +++ b/test/Haskoin/Store/Gen.hs @@ -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 diff --git a/test/Haskoin/Store/Laws.hs b/test/Haskoin/Store/Laws.hs new file mode 100644 --- /dev/null +++ b/test/Haskoin/Store/Laws.hs @@ -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) diff --git a/test/Haskoin/Store/WebCommonSpec.hs b/test/Haskoin/Store/WebCommonSpec.hs --- a/test/Haskoin/Store/WebCommonSpec.hs +++ b/test/Haskoin/Store/WebCommonSpec.hs @@ -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