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