haskoin-store 1.0.1 → 1.1.0

raw patch · 15 files changed

+3224/−5768 lines, 15 filesdep +statsd-ruppdep −ekg-coredep −ekg-statsddep −foldldep ~haskoin-store-dataPVP ok

version bump matches the API change (PVP)

Dependencies added: statsd-rupp

Dependencies removed: ekg-core, ekg-statsd, foldl, wai-extra

Dependency ranges changed: haskoin-store-data

API changes (from Hackage documentation)

Files

• CHANGELOG.md +0/−1764
• README.md +0/−57
• app/Main.hs +54/−75
• haskoin-store.cabal +10/−22
• src/Haskoin/Store/BlockStore.hs +57/−67
• src/Haskoin/Store/Cache.hs +216/−249
• src/Haskoin/Store/Common.hs +6/−45
• src/Haskoin/Store/Database/Reader.hs +106/−69
• src/Haskoin/Store/Database/Types.hs +1/−10
• src/Haskoin/Store/Database/Writer.hs +3/−23
• src/Haskoin/Store/Logic.hs +2/−6
• src/Haskoin/Store/Manager.hs +8/−12
• src/Haskoin/Store/Stats.hs +0/−209
• src/Haskoin/Store/Web.hs +2760/−3159
• test/Haskoin/StoreSpec.hs +1/−1

@@ -1,1764 +0,0 @@-# 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)--## [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.

@@ -1,57 +0,0 @@-# Haskoin Store--Block chain store and index featuring:--- Persistent storage using [RocksDB](https://rocksdb.org/).-- [Bitcoin Cash (BCH)](https://www.bitcoincash.org/) support.-- [Bitcoin Core (BTC)](https://bitcoin.org/) support.-- Indices for address balances, transactions, and unspent outputs (UTXO).-- Persistent mempool.-- Replace Bitcoin Core (BTC) RBF transactions by default.-- Query transactions, balances and UTXO on extended keys (xpub).-- Optional accelerated xpub cache using Redis.-- RESTful API with JSON and binary serialization.-- High performance concurrent architecture.-- Compatibility with Blockchain.info-style endpoints.--## Install with Nix on any distribution--* Get [Nix](https://nixos.org/nix/)--```sh-nix-env --install stack-git clone https://github.com/haskoin/haskoin-store.git-cd haskoin-store-stack --nix build --copy-bins-~/.local/bin/haskoin-store --help-```--## Install on Ubuntu or Debian--```sh-apt install git zlib1g-dev libsecp256k1-dev librocksdb-dev pkg-config haskell-stack-git clone https://github.com/haskoin/haskoin-store.git-cd haskoin-store-stack build --copy-bins-~/.local/bin/haskoin-store --help-```--## Install on Fedora--```sh-dnf install git zlib-devel libsecp256k1-devel rocksdb-devel stack-git clone https://github.com/haskoin/haskoin-store.git-cd haskoin-store-stack build --copy-bins-~/.local/bin/haskoin-store --help-```--## Non-Haskell Dependencies--* [zlib](https://zlib.net/)-* [libsecp256k1](https://github.com/Bitcoin-ABC/secp256k1)-* [RocksDB](https://github.com/facebook/rocksdb)--## API Documentation--* [Swagger API Documentation](https://api.haskoin.com/)

@@ -1,6 +1,7 @@ {-# LANGUAGE ApplicativeDo #-} {-# LANGUAGE CPP #-} {-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedRecordDot #-}@@ -10,10 +11,9 @@ {-# LANGUAGE TupleSections #-} {-# LANGUAGE NoFieldSelectors #-} -module Main where+module Main (main) where  import Control.Applicative ((<|>))-import Control.Arrow (second) import Control.Monad (when) import Control.Monad.Cont (ContT (ContT), runContT) import Control.Monad.Logger@@ -30,18 +30,9 @@ import Data.Maybe (fromMaybe) import Data.String.Conversions (cs) import Data.Text qualified as T-import Data.Word (Word32) import Haskoin   ( Network (..),     allNets,-    bch,-    bchRegTest,-    bchTest,-    bchTest4,-    btc,-    btcRegTest,-    btcTest,-    eitherToMaybe,     netByName,     withContext,   )@@ -50,15 +41,12 @@   ( StoreConfig (..),     WebConfig (..),     WebLimits (..),-    WebTimeouts (..),     runWeb,     withStore,   )-import Haskoin.Store.Stats (withStats) import Options.Applicative   ( Parser,     auto,-    eitherReader,     execParser,     flag,     fullDesc,@@ -79,7 +67,11 @@   ) import System.Exit (exitSuccess) import System.FilePath ((</>))-import System.IO.Unsafe (unsafePerformIO)+import System.Metrics.StatsD+    ( defStatConfig,+      withStats,+      StatConfig(statsdPort, statsdServer, namespace, reportSamples,+                 reportStats) ) import Text.Read (readMaybe) import UnliftIO (MonadIO) import UnliftIO.Directory@@ -88,12 +80,12 @@   ) import UnliftIO.Environment (lookupEnv) -version :: String+haskoinStoreVersion :: String  #ifdef CURRENT_PACKAGE_VERSION-version = CURRENT_PACKAGE_VERSION+haskoinStoreVersion = CURRENT_PACKAGE_VERSION #else-version = "Unavailable"+haskoinStoreVersion = "Unavailable" #endif  data Config = Config@@ -109,7 +101,6 @@     maxLaggingBlocks :: !Int,     minPeers :: !Int,     webLimits :: !WebLimits,-    webTimeouts :: !WebTimeouts,     redis :: !Bool,     redisURL :: !String,     redisMinAddrs :: !Int,@@ -125,6 +116,8 @@     statsdHost :: !String,     statsdPort :: !Int,     statsdPrefix :: !String,+    statsdNoEvents :: Bool,+    statsdAggregates :: Bool,     tickerRefresh :: !Int,     tickerURL :: !String,     priceHistoryURL :: !String,@@ -162,8 +155,6 @@     env "MIN_PEERS" 1 readMaybe   webLimits <-     getWebLimits-  webTimeouts <--    getWebTimeouts   redis <-     env "REDIS" False parseBool   redisURL <-@@ -192,6 +183,10 @@     env "STATSD_HOST" "localhost" pure   statsdPort <-     env "STATSD_PORT" 8125 readMaybe+  statsdNoEvents <-+    env "STATSD_NO_EVENTS" False parseBool+  statsdAggregates <-+    env "STATSD_AGGREGATES" False parseBool   statsdPrefix <-     getStatsdPrefix   tickerRefresh <-@@ -216,31 +211,24 @@       getAppUserDataDirectory "haskoin-store" >>= \d ->         env "DIR" d pure     getWebLimits = do-      let WebLimits {..} = def+      let d = def :: WebLimits       maxItemCount <--        env "MAX_ITEM_COUNT" maxItemCount readMaybe+        env "MAX_ITEM_COUNT" d.maxItemCount readMaybe       maxFullItemCount <--        env "MAX_FULL_ITEM_COUNT" maxFullItemCount readMaybe+        env "MAX_FULL_ITEM_COUNT" d.maxFullItemCount readMaybe       maxOffset <--        env "MAX_OFFSET" maxOffset readMaybe+        env "MAX_OFFSET" d.maxOffset readMaybe       defItemCount <--        env "DEF_ITEM_COUNT" defItemCount readMaybe+        env "DEF_ITEM_COUNT" d.defItemCount readMaybe       xpubGap <--        env "XPUB_GAP" xpubGap readMaybe+        env "XPUB_GAP" d.xpubGap readMaybe       xpubGapInit <--        env "XPUB_GAP_INIT" xpubGapInit readMaybe-      maxBodySize <--        env "MAX_BODY_SIZE" maxBodySize readMaybe-      requestTimeout <--        env "REQUEST_TIMEOUT" requestTimeout readMaybe+        env "XPUB_GAP_INIT" d.xpubGapInit readMaybe+      blockTimeout <-+        env "BLOCK_TIMEOUT" d.blockTimeout readMaybe+      txTimeout <-+        env "TX_TIMEOUT" d.txTimeout readMaybe       return WebLimits {..}-    getWebTimeouts = do-      let WebTimeouts {..} = def-      block <--        env "BLOCK_TIMEOUT" block readMaybe-      tx <--        env "TX_TIMEOUT" tx readMaybe-      return WebTimeouts {..}     getStatsdPrefix = do       let go = prefix <|> nomad           prefix =@@ -385,37 +373,21 @@           <> help "Max gap for empty xpubs"           <> showDefault           <> value c.webLimits.xpubGapInit-    maxBodySize <--      option auto $-        metavar "BYTES"-          <> long "max-body-size"-          <> help "Maximum request body size"-          <> showDefault-          <> value c.webLimits.maxBodySize-    requestTimeout <--      option auto $-        metavar "SECONDS"-          <> long "request-timeout"-          <> help "Web request timeout"-          <> showDefault-          <> value c.webLimits.requestTimeout-    return WebLimits {..}-  webTimeouts <- do-    block <-+    blockTimeout <-       option auto $         metavar "SECONDS"           <> long "block-timeout"           <> help "Block lag health timeout"           <> showDefault-          <> value c.webTimeouts.block-    tx <-+          <> value c.webLimits.blockTimeout+    txTimeout <-       option auto $         metavar "SECONDS"           <> long "tx-timeout"           <> help "Last tx received health timeout"           <> showDefault-          <> value c.webTimeouts.tx-    return WebTimeouts {..}+          <> value c.webLimits.txTimeout+    return WebLimits {..}   redis <-     flag c.redis True $       long "redis"@@ -505,6 +477,14 @@         <> help "Prefix for statsd metrics"         <> showDefault         <> value c.statsdPrefix+  statsdNoEvents <-+    flag c.statsdNoEvents True $+      long "statsd-no-events"+        <> help "Do not report individual events to statsd"+  statsdAggregates <-+    flag c.statsdAggregates True $+      long "statsd-aggregates"+        <> help "Send statistical aggregate reports to statsd every second"   tickerRefresh <-     option auto $       metavar "MICROSECONDS"@@ -549,15 +529,11 @@     Just net -> Right net     Nothing -> Left "Network name invalid" -peerReader :: String -> Either String String-peerReader "" = Left "Peer cannot be blank"-peerReader s = Right s- main :: IO () main = do   c <- execParser . opts =<< defConfig   when c.version $ do-    putStrLn version+    putStrLn haskoinStoreVersion     exitSuccess   if null c.peers && not c.discover     then run $ let Config {..} = c in Config {discover = True, ..}@@ -568,14 +544,14 @@         fullDesc           <> progDesc "Bitcoin (BCH & BTC) block chain index with HTTP API"           <> Options.Applicative.header-            ("haskoin-store version " <> version)+            ("haskoin-store version " <> haskoinStoreVersion)  run :: Config -> IO () run cfg =   withContext $ \ctx ->     runStderrLoggingT $ filterLogger l $ flip runContT return $ do-      stats <- ContT $ with_stats       net <- either error return $ networkReader cfg.net+      stats <- ContT $ with_stats net       let dir = cfg.dir </> net.name       $(logInfoS) "haskoin-store" $         "Creating working directory (if not found): " <> cs dir@@ -601,7 +577,7 @@                 peerTimeout = fromIntegral cfg.peerTimeout,                 maxPeerLife = fromIntegral cfg.maxPeerLife,                 connect = withConnection,-                statsStore = stats,+                stats = stats,                 redisSyncInterval = cfg.redisSyncInterval               }       lift $@@ -611,13 +587,12 @@               port = cfg.port,               store = store,               limits = cfg.webLimits,-              timeouts = cfg.webTimeouts,               maxPendingTxs = cfg.maxPendingTxs,               maxLaggingBlocks = cfg.maxLaggingBlocks,               minPeers = cfg.minPeers,-              version = version,+              version = haskoinStoreVersion,               noMempool = cfg.noMempool,-              statsStore = stats,+              stats = stats,               tickerRefresh = cfg.tickerRefresh,               tickerURL = cfg.tickerURL,               priceHistoryURL = cfg.priceHistoryURL,@@ -626,7 +601,7 @@               healthCheckInterval = cfg.healthCheckInterval             }   where-    with_stats go+    with_stats net go       | cfg.statsd = do           $(logInfoS) "Main" $             "Sending stats to "@@ -636,9 +611,13 @@               <> " with prefix: "               <> T.pack cfg.statsdPrefix           withStats-            (T.pack cfg.statsdHost)-            cfg.statsdPort-            (T.pack cfg.statsdPrefix)+            defStatConfig+              { statsdServer = cfg.statsdHost,+                statsdPort = cfg.statsdPort,+                namespace = cfg.statsdPrefix <> "." <> net.name,+                reportSamples = not cfg.statsdNoEvents,+                reportStats = cfg.statsdAggregates+              }             (go . Just)       | otherwise = go Nothing     l _ lvl

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           haskoin-store-version:        1.0.1+version:        1.1.0 synopsis:       Storage and index for Bitcoin and Bitcoin Cash description:    Please see the README on GitHub at <https://github.com/haskoin/haskoin-store#readme> category:       Bitcoin, Finance, Network@@ -17,9 +17,6 @@ license:        MIT license-file:   LICENSE build-type:     Simple-extra-source-files:-    README.md-    CHANGELOG.md  source-repository head   type: git@@ -36,12 +33,12 @@       Haskoin.Store.Database.Writer       Haskoin.Store.Logic       Haskoin.Store.Manager-      Haskoin.Store.Stats       Haskoin.Store.Web   other-modules:       Paths_haskoin_store   hs-source-dirs:       src+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints   build-depends:       aeson >=1.4.7.1     , aeson-pretty >=0.8.8@@ -54,14 +51,11 @@     , containers >=0.6.2.1     , data-default >=0.7.1.1     , deepseq >=1.4.4.0-    , ekg-core >=0.1.1.7-    , ekg-statsd >=0.2.5-    , foldl >=1.4.10     , hashable >=1.3.0.0     , hashtables >=1.2.4.2     , haskoin-core >=1.0.0     , haskoin-node >=1.0.0-    , haskoin-store-data ==1.0.1+    , haskoin-store-data ==1.1.0     , hedis >=0.12.13     , http-types >=0.12.3     , lens >=4.18.1@@ -74,6 +68,7 @@     , rocksdb-haskell-jprupp >=2.1.3     , rocksdb-query >=0.4.0     , scotty >=0.11.5+    , statsd-rupp >=0.4     , stm >=2.5.0.0     , string-conversions >=0.4.0.1     , text >=1.2.3.0@@ -83,7 +78,6 @@     , unordered-containers >=0.2.10.0     , vault >=0.3.1.5     , wai >=3.2.2.1-    , wai-extra >=3.1.6     , wai-websockets >=3.0.1.2     , warp >=3.3.10     , websockets >=0.12.4@@ -96,7 +90,7 @@       Paths_haskoin_store   hs-source-dirs:       app-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:       aeson >=1.4.7.1     , aeson-pretty >=0.8.8@@ -109,16 +103,13 @@     , containers >=0.6.2.1     , data-default >=0.7.1.1     , deepseq >=1.4.4.0-    , ekg-core >=0.1.1.7-    , ekg-statsd >=0.2.5     , filepath-    , foldl >=1.4.10     , hashable >=1.3.0.0     , hashtables >=1.2.4.2     , haskoin-core >=1.0.0     , haskoin-node >=1.0.0     , haskoin-store-    , haskoin-store-data ==1.0.1+    , haskoin-store-data ==1.1.0     , hedis >=0.12.13     , http-types >=0.12.3     , lens >=4.18.1@@ -132,6 +123,7 @@     , rocksdb-haskell-jprupp >=2.1.3     , rocksdb-query >=0.4.0     , scotty >=0.11.5+    , statsd-rupp >=0.4     , stm >=2.5.0.0     , string-conversions >=0.4.0.1     , text >=1.2.3.0@@ -141,7 +133,6 @@     , unordered-containers >=0.2.10.0     , vault >=0.3.1.5     , wai >=3.2.2.1-    , wai-extra >=3.1.6     , wai-websockets >=3.0.1.2     , warp >=3.3.10     , websockets >=0.12.4@@ -157,7 +148,7 @@       Paths_haskoin_store   hs-source-dirs:       test-  ghc-options: -threaded -rtsopts -with-rtsopts=-N+  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N   build-depends:       QuickCheck >=2.13.2     , aeson >=1.4.7.1@@ -172,15 +163,12 @@     , containers >=0.6.2.1     , data-default >=0.7.1.1     , deepseq >=1.4.4.0-    , ekg-core >=0.1.1.7-    , ekg-statsd >=0.2.5-    , foldl >=1.4.10     , hashable >=1.3.0.0     , hashtables >=1.2.4.2     , haskoin-core >=1.0.0     , haskoin-node >=1.0.0     , haskoin-store-    , haskoin-store-data ==1.0.1+    , haskoin-store-data ==1.1.0     , hedis >=0.12.13     , hspec >=2.7.1     , http-types >=0.12.3@@ -194,6 +182,7 @@     , rocksdb-haskell-jprupp >=2.1.3     , rocksdb-query >=0.4.0     , scotty >=0.11.5+    , statsd-rupp >=0.4     , stm >=2.5.0.0     , string-conversions >=0.4.0.1     , text >=1.2.3.0@@ -203,7 +192,6 @@     , unordered-containers >=0.2.10.0     , vault >=0.3.1.5     , wai >=3.2.2.1-    , wai-extra >=3.1.6     , wai-websockets >=3.0.1.2     , warp >=3.3.10     , websockets >=0.12.4

@@ -150,9 +150,9 @@     newMempoolTx,     revertBlock,   )-import Haskoin.Store.Stats import NQE-  ( Listen,+  ( InChan,+    Listen,     Mailbox,     Publisher,     inboxToMailbox,@@ -163,9 +163,7 @@     send,     sendSTM,   )-import System.Metrics qualified as Metrics-import System.Metrics.Gauge qualified as Metrics (Gauge)-import System.Metrics.Gauge qualified as Metrics.Gauge+import System.Metrics.StatsD import System.Random (randomRIO) import UnliftIO   ( Exception,@@ -229,69 +227,60 @@   }  data StoreMetrics = StoreMetrics-  { storeHeight :: !Metrics.Gauge,-    headersHeight :: !Metrics.Gauge,-    pendingTxs :: !Metrics.Gauge,-    connectedPeers :: !Metrics.Gauge,-    mempoolSize :: !Metrics.Gauge+  { blocks :: !StatGauge,+    headers :: !StatGauge,+    queuedTxs :: !StatGauge,+    peers :: !StatGauge,+    mempool :: !StatGauge   } -newStoreMetrics :: (MonadIO m) => Metrics.Store -> m StoreMetrics-newStoreMetrics s = liftIO $ do-  storeHeight <- g "blockchain.height"-  headersHeight <- g "blockchain.headers"-  pendingTxs <- g "mempool.pending_txs"-  connectedPeers <- g "network.peers_connected"-  mempoolSize <- g "mempool.size"-  return StoreMetrics {..}+newStoreMetrics :: (MonadIO m) => BlockStoreConfig -> m (Maybe StoreMetrics)+newStoreMetrics cfg =+  forM cfg.stats $ \s -> liftIO $ do+    m <- withDB cfg.db getMempool+    b <- fmap (maybe 0 (.height)) $ withDB cfg.db $ runMaybeT $+        MaybeT getBestBlock >>= MaybeT . getBlock+    h <- chainGetBest cfg.chain+    p <- getPeers cfg.peerMgr+    blocks <- g s "blocks" (fromIntegral b)+    headers <- g s "headers" (fromIntegral h.height)+    queuedTxs <- g s "queued_txs" 0+    peers <- g s "peers" (length p)+    mempool <- g s "mempool" (length m)+    return StoreMetrics {..}   where-    g x = Metrics.createGauge ("store." <> x) s+    g s x = newStatGauge s ("store." <> x)  setStoreHeight :: (MonadIO m) => BlockT m ()-setStoreHeight =-  asks (.metrics) >>= \case-    Nothing -> return ()-    Just m ->-      getBestBlock >>= \case-        Nothing -> setit m 0-        Just bb ->-          getBlock bb >>= \case-            Nothing -> setit m 0-            Just b -> setit m b.height-  where-    setit m i = liftIO $ m.storeHeight `Metrics.Gauge.set` fromIntegral i+setStoreHeight = void $ runMaybeT $ do+  m <- MaybeT (asks (.metrics))+  h <- MaybeT getBestBlock+  b <- MaybeT (getBlock h)+  setGauge m.blocks (fromIntegral b.height)  setHeadersHeight :: (MonadIO m) => BlockT m ()-setHeadersHeight =-  asks (.metrics) >>= \case-    Nothing -> return ()-    Just m -> do-      h <- fmap (.height) $ chainGetBest =<< asks (.config.chain)-      liftIO $ m.headersHeight `Metrics.Gauge.set` fromIntegral h+setHeadersHeight = void $ runMaybeT $ do+  m <- MaybeT (asks (.metrics))+  n <- chainGetBest =<< asks (.config.chain)+  setGauge m.headers (fromIntegral n.height)  setPendingTxs :: (MonadIO m) => BlockT m ()-setPendingTxs =-  asks (.metrics) >>= \case-    Nothing -> return ()-    Just m -> do-      s <- asks (.txs) >>= \t -> atomically (HashMap.size <$> readTVar t)-      liftIO $ m.pendingTxs `Metrics.Gauge.set` fromIntegral s+setPendingTxs = void $ runMaybeT $ do+  m <- MaybeT (asks (.metrics))+  p <- readTVarIO =<< asks (.txs)+  setGauge m.queuedTxs (HashMap.size p)  setPeersConnected :: (MonadIO m) => BlockT m ()-setPeersConnected =-  asks (.metrics) >>= \case-    Nothing -> return ()-    Just m -> do-      ps <- fmap length $ getPeers =<< asks (.config.peerMgr)-      liftIO $ m.connectedPeers `Metrics.Gauge.set` fromIntegral ps+setPeersConnected = void $ runMaybeT $ do+  m <- MaybeT (asks (.metrics))+  p <- getPeers =<< asks (.config.peerMgr)+  setGauge m.peers (length p)  setMempoolSize :: (MonadIO m) => BlockT m ()-setMempoolSize =-  asks (.metrics) >>= \case-    Nothing -> return ()-    Just m -> do-      s <- length <$> getMempool-      liftIO $ m.mempoolSize `Metrics.Gauge.set` fromIntegral s+setMempoolSize = void $ runMaybeT $ do+  m <- MaybeT (asks (.metrics))+  p <- lift getMempool+  setGauge m.mempool (length p)  -- | Configuration for a block store. data BlockStoreConfig = BlockStoreConfig@@ -314,7 +303,7 @@     syncMempool :: !Bool,     -- | disconnect syncing peer if inactive for this long     peerTimeout :: !NominalDiffTime,-    statsStore :: !(Maybe Metrics.Store)+    stats :: !(Maybe Stats)   }  type BlockT m = ReaderT BlockStore m@@ -391,7 +380,7 @@   ts <- newTVarIO HashMap.empty   rq <- newTVarIO HashSet.empty   inbox <- newInbox-  metrics <- mapM newStoreMetrics cfg.statsStore+  metrics <- newStoreMetrics cfg   let r =         BlockStore           { mailbox = inboxToMailbox inbox,@@ -442,6 +431,10 @@       withAsync (pingMe (inboxToMailbox inbox)) $ \a ->         link a >> runBlockStoreLoop inbox +runBlockStoreLoop ::+  (InChan mbox, MonadUnliftIO m, MonadLoggerIO m) =>+  mbox BlockStoreMessage ->+  ReaderT BlockStore m b runBlockStoreLoop inbox =   forever $ do     $(logDebugS) "BlockStore" "Waiting for new event..."@@ -470,8 +463,8 @@   s <- asks (.config.syncMempool)   when s f -mempool :: (MonadUnliftIO m, MonadLoggerIO m) => Peer -> BlockT m ()-mempool p =+requestMempool :: (MonadUnliftIO m, MonadLoggerIO m) => Peer -> BlockT m ()+requestMempool p =   guardMempool . syncMempool $     isInSync >>= \s -> when s $ do       $(logDebugS) "BlockStore" $@@ -529,7 +522,7 @@         False -> syncMe         True -> do           updateOrphans-          mempool peer+          requestMempool peer     failure e = do       $(logErrorS) "BlockStore" $         "Error importing block "@@ -633,7 +626,6 @@   atomically $ do     modifyTVar ts $ HashMap.insert th p     modifyTVar rq $ HashSet.delete th-    HashMap.size <$> readTVar ts   setPendingTxs   where     th = txHash p.tx@@ -765,9 +757,9 @@     new_mempool_tx = do       t <- newMempoolTx tx seconds       $(logInfoS) "BlockStore" $-        "Tx "+        bool "Already have" "Imported" t+          <> " tx "           <> txHashToHex (txHash tx)-          <> bool " was already imported" " imported" t       when t $ fulfillOrphans block_read tx_hash       return t @@ -797,9 +789,7 @@   unless (null txs) (import_txs block_read txs)   where     run_import block_read p =-      let t = p.tx-          h = txHash t-       in importMempoolTx block_read p.time p.tx+      importMempoolTx block_read p.time p.tx     import_txs block_read txs =       let r = mapM (run_import block_read) txs        in do@@ -1097,7 +1087,7 @@ trySyncingPeer :: (MonadUnliftIO m, MonadLoggerIO m) => Peer -> BlockT m () trySyncingPeer p =   isInSync >>= \case-    True -> mempool p+    True -> requestMempool p     False ->       trySetPeer p >>= \case         False -> return ()

@@ -37,46 +37,34 @@ where  import Control.DeepSeq (NFData)-import Control.Monad (forM, forM_, forever, guard, unless, void, when, (>=>))+import Control.Monad (forM, forM_, forever, unless, void, when) import Control.Monad.Logger   ( MonadLoggerIO,     logDebugS,     logErrorS,     logInfoS,-    logWarnS,   )-import Control.Monad.Reader (ReaderT (..), ask, asks)+import Control.Monad.Reader (ReaderT (..), asks) import Control.Monad.Trans (lift)-import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT)-import Data.Bits (complement, shift, (.&.), (.|.))+import Data.Bits (shift, (.&.), (.|.)) import Data.ByteString (ByteString)-import Data.ByteString qualified as B import Data.Default (def) import Data.Either (fromRight, isRight, rights) import Data.Functor ((<&>)) import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as HashMap-import Data.HashSet (HashSet) import Data.HashSet qualified as HashSet import Data.IntMap.Strict qualified as I import Data.List (sort) import Data.Map.Strict qualified as Map import Data.Maybe   ( catMaybes,-    fromMaybe,-    isJust,-    isNothing,     mapMaybe,   ) import Data.Serialize (Serialize, decode, encode) import Data.String.Conversions (cs) import Data.Text (Text)-import Data.Time.Clock (NominalDiffTime, diffUTCTime)-import Data.Time.Clock.System-  ( getSystemTime,-    systemSeconds,-    systemToUTCTime,-  )+import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Word (Word32, Word64) import Database.Redis   ( Connection,@@ -93,12 +81,10 @@     zrem,   ) import Database.Redis qualified as Redis-import Database.Redis qualified as Reids import GHC.Generics (Generic) import Haskoin   ( Address,     BlockHash,-    BlockHeader (..),     BlockNode (..),     Ctx,     DerivPathI (..),@@ -124,8 +110,6 @@   ) import Haskoin.Node   ( Chain,-    chainBlockMain,-    chainGetAncestor,     chainGetBest,     chainGetBlock,     chainGetParents,@@ -133,49 +117,35 @@   ) import Haskoin.Store.Common import Haskoin.Store.Data-import Haskoin.Store.Stats+import Haskoin.Store.Database.Reader (DatabaseReader, withDB) import NQE   ( Inbox,     Listen,     Mailbox,-    inboxToMailbox,     query,     receive,     send,   )-import System.Metrics qualified as Metrics-import System.Metrics.Counter qualified as Metrics (Counter)-import System.Metrics.Counter qualified as Metrics.Counter-import System.Metrics.Distribution qualified as Metrics (Distribution)-import System.Metrics.Distribution qualified as Metrics.Distribution-import System.Metrics.Gauge qualified as Metrics (Gauge)-import System.Metrics.Gauge qualified as Metrics.Gauge-import System.Random (randomIO, randomRIO)+import System.Metrics.StatsD import UnliftIO   ( Exception,     MonadIO,     MonadUnliftIO,-    TQueue,-    TVar,     atomically,     bracket,     liftIO,-    link,-    modifyTVar,-    newTVarIO,-    readTQueue,-    readTVar,     throwIO,-    wait,     withAsync,-    writeTQueue,-    writeTVar,   ) import UnliftIO.Concurrent (threadDelay)  runRedis :: (MonadLoggerIO m) => Redis (Either Reply a) -> CacheX m a runRedis action = do   conn <- asks (.redis)+  withRedis conn action++withRedis :: (MonadLoggerIO m) => Connection -> Redis (Either Reply a) -> m a+withRedis conn action =   liftIO (Redis.runRedis conn action) >>= \case     Right x -> return x     Left e -> do@@ -191,64 +161,69 @@   }  data CacheMetrics = CacheMetrics-  { cacheHits :: !Metrics.Counter,-    cacheMisses :: !Metrics.Counter,-    lockAcquired :: !Metrics.Counter,-    lockReleased :: !Metrics.Counter,-    lockFailed :: !Metrics.Counter,-    xPubBals :: !Metrics.Counter,-    xPubUnspents :: !Metrics.Counter,-    xPubTx :: !Metrics.Counter,-    xPubTxCount :: !Metrics.Counter,-    indexTime :: !StatDist+  { hits :: !StatCounter,+    misses :: !StatCounter,+    lockAcquired :: !StatCounter,+    lockReleased :: !StatCounter,+    lockFailed :: !StatCounter,+    xBalances :: !StatCounter,+    xUnspents :: !StatCounter,+    xTxs :: !StatCounter,+    xTxCount :: !StatCounter,+    indexTime :: !StatTiming,+    height :: !StatGauge   } -newCacheMetrics :: (MonadIO m) => Metrics.Store -> m CacheMetrics-newCacheMetrics s = liftIO $ do-  cacheHits <- c "cache.hits"-  cacheMisses <- c "cache.misses"+newCacheMetrics ::+  (MonadLoggerIO m) =>+  Stats ->+  Connection ->+  DatabaseReader ->+  m CacheMetrics+newCacheMetrics s r db = do+  h <- redisBest+  hits <- c "cache.hits"+  misses <- c "cache.misses"   lockAcquired <- c "cache.lock_acquired"   lockReleased <- c "cache.lock_released"   lockFailed <- c "cache.lock_failed"   indexTime <- d "cache.index"-  xPubBals <- c "cache.xpub_balances_cached"-  xPubUnspents <- c "cache.xpub_unspents_cached"-  xPubTx <- c "cache.xpub_txs_cached"-  xPubTxCount <- c "cache.xpub_tx_count_cached"+  xBalances <- c "cache.xpub_balances"+  xUnspents <- c "cache.xpub_unspents"+  xTxs <- c "cache.xpub_txs"+  xTxCount <- c "cache.xpub_tx_count"+  height <- newStatGauge s "cache.height" h   return CacheMetrics {..}   where-    c x = Metrics.createCounter x s-    d x = createStatDist x s+    redisBest =+      maybe dbBest dbBlock =<< withRedis r redisGetHead+    dbBlock h =+      maybe 0 (fromIntegral . (.height)) <$> withDB db (getBlock h)+    dbBest =+      maybe (return 0) dbBlock =<< withDB db getBestBlock+    c x = newStatCounter s x 10+    d x = newStatTiming s x 10 -withMetrics ::+withTiming ::   (MonadUnliftIO m) =>-  (CacheMetrics -> StatDist) ->+  (CacheMetrics -> StatTiming) ->   CacheX m a ->   CacheX m a-withMetrics df go =+withTiming df go =   asks (.metrics) >>= \case     Nothing -> go     Just m ->       bracket-        (systemToUTCTime <$> liftIO getSystemTime)+        time         (end m)         (const go)   where-    end metrics t1 = do-      t2 <- systemToUTCTime <$> liftIO getSystemTime-      let diff = round $ diffUTCTime t2 t1 * 1000-      df metrics `addStatTime` diff-      addStatQuery (df metrics)+    time = round . (* 1000) <$> liftIO getPOSIXTime+    end m t1 = time >>= addTiming (df m) . subtract t1 -incrementCounter ::-  (MonadIO m) =>-  (CacheMetrics -> Metrics.Counter) ->-  Int ->-  CacheX m ()-incrementCounter f i =-  asks (.metrics) >>= \case-    Just s -> liftIO $ Metrics.Counter.add (f s) (fromIntegral i)-    Nothing -> return ()+withMetrics ::+  (MonadIO m) => (CacheMetrics -> CacheX m a) -> CacheX m ()+withMetrics go = asks (.metrics) >>= mapM_ go  type CacheT = ReaderT (Maybe CacheConfig) @@ -271,7 +246,22 @@   liftIO (checkedConnect conninfo)  instance-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>+  (MonadUnliftIO m, StoreReadBase m) =>+  StoreReadBase (CacheX m)+  where+  getCtx = lift getCtx+  getNetwork = lift getNetwork+  getBestBlock = lift getBestBlock+  getBlocksAtHeight = lift . getBlocksAtHeight+  getBlock = lift . getBlock+  getTxData = lift . getTxData+  getSpender = lift . getSpender+  getBalance = lift . getBalance+  getUnspent = lift . getUnspent+  getMempool = lift getMempool++instance+  (MonadUnliftIO m, StoreReadBase m) =>   StoreReadBase (CacheT m)   where   getCtx = lift getCtx@@ -287,6 +277,23 @@  instance   (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>+  StoreReadExtra (CacheX m)+  where+  getBalances = lift . getBalances+  getAddressesTxs addrs = lift . getAddressesTxs addrs+  getAddressTxs addr = lift . getAddressTxs addr+  getAddressUnspents addr = lift . getAddressUnspents addr+  getAddressesUnspents addrs = lift . getAddressesUnspents addrs+  getMaxGap = lift getMaxGap+  getInitialGap = lift getInitialGap+  getNumTxData = lift . getNumTxData+  xPubTxs = getXPubTxs+  xPubTxCount = getXPubTxCount+  xPubBals = getXPubBalances+  xPubUnspents = getXPubUnspents++instance+  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>   StoreReadExtra (CacheT m)   where   getBalances = lift . getBalances@@ -298,39 +305,23 @@   getInitialGap = lift getInitialGap   getNumTxData = lift . getNumTxData   xPubBals xpub =-    ask >>= \case-      Nothing ->-        lift $-          xPubBals xpub-      Just cfg ->-        lift $-          runReaderT (getXPubBalances xpub) cfg+    ReaderT $ \case+      Nothing -> xPubBals xpub+      Just cfg -> runReaderT (xPubBals xpub) cfg   xPubUnspents xpub xbals limits =-    ask >>= \case-      Nothing ->-        lift $-          xPubUnspents xpub xbals limits-      Just cfg ->-        lift $-          runReaderT (getXPubUnspents xpub xbals limits) cfg+    ReaderT $ \case+      Nothing -> xPubUnspents xpub xbals limits+      Just cfg -> runReaderT (xPubUnspents xpub xbals limits) cfg   xPubTxs xpub xbals limits =-    ask >>= \case-      Nothing ->-        lift $-          xPubTxs xpub xbals limits-      Just cfg ->-        lift $-          runReaderT (getXPubTxs xpub xbals limits) cfg+    ReaderT $ \case+      Nothing -> xPubTxs xpub xbals limits+      Just cfg -> runReaderT (xPubTxs xpub xbals limits) cfg   xPubTxCount xpub xbals =-    ask >>= \case-      Nothing ->-        lift $-          xPubTxCount xpub xbals-      Just cfg ->-        lift $-          runReaderT (getXPubTxCount xpub xbals) cfg+    ReaderT $ \case+      Nothing -> xPubTxCount xpub xbals+      Just cfg -> runReaderT (xPubTxCount xpub xbals) cfg -withCache :: (StoreReadBase m) => Maybe CacheConfig -> CacheT m a -> m a+withCache :: Maybe CacheConfig -> CacheT m a -> m a withCache s f = runReaderT f s  balancesPfx :: ByteString@@ -353,40 +344,41 @@   CacheX m [TxRef] getXPubTxs xpub xbals limits = go False   where-    go m =-      isXPubCached xpub >>= \c ->-        if c-          then do-            txs <- cacheGetXPubTxs xpub limits-            incrementCounter (.xPubTx) (length txs)-            return txs-          else do-            if m-              then lift $ xPubTxs xpub xbals limits-              else do-                newXPubC xpub xbals-                go True+    go recursed = do+      cached <- isXPubCached recursed xpub+      if cached+        then do+          txs <- cacheGetXPubTxs xpub limits+          withMetrics $ \s ->+            incrementCounter s.xTxs (length txs)+          return txs+        else do+          if recursed+            then lift $ xPubTxs xpub xbals limits+            else do+              newXPubC xpub xbals+              go True  getXPubTxCount ::   (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>   XPubSpec ->   [XPubBal] ->   CacheX m Word32-getXPubTxCount xpub xbals =-  go False+getXPubTxCount xpub xbals = go False   where-    go t =-      isXPubCached xpub >>= \c ->-        if c-          then do-            incrementCounter (.xPubTxCount) 1-            cacheGetXPubTxCount xpub-          else do-            if t-              then lift $ xPubTxCount xpub xbals-              else do-                newXPubC xpub xbals-                go True+    go recursed = do+      cached <- isXPubCached recursed xpub+      if cached+        then do+          withMetrics $ \s ->+            incrementCounter s.xTxCount 1+          cacheGetXPubTxCount xpub+        else do+          if recursed+            then lift $ xPubTxCount xpub xbals+            else do+              newXPubC xpub xbals+              go True  getXPubUnspents ::   (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>@@ -397,70 +389,69 @@ getXPubUnspents xpub xbals limits =   go False   where-    xm =-      let f x = (x.balance.address, x)-          g = (> 0) . (.balance.utxo)-       in HashMap.fromList $ map f $ filter g xbals-    go m =-      isXPubCached xpub >>= \c ->-        if c-          then do-            process-          else do-            if m-              then lift $ xPubUnspents xpub xbals limits-              else do-                newXPubC xpub xbals-                go True-    process = do-      ops <- map snd <$> cacheGetXPubUnspents xpub limits-      uns <- catMaybes <$> lift (mapM getUnspent ops)-      ctx <- lift getCtx-      let f u =-            either-              (const Nothing)-              (\a -> Just (a, u))-              (scriptToAddressBS ctx u.script)-          g a = HashMap.lookup a xm-          h u x =-            XPubUnspent-              { unspent = u,-                path = x.path-              }-          us = mapMaybe f uns-          i a u = h u <$> g a-      incrementCounter (.xPubUnspents) (length us)-      return $ mapMaybe (uncurry i) us+    go recursed = do+      cached <- isXPubCached recursed xpub+      if cached+        then do+          ops <- map snd <$> cacheGetXPubUnspents xpub limits+          uns <- catMaybes <$> lift (mapM getUnspent ops)+          ctx <- lift getCtx+          let f u =+                either+                  (const Nothing)+                  (\a -> Just (a, u))+                  (scriptToAddressBS ctx u.script)+              xm =+                let j x = (x.balance.address, x)+                    k = (> 0) . (.balance.utxo)+                 in HashMap.fromList $ map j $ filter k xbals+              g a = HashMap.lookup a xm+              h u x =+                XPubUnspent+                  { unspent = u,+                    path = x.path+                  }+              us = mapMaybe f uns+              i a u = h u <$> g a+          withMetrics $ \s -> incrementCounter s.xUnspents (length us)+          return $ mapMaybe (uncurry i) us+        else do+          if recursed+            then lift $ xPubUnspents xpub xbals limits+            else do+              newXPubC xpub xbals+              go True  getXPubBalances ::   (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>   XPubSpec ->   CacheX m [XPubBal]-getXPubBalances xpub =-  isXPubCached xpub >>= \c ->-    if c-      then do-        xbals <- cacheGetXPubBalances xpub-        incrementCounter (.xPubBals) (length xbals)-        return xbals-      else do-        bals <- lift $ xPubBals xpub-        newXPubC xpub bals-        return bals+getXPubBalances xpub = do+  cached <- isXPubCached False xpub+  if cached+    then do+      xbals <- cacheGetXPubBalances xpub+      withMetrics $ \s -> incrementCounter s.xBalances (length xbals)+      return xbals+    else do+      bals <- lift $ xPubBals xpub+      newXPubC xpub bals+      return bals  isInCache :: (MonadLoggerIO m) => XPubSpec -> CacheT m Bool isInCache xpub =-  ask >>= \case+  ReaderT $ \case     Nothing -> return False-    Just cfg -> runReaderT (isXPubCached xpub) cfg+    Just cfg -> runReaderT (isXPubCached True xpub) cfg -isXPubCached :: (MonadLoggerIO m) => XPubSpec -> CacheX m Bool-isXPubCached xpub =-  runRedis (redisIsXPubCached xpub) >>= \c -> do-    if c-      then incrementCounter (.cacheHits) 1-      else incrementCounter (.cacheMisses) 1-    return c+isXPubCached :: (MonadLoggerIO m) => Bool -> XPubSpec -> CacheX m Bool+isXPubCached silent xpub = do+  cached <- runRedis (redisIsXPubCached xpub)+  unless silent $ withMetrics $ \s ->+    if cached+      then incrementCounter s.hits 1+      else incrementCounter s.misses 1+  return cached  redisIsXPubCached :: (RedisCtx m f) => XPubSpec -> m (f Bool) redisIsXPubCached xpub = Redis.exists (balancesPfx <> encode xpub)@@ -472,7 +463,7 @@   return bals  cacheGetXPubTxCount ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>+  (MonadUnliftIO m, MonadLoggerIO m) =>   XPubSpec ->   CacheX m Word32 cacheGetXPubTxCount xpub = do@@ -666,8 +657,8 @@     return       [ (k, v)         | (k', v') <- xs,-          let Right k = decode k',-          let Right v = decode v'+          let k = fromRight undefined $ decode k',+          let v = fromRight undefined $ decode v'       ]  data CacheWriterMessage@@ -723,28 +714,28 @@   go >>= \case     Right Redis.Ok -> do       $(logDebugS) "Cache" "Acquired lock"-      incrementCounter (.lockAcquired) 1+      withMetrics $ \s -> incrementCounter s.lockAcquired 1       return True     Right Redis.Pong -> do       $(logErrorS)         "Cache"         "Unexpected pong when acquiring lock"-      incrementCounter (.lockFailed) 1+      withMetrics $ \s -> incrementCounter s.lockFailed 1       return False     Right (Redis.Status s) -> do       $(logErrorS) "Cache" $         "Unexpected status acquiring lock: " <> cs s-      incrementCounter (.lockFailed) 1+      withMetrics $ \m -> incrementCounter m.lockFailed 1       return False     Left (Redis.Bulk Nothing) -> do       $(logDebugS) "Cache" "Lock already taken"-      incrementCounter (.lockFailed) 1+      withMetrics $ \s -> incrementCounter s.lockFailed 1       return False     Left e -> do       $(logErrorS)         "Cache"         "Error when trying to acquire lock"-      incrementCounter (.lockFailed) 1+      withMetrics $ \s -> incrementCounter s.lockFailed 1       throwIO (RedisError e)   where     go = do@@ -786,37 +777,19 @@       threadDelay (150 * 1000 * 1000)       refreshLock -isFull ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  CacheX m Bool-isFull = do-  x <- asks (.maxKeys)-  s <- runRedis Redis.dbsize-  return $ s > x- pruneDB ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  CacheX m Integer+  (MonadLoggerIO m, StoreReadBase m) => CacheX m () pruneDB = do-  x <- asks (((`div` 10) . (* 8)) . (.maxKeys))-  -- Prune to 80% of max+  x <- asks (.maxKeys)   s <- runRedis Redis.dbsize-  if s > x then flush (s - x) else return 0-  where-    flush n =-      case n `div` 64 of-        0 -> return 0-        x -> do-          ks <--            fmap (map fst) . runRedis $-              getFromSortedSet maxKey Nothing 0 (fromIntegral x)-          $(logDebugS) "Cache" $-            "Pruning " <> cs (show (length ks)) <> " old xpubs"-          delXPubKeys ks+  $(logDebugS) "Cache" "Pruning old xpubs"+  when (s > x) $+    void . delXPubKeys . map fst+      =<< runRedis (getFromSortedSet maxKey Nothing 0 32)  touchKeys :: (MonadLoggerIO m) => [XPubSpec] -> CacheX m () touchKeys xpubs = do-  now <- systemSeconds <$> liftIO getSystemTime+  now <- round <$> liftIO getPOSIXTime :: (MonadIO m) => m Int   runRedis $ redisTouchKeys now xpubs  redisTouchKeys :: (Monad f, RedisCtx m f, Real a) => a -> [XPubSpec] -> m (f ())@@ -853,7 +826,7 @@ newXPubC xpub xbals =   should_index >>= \i -> when i $     bracket set_index unset_index $ \j -> when j $-      withMetrics (.indexTime) $ do+      withTiming (.indexTime) $ do         xpubtxt <- xpubText xpub         $(logDebugS) "Cache" $           "Caching "@@ -877,7 +850,7 @@             <> ": "             <> cs (show (length xtxs))             <> " txs"-        now <- systemSeconds <$> liftIO getSystemTime+        now <- round <$> liftIO getPOSIXTime :: (MonadIO m) => m Int         runRedis $ do           b <- redisTouchKeys now [xpub]           c <- redisAddXPubBalances xpub xbals@@ -893,7 +866,7 @@           then             inSync >>= \s ->               if s-                then not <$> isFull+                then pruneDB >> return True                 else return False           else return False     key = idxPfx <> encode xpub@@ -910,7 +883,7 @@       liftIO (Redis.runRedis conn red) <&> isRight  inSync ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadExtra m) =>+  (MonadUnliftIO m, StoreReadExtra m) =>   CacheX m Bool inSync =   lift getBestBlock >>= \case@@ -983,7 +956,7 @@           <> cs (show (length tds))           <> " transactions from block "           <> blockHashToHex bh-      cacheSetHead bh+      cacheSetHead bd     Nothing -> do       $(logErrorS) "Cache" $         "Could not get block: "@@ -1016,7 +989,7 @@       <> " outputs"   unspentmap <- getunspents ctx   gap <- lift getMaxGap-  now <- systemSeconds <$> liftIO getSystemTime+  now <- round <$> liftIO getPOSIXTime :: (MonadIO m) => m Int   let xpubs = allxpubsls addrmap   forM_ (zip [(1 :: Int) ..] xpubs) $ \(i, xpub) -> do     xpubtxt <- xpubText xpub@@ -1266,16 +1239,16 @@ cacheGetMempool :: (MonadLoggerIO m) => CacheX m [(UnixTime, TxHash)] cacheGetMempool = runRedis redisGetMempool -cacheIsInMempool :: (MonadLoggerIO m) => TxHash -> CacheX m Bool-cacheIsInMempool = runRedis . redisIsInMempool- cacheGetHead :: (MonadLoggerIO m) => CacheX m (Maybe BlockHash) cacheGetHead = runRedis redisGetHead -cacheSetHead :: (MonadLoggerIO m, StoreReadBase m) => BlockHash -> CacheX m ()-cacheSetHead bh = do+cacheSetHead :: (MonadLoggerIO m, StoreReadBase m) => BlockData -> CacheX m ()+cacheSetHead bd = do   $(logDebugS) "Cache" $ "Cache head set to: " <> blockHashToHex bh   void $ runRedis (redisSetHead bh)+  withMetrics $ \s -> setGauge s.height (fromIntegral bd.height)+  where+    bh = headerHash bd.header  cacheGetAddrsInfo ::   (MonadLoggerIO m) => [Address] -> CacheX m [Maybe AddressXPub]@@ -1289,10 +1262,6 @@       (\btx -> (blockRefScore btx.block, encode btx.txid))       btxs -redisIsInMempool :: (Applicative f, RedisCtx m f) => TxHash -> m (f Bool)-redisIsInMempool txid =-  fmap isJust <$> Redis.zrank mempoolSetKey (encode txid)- redisRemFromMempool ::   (Applicative f, RedisCtx m f) => [TxHash] -> m (f Integer) redisRemFromMempool [] = return (pure 0)@@ -1303,7 +1272,7 @@ redisSetAddrInfo a i = void <$> Redis.set (addrPfx <> encode a) (encode i)  cacheDelXPubs ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>+  (MonadLoggerIO m, StoreReadBase m) =>   [XPubSpec] ->   CacheT m Integer cacheDelXPubs xpubs = ReaderT $ \case@@ -1311,7 +1280,7 @@   Nothing -> return 0  delXPubKeys ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>+  (MonadLoggerIO m, StoreReadBase m) =>   [XPubSpec] ->   CacheX m Integer delXPubKeys [] = return 0@@ -1414,10 +1383,10 @@   | null fbals =       []   | not haschange =-      zipWith f (addrs ctx) list-        <> zipWith f (changeaddrs ctx) changelist+      zipWith f addrs list+        <> zipWith f changeaddrs changelist   | otherwise =-      zipWith f (addrs ctx) list+      zipWith f addrs list   where     haschange = any ((== 1) . head . (.path)) xbals     f a p = (a, AddressXPub {spec = xpub, path = p})@@ -1431,12 +1400,12 @@         then [maxidx + 1 .. aidx + gap]         else []     paths = map (Deriv :/ dchain :/) ixs-    keys ctx = map (\p -> derivePubPath ctx p xpub.key)+    keys = map (\p -> derivePubPath ctx p xpub.key)     list = map pathToList paths-    xpubf ctx = xPubAddrFunction ctx xpub.deriv-    addrs ctx = map (xpubf ctx) (keys ctx paths)+    xpubf = xPubAddrFunction ctx xpub.deriv+    addrs = map xpubf (keys paths)     changepaths = map (Deriv :/ 1 :/) [0 .. gap - 1]-    changeaddrs ctx = map (xpubf ctx) (keys ctx changepaths)+    changeaddrs = map xpubf (keys changepaths)     changelist = map pathToList changepaths  sortTxData :: [TxData] -> [TxData]@@ -1484,9 +1453,7 @@     f t s = ((scoreBlockRef s).timestamp, t)  xpubText ::-  ( MonadUnliftIO m,-    MonadLoggerIO m,-    StoreReadBase m+  ( StoreReadBase m   ) =>   XPubSpec ->   CacheX m Text

@@ -19,7 +19,6 @@     StoreWrite (..),     StoreEvent (..),     PubExcept (..),-    DataMetrics (..),     getActiveBlock,     getActiveTxData,     getDefaultBalance,@@ -41,7 +40,6 @@     microseconds,     streamThings,     joinDescStreams,-    createDataMetrics,   ) where @@ -57,7 +55,6 @@   ) import Control.DeepSeq (NFData) import Control.Exception (Exception)-import Control.Monad (forM) import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Control.Monad.Trans.Reader (runReaderT)@@ -65,12 +62,8 @@ import Data.Default (Default (..)) import Data.HashSet qualified as H import Data.Hashable (Hashable)-import Data.IntMap.Strict (IntMap)-import Data.IntMap.Strict qualified as I-import Data.List (sortOn) import Data.Map.Strict qualified as Map-import Data.Maybe (catMaybes, mapMaybe)-import Data.Ord (Down (..))+import Data.Maybe (mapMaybe) import Data.Serialize (Serialize (..)) import Data.Time.Clock.System   ( getSystemTime,@@ -99,9 +92,6 @@     toTransaction,     zeroBalance,   )-import System.Metrics qualified as Metrics-import System.Metrics.Counter (Counter)-import System.Metrics.Counter qualified as Counter import UnliftIO (MonadIO, liftIO)  type DeriveAddr = XPubKey -> KeyIndex -> Address@@ -111,8 +101,8 @@ type Limit = Word32  data Start-  = AtTx {atTxHash :: !TxHash}-  | AtBlock {atBlockHeight :: !BlockHeight}+  = AtTx !TxHash+  | AtBlock !BlockHeight   deriving (Eq, Show)  data Limits = Limits@@ -214,13 +204,13 @@     rx = sum [b.balance.received | b <- xt]  getTransaction ::-  (Monad m, StoreReadBase m) => TxHash -> m (Maybe Transaction)+  ( StoreReadBase m) =>TxHash -> m (Maybe Transaction) getTransaction h = do   ctx <- getCtx   fmap (toTransaction ctx) <$> getTxData h  getNumTransaction ::-  (Monad m, StoreReadExtra m) => Word64 -> m [Transaction]+  ( StoreReadExtra m) =>Word64 -> m [Transaction] getNumTransaction i =   getCtx >>= \ctx ->     map (toTransaction ctx) <$> getNumTxData i@@ -341,7 +331,7 @@             then go ((i, tx) : orphans) ths xs             else (i, tx) : go orphans (txHash tx `H.delete` ths) xs -nub' :: (Eq a, Hashable a) => [a] -> [a]+nub' :: (Hashable a) => [a] -> [a] nub' = H.toList . H.fromList  microseconds :: (MonadIO m) => m Integer@@ -398,32 +388,3 @@         let mp2 = Map.deleteMax mp             mp' = Map.unionWith (++) mp1 mp2         go (Just x) mp'--data DataMetrics = DataMetrics-  { dataBestCount :: !Counter,-    dataBlockCount :: !Counter,-    dataTxCount :: !Counter,-    dataMempoolCount :: !Counter,-    dataBalanceCount :: !Counter,-    dataUnspentCount :: !Counter,-    dataAddrTxCount :: !Counter,-    dataXPubBals :: !Counter,-    dataXPubUnspents :: !Counter,-    dataXPubTxs :: !Counter,-    dataXPubTxCount :: !Counter-  }--createDataMetrics :: (MonadIO m) => Metrics.Store -> m DataMetrics-createDataMetrics s = liftIO $ do-  dataBestCount <- Metrics.createCounter "data.best_block" s-  dataBlockCount <- Metrics.createCounter "data.blocks" s-  dataTxCount <- Metrics.createCounter "data.txs" s-  dataMempoolCount <- Metrics.createCounter "data.mempool" s-  dataBalanceCount <- Metrics.createCounter "data.balances" s-  dataUnspentCount <- Metrics.createCounter "data.unspents" s-  dataAddrTxCount <- Metrics.createCounter "data.address_txs" s-  dataXPubBals <- Metrics.createCounter "data.xpub_balances" s-  dataXPubUnspents <- Metrics.createCounter "data.xpub_unspents" s-  dataXPubTxs <- Metrics.createCounter "data.xpub_txs" s-  dataXPubTxCount <- Metrics.createCounter "data.xpub_tx_count" s-  return DataMetrics {..}

@@ -5,12 +5,16 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-} {-# LANGUAGE NoFieldSelectors #-}  module Haskoin.Store.Database.Reader   ( -- * RocksDB Database Access     DatabaseReader (..),     DatabaseReaderT,+    DataMetrics,+    withDB,+    createDataMetrics,     withDatabaseReader,     addrTxCF,     addrOutCF,@@ -24,28 +28,25 @@  import Conduit   ( ConduitT,-    dropC,     dropWhileC,     lift,     mapC,     runConduit,     sinkList,-    takeC,     (.|),   ) import Control.Monad.Except (runExceptT, throwError)-import Control.Monad.Reader (ReaderT, ask, asks, runReaderT)+import Control.Monad.Reader (MonadReader, ReaderT, asks, runReaderT) import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import Data.Bits ((.&.)) import Data.ByteString qualified as BS import Data.Default (def)-import Data.Function (on) import Data.IntMap.Strict qualified as IntMap import Data.List (sortOn) import Data.Maybe (fromMaybe) import Data.Ord (Down (..)) import Data.Serialize (encode)-import Data.Word (Word32, Word64)+import Data.Word (Word32) import Database.RocksDB   ( ColumnFamily,     Config (..),@@ -63,23 +64,11 @@     retrieveCF,   ) import Haskoin-  ( Address,-    BlockHash,-    BlockHeight,-    Ctx,-    Network,-    OutPoint (..),-    TxHash,-    pubSubKey,-    txHash,-  ) import Haskoin.Store.Common import Haskoin.Store.Data import Haskoin.Store.Database.Types-import System.Metrics qualified as Metrics-import System.Metrics.Counter (Counter)-import System.Metrics.Counter qualified as Counter-import UnliftIO (MonadIO, MonadUnliftIO, liftIO)+import System.Metrics.StatsD+import UnliftIO (MonadIO, MonadUnliftIO, bracket_, liftIO)  type DatabaseReaderT = ReaderT DatabaseReader @@ -92,19 +81,48 @@     ctx :: !Ctx   } -incrementCounter ::-  (MonadIO m) =>-  (DataMetrics -> Counter) ->-  Int ->-  ReaderT DatabaseReader m ()-incrementCounter f i =-  asks (.metrics) >>= \case-    Just s -> liftIO $ Counter.add (f s) (fromIntegral i)-    Nothing -> return ()+data DataMetrics = DataMetrics+  { dataBestCount :: !StatCounter,+    dataBlockCount :: !StatCounter,+    dataTxCount :: !StatCounter,+    dataMempoolCount :: !StatCounter,+    dataBalanceCount :: !StatCounter,+    dataUnspentCount :: !StatCounter,+    dataAddrTxCount :: !StatCounter,+    dataXPubBals :: !StatCounter,+    dataXPubUnspents :: !StatCounter,+    dataXPubTxs :: !StatCounter,+    dataXPubTxCount :: !StatCounter,+    dataIters :: !StatGauge+  } +createDataMetrics :: (MonadIO m) => Stats -> m DataMetrics+createDataMetrics s = do+  dataBestCount <- newStatCounter s "db.best_block" n+  dataBlockCount <- newStatCounter s "db.blocks" n+  dataTxCount <- newStatCounter s "db.txs" n+  dataMempoolCount <- newStatCounter s "db.mempool" n+  dataBalanceCount <- newStatCounter s "db.balances" n+  dataUnspentCount <- newStatCounter s "db.unspents" n+  dataAddrTxCount <- newStatCounter s "db.address_txs" n+  dataXPubBals <- newStatCounter s "db.xpub_balances" n+  dataXPubUnspents <- newStatCounter s "db.xpub_unspents" n+  dataXPubTxs <- newStatCounter s "db.xpub_txs" n+  dataXPubTxCount <- newStatCounter s "db.xpub_tx_count" n+  dataIters <- newStatGauge s "db.iterators" 0+  return DataMetrics {..}+  where+    n = 10++withMetrics :: (MonadReader DatabaseReader m) => (DataMetrics -> m a) -> m ()+withMetrics go = asks (.metrics) >>= mapM_ go+ dataVersion :: Word32 dataVersion = 18 +withDB :: DatabaseReader -> DatabaseReaderT m a -> m a+withDB = flip runReaderT+ withDatabaseReader ::   (MonadUnliftIO m) =>   Network ->@@ -129,7 +147,7 @@     initRocksDB bdb     runReaderT f bdb   where-    cfg = def {createIfMissing = True, maxFiles = Just (-1)}+    cfg = def {createIfMissing = True}  columnFamilyConfig :: [(String, Config)] columnFamilyConfig =@@ -204,10 +222,9 @@           Just TxData {block = b@BlockRef {}} ->             matchingSkip it (AddrTxKeyA a) (AddrTxKeyB a b)           Just TxData {block = MemRef {}} ->-            let cond (AddrTxKey _a (TxRef MemRef {} th)) =-                  th /= txh-                cond (AddrTxKey _a (TxRef BlockRef {} _th)) =-                  False+            let cond (AddrTxKey _ (TxRef MemRef {} th)) = th /= txh+                cond (AddrTxKey _ (TxRef BlockRef {} _)) = False+                cond _ = undefined              in matching it (AddrTxKeyA a)                   .| (dropWhileC (cond . fst) >> mapC id)           Nothing -> return ()@@ -235,25 +252,35 @@           Just TxData {block = b@BlockRef {}} ->             matchingSkip it (AddrOutKeyA a) (AddrOutKeyB a b)           Just TxData {block = MemRef {}} ->-            let cond (AddrOutKey _a MemRef {} p) =-                  p.hash /= txh-                cond (AddrOutKey _a BlockRef {} _p) =-                  False+            let cond (AddrOutKey _ MemRef {} p) = p.hash /= txh+                cond (AddrOutKey _ BlockRef {} _) = False+                cond _ = undefined              in matching it (AddrOutKeyA a)                   .| (dropWhileC (cond . fst) >> mapC id)           Nothing -> return () +withIterCFStat ::+  (MonadUnliftIO m) =>+  DB ->+  ColumnFamily ->+  (Iterator -> DatabaseReaderT m a) ->+  DatabaseReaderT m a+withIterCFStat db cf = bracket_ open close . withIterCF db cf+  where+    open = asks (.metrics) >>= mapM_ (\m -> incrementGauge m.dataIters 1)+    close = asks (.metrics) >>= mapM_ (\m -> decrementGauge m.dataIters 1)+ withManyIters ::   (MonadUnliftIO m) =>   DB ->   ColumnFamily ->   Int ->-  ([Iterator] -> m a) ->-  m a+  ([Iterator] -> DatabaseReaderT m a) ->+  DatabaseReaderT m a withManyIters db cf i f = go [] i   where     go acc 0 = f acc-    go acc n = withIterCF db cf $ \it -> go (it : acc) (n - 1)+    go acc n = withIterCFStat db cf $ \it -> go (it : acc) (n - 1)  joinConduits ::   (Monad m, Ord o) =>@@ -272,7 +299,7 @@     retrieveCF db (txCF db) (TxKey th) >>= \case       Nothing -> return Nothing       Just t -> do-        incrementCounter (.dataTxCount) 1+        withMetrics $ \s -> incrementCounter s.dataTxCount 1         return (Just t)    getSpender op = runMaybeT $ do@@ -287,21 +314,21 @@     case fmap (valToUnspent ctx p) val of       Nothing -> return Nothing       Just u -> do-        incrementCounter (.dataUnspentCount) 1+        withMetrics $ \s -> incrementCounter s.dataUnspentCount 1         return (Just u)    getBalance a = do     db <- asks (.db)-    incrementCounter (.dataBalanceCount) 1+    withMetrics $ \s -> incrementCounter s.dataBalanceCount 1     fmap (valToBalance a) <$> retrieveCF db (balanceCF db) (BalKey a)    getMempool = do     db <- asks (.db)-    incrementCounter (.dataMempoolCount) 1+    withMetrics $ \s -> incrementCounter s.dataMempoolCount 1     fromMaybe [] <$> retrieve db MemKey    getBestBlock = do-    incrementCounter (.dataBestCount) 1+    withMetrics $ \s -> incrementCounter s.dataBestCount 1     asks (.db) >>= (`retrieve` BestKey)    getBlocksAtHeight h = do@@ -309,7 +336,7 @@     retrieveCF db (heightCF db) (HeightKey h) >>= \case       Nothing -> return []       Just ls -> do-        incrementCounter (.dataBlockCount) (length ls)+        withMetrics $ \s -> incrementCounter s.dataBlockCount (length ls)         return ls    getBlock h = do@@ -317,7 +344,7 @@     retrieveCF db (blockCF db) (BlockKey h) >>= \case       Nothing -> return Nothing       Just b -> do-        incrementCounter (.dataBlockCount) 1+        withMetrics $ \s -> incrementCounter s.dataBlockCount 1         return (Just b)  instance (MonadUnliftIO m) => StoreReadExtra (DatabaseReaderT m) where@@ -325,7 +352,7 @@     db <- asks (.db)     withManyIters db (addrTxCF db) (length addrs) $ \its -> do       txs <- joinConduits (cs its) limits-      incrementCounter (.dataAddrTxCount) (length txs)+      withMetrics $ \s -> incrementCounter s.dataAddrTxCount (length txs)       return txs     where       cs = zipWith c addrs@@ -336,7 +363,7 @@     ctx <- asks (.ctx)     withManyIters db (addrOutCF db) (length addrs) $ \its -> do       uns <- joinConduits (cs ctx its) limits-      incrementCounter (.dataUnspentCount) (length uns)+      withMetrics $ \s -> incrementCounter s.dataUnspentCount (length uns)       return uns     where       cs ctx = zipWith (c ctx) addrs@@ -345,22 +372,22 @@   getAddressUnspents a limits = do     db <- asks (.db)     ctx <- asks (.ctx)-    us <- withIterCF db (addrOutCF db) $ \it ->+    us <- withIterCFStat db (addrOutCF db) $ \it ->       runConduit $         unspentConduit ctx a limits.start it           .| applyLimitsC limits           .| sinkList-    incrementCounter (.dataUnspentCount) (length us)+    withMetrics $ \s -> incrementCounter s.dataUnspentCount (length us)     return us    getAddressTxs a limits = do     db <- asks (.db)-    txs <- withIterCF db (addrTxCF db) $ \it ->+    txs <- withIterCFStat db (addrTxCF db) $ \it ->       runConduit $         addressConduit a limits.start it           .| applyLimitsC limits           .| sinkList-    incrementCounter (.dataAddrTxCount) (length txs)+    withMetrics $ \s -> incrementCounter s.dataAddrTxCount (length txs)     return txs    getMaxGap = asks (.maxGap)@@ -377,7 +404,7 @@               w' = b .&. 0xf8            in w == w'         txs = filter f $ map snd ls-    incrementCounter (.dataTxCount) (length txs)+    withMetrics $ \s -> incrementCounter s.dataTxCount (length txs)     return txs    getBalances as = do@@ -391,34 +418,44 @@     igap <- getInitialGap     gap <- getMaxGap     ext1 <- derive_until_gap gap 0 (take (fromIntegral igap) (aderiv ctx 0 0))-    if all (nullBalance . (.balance)) ext1+    if all nullxb ext1       then do-        incrementCounter (.dataXPubBals) (length ext1)+        withMetrics $ \s -> incrementCounter s.dataXPubBals (length ext1)         return ext1       else do         ext2 <- derive_until_gap gap 0 (aderiv ctx 0 igap)         chg <- derive_until_gap gap 1 (aderiv ctx 1 0)         let bals = ext1 <> ext2 <> chg-        incrementCounter (.dataXPubBals) (length bals)+        withMetrics $ \s -> incrementCounter s.dataXPubBals (length bals)         return bals     where+      nullxb b = nullBalance b.balance       aderiv ctx m =         deriveAddresses           (deriveFunction ctx xpub.deriv)           (pubSubKey ctx xpub.key m)-      xbalance m b n = XPubBal {path = [m, n], balance = b}-      derive_until_gap _ _ [] = return []-      derive_until_gap gap m as = do-        let (as1, as2) = splitAt (fromIntegral gap) as-        bs <- getBalances (map snd as1)-        let xbs = zipWith (xbalance m) bs (map fst as1)-        if all nullBalance bs-          then return xbs-          else (xbs <>) <$> derive_until_gap gap m as2+      derive_until_gap gap m adrs =+        let xb b n = XPubBal {path = [m, n], balance = b}+            ig = fromIntegral gap+            test acc =+              let ns = takeWhile nullxb acc+               in length ns > ig+            go acc [] = return $ reverse acc+            go acc as+              | test acc =+                  let (ns, ys) = span nullxb acc+                      xs = take ig $ reverse ns+                   in return $ reverse ys <> xs+              | otherwise = do+                  let (as', as'') = splitAt ig as+                  bs <- getBalances (map snd as')+                  let xs = reverse $ zipWith xb bs (map fst as')+                  go (xs <> acc) as''+         in go [] adrs    xPubUnspents _xspec xbals limits = do     us <- concat <$> mapM h cs-    incrementCounter (.dataXPubUnspents) (length us)+    withMetrics $ \s -> incrementCounter s.dataXPubUnspents (length us)     return . applyLimits limits $ sortOn Down us     where       l = deOffset limits@@ -433,9 +470,9 @@             filter (not . nullBalance) $               map (.balance) xbals     txs <- getAddressesTxs as limits-    incrementCounter (.dataXPubTxs) (length txs)+    withMetrics $ \s -> incrementCounter s.dataXPubTxs (length txs)     return txs    xPubTxCount xspec xbals = do-    incrementCounter (.dataXPubTxCount) 1+    withMetrics $ \s -> incrementCounter s.dataXPubTxCount 1     fromIntegral . length <$> xPubTxs xspec xbals def

@@ -33,27 +33,19 @@ import Control.DeepSeq (NFData) import Control.Monad (guard) import Data.Bits-  ( Bits,-    shift,-    shiftL,-    shiftR,+  ( shift,     (.&.),-    (.|.),   ) import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.Default (Default (..))-import Data.Either (fromRight) import Data.Hashable (Hashable) import Data.Serialize   ( Serialize (..),-    decode,-    encode,     getBytes,     getWord16be,     getWord32be,     getWord8,-    putWord32be,     putWord64be,     putWord8,     runGet,@@ -76,7 +68,6 @@   ( Balance (..),     BlockData,     BlockRef,-    Spender,     TxData,     TxRef (..),     UnixTime,

@@ -10,11 +10,8 @@  module Haskoin.Store.Database.Writer (WriterT, runWriter) where -import Control.Monad (join) import Control.Monad.Reader (ReaderT (..)) import Control.Monad.Reader qualified as R-import Data.HashMap.Strict (HashMap)-import Data.HashMap.Strict qualified as M import Data.HashTable.IO qualified as H import Data.IntMap.Strict qualified as IntMap import Data.List (sortOn)@@ -46,15 +43,9 @@ import UnliftIO   ( IORef,     MonadIO,-    TVar,-    atomically,     liftIO,-    modifyIORef,-    modifyTVar,     newIORef,-    newTVarIO,     readIORef,-    readTVarIO,     writeIORef,   ) @@ -77,8 +68,6 @@   getBalance = getBalanceI   getMempool = getMempoolI -type NetRef = IORef (Maybe Network)- type BestRef = IORef (Maybe (Maybe BlockHash))  type BlockTable = H.BasicHashTable BlockHash (Maybe BlockData)@@ -219,7 +208,7 @@ txOps :: (MonadIO m) => DB -> TxTable -> m [BatchOp] txOps db t = map (uncurry f) <$> liftIO (H.toList t)   where-    f k (Just t) = insertOpCF (txCF db) (TxKey k) t+    f k (Just t') = insertOpCF (txCF db) (TxKey k) t'     f k Nothing = deleteOpCF (txCF db) (TxKey k)  balOps :: (MonadIO m) => DB -> BalanceTable -> m [BatchOp]@@ -231,8 +220,8 @@ addrTxOps :: (MonadIO m) => DB -> AddrTxTable -> m [BatchOp] addrTxOps db t = map (uncurry f) <$> liftIO (H.toList t)   where-    f (a, t) (Just ()) = insertOpCF (addrTxCF db) (AddrTxKey a t) ()-    f (a, t) Nothing = deleteOpCF (addrTxCF db) (AddrTxKey a t)+    f (a, t') (Just ()) = insertOpCF (addrTxCF db) (AddrTxKey a t') ()+    f (a, t') Nothing = deleteOpCF (addrTxCF db) (AddrTxKey a t')  addrOutOps :: (MonadIO m) => DB -> AddrOutTable -> m [BatchOp] addrOutOps db t = map (uncurry f) <$> liftIO (H.toList t)@@ -313,12 +302,6 @@   mempoolTable <- liftIO $ H.fromList (map swap mempool)   return Memory {..} -getNetworkH :: (Monad m) => Memory -> m Network-getNetworkH Memory {net} = return net--getCtxH :: (Monad m) => Memory -> m Ctx-getCtxH Memory {ctx} = return ctx- getBestBlockH :: Memory -> IO (Maybe (Maybe BlockHash)) getBestBlockH = readIORef . (.best) @@ -339,9 +322,6 @@  getBalanceH :: Address -> Memory -> IO (Maybe (Maybe Balance)) getBalanceH a s = H.lookup s.balanceTable a--getMempoolH :: Memory -> IO [(UnixTime, TxHash)]-getMempoolH Memory {..} = sortOn Down . map swap <$> H.toList mempoolTable  getUnspentH :: OutPoint -> Memory -> IO (Maybe (Maybe Unspent)) getUnspentH p Memory {..} = H.lookup unspentTable p

@@ -30,7 +30,6 @@     void,     when,     zipWithM_,-    (<=<),   ) import Control.Monad.Except (MonadError, throwError) import Control.Monad.Logger@@ -40,7 +39,6 @@   ) import qualified Data.ByteString as B import Data.Either (rights)-import Data.HashSet (HashSet) import qualified Data.HashSet as HashSet import qualified Data.IntMap.Strict as I import Data.List (nub)@@ -135,7 +133,7 @@       freeOutputs True True tx       rbf <- isRBF (MemRef w) tx       checkNewTx tx-      importTx (MemRef w) w rbf tx+      _ <- importTx (MemRef w) w rbf tx       return True  bestBlockData :: (MonadImport m) => m BlockData@@ -265,8 +263,6 @@       <> blockHashToHex (headerHash n.header)   return (bd, tds)   where-    cb_out_val =-      sum $ map (.value) $ (head b.txs).outputs     ts_out_val =       sum $ map (sum . map (.value) . (.outputs)) $ tail $ b.txs     w =@@ -481,7 +477,7 @@   mapM_ (\t -> let h = txHash t in deleteSingleTx h >> return h) chain  getChain ::-  (MonadImport m, MonadLoggerIO m) =>+  (MonadImport m) =>   -- | only delete transaction if unconfirmed   Bool ->   -- | only delete RBF

@@ -1,6 +1,5 @@ {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE FlexibleContexts #-}-{-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedRecordDot #-} {-# LANGUAGE NoFieldSelectors #-}@@ -12,12 +11,9 @@   ) where -import Control.Monad (forever, unless, when)+import Control.Monad (forever, unless) import Control.Monad.Cont   ( ContT (..),-    MonadCont (callCC),-    cont,-    runCont,     runContT,   ) import Control.Monad.Logger (MonadLoggerIO)@@ -78,11 +74,11 @@   ) import Haskoin.Store.Common   ( StoreEvent (..),-    createDataMetrics,   ) import Haskoin.Store.Database.Reader   ( DatabaseReader (..),     DatabaseReaderT,+    createDataMetrics,     withDatabaseReader,   ) import NQE@@ -96,7 +92,7 @@     withSubscription,   ) import Network.Socket (SockAddr (..))-import System.Metrics qualified as Metrics (Store)+import System.Metrics.StatsD import UnliftIO   ( MonadIO,     MonadUnliftIO,@@ -155,8 +151,8 @@     maxPeerLife :: !NominalDiffTime,     -- | connect to peers using the function 'withConnection'     connect :: !(SockAddr -> WithConnection),-    -- | stats store-    statsStore :: !(Maybe Metrics.Store),+    -- | StatsD+    stats :: !(Maybe Stats),     -- | sync mempool against cache every this many seconds     redisSyncInterval :: !Int   }@@ -196,7 +192,7 @@   DatabaseReaderT m a ->   m a connectDB cfg f = do-  stats <- mapM createDataMetrics cfg.statsStore+  stats <- mapM createDataMetrics cfg.stats   withDatabaseReader     cfg.net     cfg.ctx@@ -224,7 +220,7 @@       wipeMempool = cfg.wipeMempool,       syncMempool = cfg.syncMempool,       peerTimeout = cfg.peerTimeout,-      statsStore = cfg.statsStore+      stats = cfg.stats     }  nodeCfg ::@@ -263,8 +259,8 @@     Nothing ->       action Nothing     Just redisurl -> do-      metrics <- mapM newCacheMetrics cfg.statsStore       conn <- connectRedis redisurl+      metrics <- mapM (\s -> newCacheMetrics s conn db) cfg.stats       withSubscription pub $ \evts ->         let conf = c conn metrics          in withProcess (f conf) $ \p ->

@@ -1,209 +0,0 @@-{-# LANGUAGE DuplicateRecordFields #-}-{-# LANGUAGE ImportQualifiedPost #-}-{-# LANGUAGE OverloadedRecordDot #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RecordWildCards #-}-{-# LANGUAGE NoFieldSelectors #-}--module Haskoin.Store.Stats-  ( StatDist,-    withStats,-    createStatDist,-    addStatTime,-    addClientError,-    addServerError,-    addStatQuery,-    addStatItems,-  )-where--import Control.Concurrent.STM.TQueue-  ( TQueue,-    flushTQueue,-    writeTQueue,-  )-import Control.Foldl qualified as L-import Control.Monad (forever)-import Data.Function (on)-import Data.HashMap.Strict (HashMap)-import Data.HashMap.Strict qualified as HashMap-import Data.Int (Int64)-import Data.List (sort, sortBy, sortOn)-import Data.Maybe (fromMaybe)-import Data.Ord (Down (..), comparing)-import Data.String.Conversions (cs)-import Data.Text (Text)-import System.Metrics-  ( Store,-    Value (..),-    newStore,-    registerGcMetrics,-    registerGroup,-    sampleAll,-  )-import System.Remote.Monitoring.Statsd-  ( defaultStatsdOptions,-    flushInterval,-    forkStatsd,-    host,-    port,-    prefix,-  )-import UnliftIO-  ( MonadIO,-    TVar,-    atomically,-    liftIO,-    modifyTVar,-    newTQueueIO,-    newTVarIO,-    readTVar,-    withAsync,-  )-import UnliftIO.Concurrent (threadDelay)--withStats :: (MonadIO m) => Text -> Int -> Text -> (Store -> m a) -> m a-withStats h p pfx go = do-  store <- liftIO newStore-  _statsd <--    liftIO $-      forkStatsd-        defaultStatsdOptions-          { prefix = pfx,-            host = h,-            port = p-          }-        store-  liftIO $ registerGcMetrics store-  go store--data StatData = StatData-  { times :: ![Int64],-    queries :: !Int64,-    items :: !Int64,-    clientErrors :: !Int64,-    serverErrors :: !Int64-  }--data StatDist = StatDist-  { queue :: !(TQueue Int64),-    queries :: !(TVar Int64),-    items :: !(TVar Int64),-    clientErrors :: !(TVar Int64),-    serverErrors :: !(TVar Int64)-  }--createStatDist :: (MonadIO m) => Text -> Store -> m StatDist-createStatDist t store = liftIO $ do-  queue <- newTQueueIO-  queries <- newTVarIO 0-  items <- newTVarIO 0-  clientErrors <- newTVarIO 0-  serverErrors <- newTVarIO 0-  let metrics =-        HashMap.fromList-          [ ( t <> ".request_count",-              Counter . (.queries)-            ),-            ( t <> ".item_count",-              Counter . (.items)-            ),-            ( t <> ".client_errors",-              Counter . (.clientErrors)-            ),-            ( t <> ".server_errors",-              Counter . (.serverErrors)-            ),-            ( t <> ".mean_ms",-              Gauge . mean . (.times)-            ),-            ( t <> ".avg_ms",-              Gauge . avg . (.times)-            ),-            ( t <> ".max_ms",-              Gauge . maxi . (.times)-            ),-            ( t <> ".min_ms",-              Gauge . mini . (.times)-            ),-            ( t <> ".p90max_ms",-              Gauge . p90max . (.times)-            ),-            ( t <> ".p90avg_ms",-              Gauge . p90avg . (.times)-            ),-            ( t <> ".var_ms",-              Gauge . var . (.times)-            )-          ]-  let sd = StatDist {..}-  registerGroup metrics (flush sd) store-  return sd--toDouble :: Int64 -> Double-toDouble = fromIntegral--addStatTime :: (MonadIO m) => StatDist -> Int64 -> m ()-addStatTime q =-  liftIO . atomically . writeTQueue q.queue--addStatQuery :: (MonadIO m) => StatDist -> m ()-addStatQuery q =-  liftIO . atomically $ modifyTVar q.queries (+ 1)--addStatItems :: (MonadIO m) => StatDist -> Int64 -> m ()-addStatItems q =-  liftIO . atomically . modifyTVar q.items . (+)--addClientError :: (MonadIO m) => StatDist -> m ()-addClientError q =-  liftIO . atomically $ modifyTVar q.clientErrors (+ 1)--addServerError :: (MonadIO m) => StatDist -> m ()-addServerError q =-  liftIO . atomically $ modifyTVar q.serverErrors (+ 1)--flush :: (MonadIO m) => StatDist -> m StatData-flush StatDist {..} = atomically $ do-  times <- flushTQueue queue-  queries <- readTVar queries-  items <- readTVar items-  clientErrors <- readTVar clientErrors-  serverErrors <- readTVar serverErrors-  return $ StatData {..}--average :: (Fractional a) => L.Fold a a-average = (/) <$> L.sum <*> L.genericLength--avg :: [Int64] -> Int64-avg = round . L.fold average . map toDouble--mean :: [Int64] -> Int64-mean = round . L.fold L.mean . map toDouble--maxi :: [Int64] -> Int64-maxi = fromMaybe 0 . L.fold L.maximum--mini :: [Int64] -> Int64-mini = fromMaybe 0 . L.fold L.minimum--var :: [Int64] -> Int64-var = round . L.fold L.variance . map toDouble--p90max :: [Int64] -> Int64-p90max ls =-  case chopped of-    [] -> 0-    h : _ -> h-  where-    sorted = sortOn Down ls-    len = length sorted-    chopped = drop (length sorted `div` 10) sorted--p90avg :: [Int64] -> Int64-p90avg ls =-  avg chopped-  where-    sorted = sortOn Down ls-    len = length sorted-    chopped = drop (length sorted `div` 10) sorted

@@ -20,3165 +20,2766 @@     WebConfig (..),     Except (..),     WebLimits (..),-    WebTimeouts (..),-    runWeb,-  )-where--import Conduit-  ( ConduitT,-    await,-    concatMapC,-    concatMapMC,-    dropC,-    dropWhileC,-    headC,-    iterMC,-    mapC,-    runConduit,-    sinkList,-    takeC,-    takeWhileC,-    yield,-    (.|),-  )-import Control.Applicative ((<|>))-import Control.Arrow (second)-import Control.Lens ((.~), (^.))-import Control.Monad-  ( forM_,-    forever,-    join,-    unless,-    when,-    (<=<),-    (>=>),-  )-import Control.Monad.Logger-  ( MonadLoggerIO,-    logDebugS,-    logErrorS,-    logWarnS,-  )-import Control.Monad.Reader-  ( ReaderT,-    asks,-    local,-    runReaderT,-  )-import Control.Monad.Trans (lift)-import Control.Monad.Trans.Control (liftWith, restoreT)-import Control.Monad.Trans.Maybe-  ( MaybeT (..),-    runMaybeT,-  )-import Data.Aeson-  ( Encoding,-    ToJSON (..),-    Value,-  )-import Data.Aeson qualified as A-import Data.Aeson.Encode.Pretty-  ( Config (..),-    defConfig,-    encodePretty',-  )-import Data.Aeson.Encoding-  ( encodingToLazyByteString,-    list,-  )-import Data.Aeson.Text (encodeToLazyText)-import Data.Base16.Types (assertBase16)-import Data.ByteString (ByteString)-import Data.ByteString qualified as B-import Data.ByteString.Base16 (decodeBase16, isBase16)-import Data.ByteString.Builder (byteString, lazyByteString)-import Data.ByteString.Char8 qualified as C-import Data.ByteString.Lazy qualified as L-import Data.Bytes.Get-import Data.Bytes.Put-import Data.Bytes.Serial-import Data.Char (isSpace)-import Data.Default (Default (..))-import Data.Function ((&))-import Data.HashMap.Strict (HashMap)-import Data.HashMap.Strict qualified as HashMap-import Data.HashSet (HashSet)-import Data.HashSet qualified as HashSet-import Data.Int (Int64)-import Data.List (nub)-import Data.Maybe-  ( catMaybes,-    fromJust,-    fromMaybe,-    isJust,-    mapMaybe,-    maybeToList,-  )-import Data.Proxy (Proxy (..))-import Data.Serialize (decode)-import Data.String (fromString)-import Data.String.Conversions (cs)-import Data.Text (Text)-import Data.Text qualified as T-import Data.Text.Encoding qualified as T-import Data.Text.Lazy (toStrict)-import Data.Text.Lazy qualified as TL-import Data.Time.Clock (diffUTCTime, getCurrentTime)-import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)-import Data.Time.Clock.System-  ( getSystemTime,-    systemSeconds,-    systemToUTCTime,-  )-import Data.Vault.Lazy qualified as V-import Data.Word (Word32, Word64)-import Database.RocksDB-  ( Property (..),-    getProperty,-  )-import GHC.RTS.Flags (ConcFlags (ConcFlags))-import Haskoin.Address-import Haskoin.Block qualified as H-import Haskoin.Crypto.Hash (Hash160 (..))-import Haskoin.Crypto.Keys-import Haskoin.Network-import Haskoin.Node-  ( Chain,-    OnlinePeer (..),-    PeerMgr,-    chainGetAncestor,-    chainGetBest,-    getPeers,-    sendMessage,-  )-import Haskoin.Script-import Haskoin.Store.BlockStore-import Haskoin.Store.Cache-import Haskoin.Store.Common-import Haskoin.Store.Data-import Haskoin.Store.Database.Reader-import Haskoin.Store.Manager-import Haskoin.Store.Stats-import Haskoin.Store.WebCommon-import Haskoin.Transaction-import Haskoin.Util-import NQE-  ( Inbox,-    Publisher,-    receive,-    withSubscription,-  )-import Network.HTTP.Types-  ( Status (..),-    hContentType,-    requestEntityTooLarge413,-    status400,-    status404,-    status409,-    status413,-    status500,-    status503,-    statusIsClientError,-    statusIsServerError,-    statusIsSuccessful,-  )-import Network.Wai-  ( Middleware,-    Request (..),-    Response,-    getRequestBodyChunk,-    responseLBS,-    responseStatus,-  )-import Network.Wai qualified as S-import Network.Wai.Handler.Warp-  ( defaultSettings,-    setHost,-    setPort,-  )-import Network.Wai.Handler.WebSockets (websocketsOr)-import Network.Wai.Middleware.RequestSizeLimit-import Network.Wai.Middleware.Timeout-import Network.WebSockets-  ( ServerApp,-    acceptRequest,-    defaultConnectionOptions,-    pendingRequest,-    rejectRequestWith,-    requestPath,-    sendTextData,-  )-import Network.WebSockets qualified as WebSockets-import Network.Wreq qualified as Wreq-import Network.Wreq.Session as Wreq (Session)-import Network.Wreq.Session qualified as Wreq.Session-import System.IO.Unsafe (unsafeInterleaveIO)-import System.Metrics qualified as Metrics-import System.Metrics.Gauge qualified as Metrics (Gauge)-import System.Metrics.Gauge qualified as Metrics.Gauge-import UnliftIO-  ( MonadIO,-    MonadUnliftIO,-    TVar,-    askRunInIO,-    atomically,-    bracket,-    bracket_,-    handleAny,-    liftIO,-    modifyTVar,-    newTVarIO,-    readTVarIO,-    timeout,-    withAsync,-    withRunInIO,-    writeTVar,-  )-import UnliftIO.Concurrent (threadDelay)-import Web.Scotty.Internal.Types (ActionT)-import Web.Scotty.Trans qualified as S--type WebT m = ActionT Except (ReaderT WebState m)--data WebLimits = WebLimits-  { maxItemCount :: !Word32,-    maxFullItemCount :: !Word32,-    maxOffset :: !Word32,-    defItemCount :: !Word32,-    xpubGap :: !Word32,-    xpubGapInit :: !Word32,-    maxBodySize :: !Word32,-    requestTimeout :: !Word32-  }-  deriving (Eq, Show)--instance Default WebLimits where-  def =-    WebLimits-      { maxItemCount = 200000,-        maxFullItemCount = 5000,-        maxOffset = 50000,-        defItemCount = 100,-        xpubGap = 32,-        xpubGapInit = 20,-        maxBodySize = 1024 * 1024,-        requestTimeout = 0-      }--data WebConfig = WebConfig-  { host :: !String,-    port :: !Int,-    store :: !Store,-    maxLaggingBlocks :: !Int,-    maxPendingTxs :: !Int,-    minPeers :: !Int,-    limits :: !WebLimits,-    timeouts :: !WebTimeouts,-    version :: !String,-    noMempool :: !Bool,-    statsStore :: !(Maybe Metrics.Store),-    tickerRefresh :: !Int,-    tickerURL :: !String,-    priceHistoryURL :: !String,-    noSlow :: !Bool,-    noBlockchainInfo :: !Bool,-    healthCheckInterval :: !Int-  }--data WebState = WebState-  { config :: !WebConfig,-    ticker :: !(TVar (HashMap Text BinfoTicker)),-    metrics :: !(Maybe WebMetrics),-    session :: !Wreq.Session,-    health :: !(TVar HealthCheck)-  }--data WebMetrics = WebMetrics-  { all :: !StatDist,-    -- Addresses-    addressTx :: !StatDist,-    addressTxFull :: !StatDist,-    addressBalance :: !StatDist,-    addressUnspent :: !StatDist,-    xpub :: !StatDist,-    xpubDelete :: !StatDist,-    xpubTxFull :: !StatDist,-    xpubTx :: !StatDist,-    xpubBalance :: !StatDist,-    xpubUnspent :: !StatDist,-    -- Transactions-    tx :: !StatDist,-    txRaw :: !StatDist,-    txAfter :: !StatDist,-    txBlock :: !StatDist,-    txBlockRaw :: !StatDist,-    txPost :: !StatDist,-    mempool :: !StatDist,-    -- Blocks-    block :: !StatDist,-    blockRaw :: !StatDist,-    -- Blockchain-    binfoMultiaddr :: !StatDist,-    binfoBalance :: !StatDist,-    binfoAddressRaw :: !StatDist,-    binfoUnspent :: !StatDist,-    binfoTxRaw :: !StatDist,-    binfoBlock :: !StatDist,-    binfoBlockHeight :: !StatDist,-    binfoBlockLatest :: !StatDist,-    binfoBlockRaw :: !StatDist,-    binfoMempool :: !StatDist,-    binfoExportHistory :: !StatDist,-    -- Blockchain /q endpoints-    binfoQaddresstohash :: !StatDist,-    binfoQhashtoaddress :: !StatDist,-    binfoQaddrpubkey :: !StatDist,-    binfoQpubkeyaddr :: !StatDist,-    binfoQhashpubkey :: !StatDist,-    binfoQgetblockcount :: !StatDist,-    binfoQlatesthash :: !StatDist,-    binfoQbcperblock :: !StatDist,-    binfoQtxtotalbtcoutput :: !StatDist,-    binfoQtxtotalbtcinput :: !StatDist,-    binfoQtxfee :: !StatDist,-    binfoQtxresult :: !StatDist,-    binfoQgetreceivedbyaddress :: !StatDist,-    binfoQgetsentbyaddress :: !StatDist,-    binfoQaddressbalance :: !StatDist,-    binfoQaddressfirstseen :: !StatDist,-    -- Others-    health :: !StatDist,-    peers :: !StatDist,-    db :: !StatDist,-    events :: !Metrics.Gauge.Gauge,-    -- Request-    key :: !(V.Key (TVar (Maybe (WebMetrics -> StatDist))))-  }--createMetrics :: (MonadIO m) => Metrics.Store -> m WebMetrics-createMetrics s = liftIO $ do-  all <- d "all"--  -- Addresses-  addressTx <- d "address_transactions"-  addressTxFull <- d "address_transactions_full"-  addressBalance <- d "address_balance"-  addressUnspent <- d "address_unspent"-  xpub <- d "xpub"-  xpubDelete <- d "xpub_delete"-  xpubTxFull <- d "xpub_transactions_full"-  xpubTx <- d "xpub_transactions"-  xpubBalance <- d "xpub_balances"-  xpubUnspent <- d "xpub_unspent"--  -- Transactions-  tx <- d "transaction"-  txRaw <- d "transaction_raw"-  txAfter <- d "transaction_after"-  txPost <- d "transaction_post"-  txBlock <- d "transactions_block"-  txBlockRaw <- d "transactions_block_raw"-  mempool <- d "mempool"--  -- Blocks-  block <- d "block"-  blockRaw <- d "block_raw"--  -- Blockchain-  binfoMultiaddr <- d "blockchain_multiaddr"-  binfoBalance <- d "blockchain_balance"-  binfoAddressRaw <- d "blockchain_rawaddr"-  binfoUnspent <- d "blockchain_unspent"-  binfoTxRaw <- d "blockchain_rawtx"-  binfoBlock <- d "blockchain_blocks"-  binfoBlockHeight <- d "blockchain_block_height"-  binfoBlockLatest <- d "blockchain_latestblock"-  binfoBlockRaw <- d "blockchain_rawblock"-  binfoMempool <- d "blockchain_mempool"-  binfoExportHistory <- d "blockchain_export_history"--  -- Blockchain /q endpoints-  binfoQaddresstohash <- d "blockchain_q_addresstohash"-  binfoQhashtoaddress <- d "blockchain_q_hashtoaddress"-  binfoQaddrpubkey <- d "blockckhain_q_addrpubkey"-  binfoQpubkeyaddr <- d "blockchain_q_pubkeyaddr"-  binfoQhashpubkey <- d "blockchain_q_hashpubkey"-  binfoQgetblockcount <- d "blockchain_q_getblockcount"-  binfoQlatesthash <- d "blockchain_q_latesthash"-  binfoQbcperblock <- d "blockchain_q_bcperblock"-  binfoQtxtotalbtcoutput <- d "blockchain_q_txtotalbtcoutput"-  binfoQtxtotalbtcinput <- d "blockchain_q_txtotalbtcinput"-  binfoQtxfee <- d "blockchain_q_txfee"-  binfoQtxresult <- d "blockchain_q_txresult"-  binfoQgetreceivedbyaddress <- d "blockchain_q_getreceivedbyaddress"-  binfoQgetsentbyaddress <- d "blockchain_q_getsentbyaddress"-  binfoQaddressbalance <- d "blockchain_q_addressbalance"-  binfoQaddressfirstseen <- d "blockchain_q_addressfirstseen"--  -- Others-  health <- d "health"-  peers <- d "peers"-  db <- d "dbstats"--  events <- g "events_connected"-  key <- V.newKey-  return WebMetrics {..}-  where-    d x = createStatDist ("web." <> x) s-    g x = Metrics.createGauge ("web." <> x) s--withGaugeIO :: (MonadUnliftIO m) => Metrics.Gauge -> m a -> m a-withGaugeIO g =-  bracket_-    (liftIO $ Metrics.Gauge.inc g)-    (liftIO $ Metrics.Gauge.dec g)--withGaugeIncrease ::-  (MonadUnliftIO m) =>-  (WebMetrics -> Metrics.Gauge) ->-  WebT m a ->-  WebT m a-withGaugeIncrease gf go =-  lift (asks (.metrics)) >>= \case-    Nothing -> go-    Just m -> do-      s <- liftWith $ \run -> withGaugeIO (gf m) (run go)-      restoreT $ return s--setMetrics :: (MonadUnliftIO m) => (WebMetrics -> StatDist) -> WebT m ()-setMetrics df =-  asks (.metrics) >>= mapM_ go-  where-    go m = do-      req <- S.request-      let t = fromMaybe e $ V.lookup m.key (vault req)-      atomically $ writeTVar t (Just df)-    e = error "the ways of the warrior are yet to be mastered"--addItemCount :: (MonadUnliftIO m) => Int -> WebT m ()-addItemCount i =-  asks (.metrics) >>= mapM_ \m -> do-    addStatItems m.all (fromIntegral i)-    req <- S.request-    forM_ (V.lookup m.key (vault req)) $-      readTVarIO >=> mapM_ \s -> addStatItems (s m) (fromIntegral i)--getItemCounter :: (MonadIO m, MonadIO n) => WebT m (Int -> n ())-getItemCounter =-  fromMaybe (\_ -> return ()) <$> runMaybeT do-    q <- lift S.request-    m <- MaybeT $ asks (.metrics)-    t <- MaybeT . return $ V.lookup m.key (vault q)-    s <- MaybeT $ readTVarIO t-    return $ addStatItems (s m) . fromIntegral--data WebTimeouts = WebTimeouts-  { tx :: !Word64,-    block :: !Word64-  }-  deriving (Eq, Show)--data SerialAs = SerialAsBinary | SerialAsJSON | SerialAsPrettyJSON-  deriving (Eq, Show)--instance Default WebTimeouts where-  def = WebTimeouts {tx = 3600 `div` 2, block = 4 * 3600}--instance-  (MonadUnliftIO m, MonadLoggerIO m) =>-  StoreReadBase (ReaderT WebState m)-  where-  getCtx = runInWebReader getCtx-  getNetwork = runInWebReader getNetwork-  getBestBlock = runInWebReader getBestBlock-  getBlocksAtHeight height = runInWebReader (getBlocksAtHeight height)-  getBlock bh = runInWebReader (getBlock bh)-  getTxData th = runInWebReader (getTxData th)-  getSpender op = runInWebReader (getSpender op)-  getUnspent op = runInWebReader (getUnspent op)-  getBalance a = runInWebReader (getBalance a)-  getMempool = runInWebReader getMempool--instance-  (MonadUnliftIO m, MonadLoggerIO m) =>-  StoreReadExtra (ReaderT WebState m)-  where-  getMaxGap = runInWebReader getMaxGap-  getInitialGap = runInWebReader getInitialGap-  getBalances as = runInWebReader (getBalances as)-  getAddressesTxs as = runInWebReader . getAddressesTxs as-  getAddressTxs a = runInWebReader . getAddressTxs a-  getAddressUnspents a = runInWebReader . getAddressUnspents a-  getAddressesUnspents as = runInWebReader . getAddressesUnspents as-  xPubBals = runInWebReader . xPubBals-  xPubUnspents xpub xbals = runInWebReader . xPubUnspents xpub xbals-  xPubTxs xpub xbals = runInWebReader . xPubTxs xpub xbals-  xPubTxCount xpub = runInWebReader . xPubTxCount xpub-  getNumTxData = runInWebReader . getNumTxData--instance (MonadUnliftIO m, MonadLoggerIO m) => StoreReadBase (WebT m) where-  getCtx = lift getCtx-  getNetwork = lift getNetwork-  getBestBlock = lift getBestBlock-  getBlocksAtHeight = lift . getBlocksAtHeight-  getBlock = lift . getBlock-  getTxData = lift . getTxData-  getSpender = lift . getSpender-  getUnspent = lift . getUnspent-  getBalance = lift . getBalance-  getMempool = lift getMempool--instance (MonadUnliftIO m, MonadLoggerIO m) => StoreReadExtra (WebT m) where-  getBalances = lift . getBalances-  getAddressesTxs as = lift . getAddressesTxs as-  getAddressTxs a = lift . getAddressTxs a-  getAddressUnspents a = lift . getAddressUnspents a-  getAddressesUnspents as = lift . getAddressesUnspents as-  xPubBals = lift . xPubBals-  xPubUnspents xpub xbals = lift . xPubUnspents xpub xbals-  xPubTxs xpub xbals = lift . xPubTxs xpub xbals-  xPubTxCount xpub = lift . xPubTxCount xpub-  getMaxGap = lift getMaxGap-  getInitialGap = lift getInitialGap-  getNumTxData = lift . getNumTxData------------------------ Path Handlers ------------------------runWeb :: (MonadUnliftIO m, MonadLoggerIO m) => WebConfig -> m ()-runWeb config = do-  ticker <- newTVarIO HashMap.empty-  metrics <- mapM createMetrics config.statsStore-  session <- liftIO Wreq.Session.newAPISession-  health <- runHealthCheck >>= newTVarIO-  let state = WebState {..}-  withAsync (priceUpdater session ticker) $ \_a1 ->-    withAsync (healthCheckLoop health) $ \_a2 -> do-      logger <- logIt metrics-      runner <- askRunInIO-      S.scottyOptsT opts (runner . flip runReaderT state) $ do-        S.middleware $ webSocketEvents state-        S.middleware logger-        S.middleware $ reqSizeLimit config.limits.maxBodySize-        timeoutMiddleware-        S.defaultHandler defHandler-        handlePaths config-        S.notFound $ raise ThingNotFound-  where-    priceUpdater session =-      unless (config.noSlow || config.noBlockchainInfo)-        . price-          config.store.net-          session-          config.tickerURL-          config.tickerRefresh-    timeoutMiddleware =-      when (config.limits.requestTimeout > 0) $-        S.middleware $-          reqTimeout config.limits.requestTimeout-    runHealthCheck = runReaderT (healthCheck config) config.store.db-    healthCheckLoop v = forever $ do-      threadDelay (config.healthCheckInterval * 1000 * 1000)-      runHealthCheck >>= atomically . writeTVar v-    opts = def {S.settings = settings defaultSettings}-    settings = setPort config.port . setHost (fromString config.host)--getRates ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  Network ->-  Wreq.Session ->-  String ->-  Text ->-  [Word64] ->-  m [BinfoRate]-getRates net session url currency times = do-  handleAny err $ do-    r <--      liftIO $-        Wreq.asJSON-          =<< Wreq.Session.postWith opts session url body-    return $ r ^. Wreq.responseBody-  where-    err _ = do-      $(logErrorS) "Web" "Could not get historic prices"-      return []-    body = toJSON times-    base =-      Wreq.defaults-        & Wreq.param "base" .~ [T.toUpper $ T.pack net.name]-    opts = base & Wreq.param "quote" .~ [currency]--price ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  Network ->-  Wreq.Session ->-  String ->-  Int ->-  TVar (HashMap Text BinfoTicker) ->-  m ()-price net session url pget v = forM_ purl $ \u -> forever $ do-  let err e = $(logErrorS) "Price" $ cs (show e)-  handleAny err $ do-    r <- liftIO $ Wreq.asJSON =<< Wreq.Session.get session u-    atomically . writeTVar v $ r ^. Wreq.responseBody-  threadDelay pget-  where-    purl = case code of-      Nothing -> Nothing-      Just x -> Just (url <> "?base=" <> x)-      where-        code-          | net == btc = Just "btc"-          | net == bch = Just "bch"-          | otherwise = Nothing--raise :: (MonadIO m) => Except -> WebT m a-raise err =-  lift (asks (.metrics)) >>= \case-    Nothing -> S.raise err-    Just m -> do-      req <- S.request-      mM <- case V.lookup m.key (vault req) of-        Nothing -> return Nothing-        Just t -> readTVarIO t-      let status = errStatus err-      if-          | statusIsClientError status ->-              liftIO $ do-                addClientError m.all-                forM_ mM $ \f -> addClientError (f m)-          | statusIsServerError status ->-              liftIO $ do-                addServerError m.all-                forM_ mM $ \f -> addServerError (f m)-          | otherwise ->-              return ()-      S.raise err--errStatus :: Except -> Status-errStatus ThingNotFound = status404-errStatus BadRequest = status400-errStatus UserError {} = status400-errStatus StringError {} = status400-errStatus ServerError = status500-errStatus TxIndexConflict {} = status409-errStatus ServerTimeout = status500-errStatus RequestTooLarge = status413--defHandler :: (Monad m) => Except -> WebT m ()-defHandler e = do-  setHeaders-  S.status $ errStatus e-  S.json e--handlePaths ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  WebConfig ->-  S.ScottyT Except (ReaderT WebState m) ()-handlePaths WebConfig {..} = do-  -- Block Paths-  pathCompact-    (GetBlock <$> paramLazy <*> paramDef)-    scottyBlock-    (marshalEncoding net)-    (marshalValue net)-  pathCompact-    (GetBlockBest <$> paramDef)-    scottyBlockBest-    (marshalEncoding net)-    (marshalValue net)-  pathCompact-    (GetBlockHeight <$> paramLazy <*> paramDef)-    (fmap SerialList . scottyBlockHeight)-    (list (marshalEncoding net) . (.get))-    (json_list (marshalValue net) . (.get))-  pathCompact-    (GetBlockTime <$> paramLazy <*> paramDef)-    scottyBlockTime-    (marshalEncoding net)-    (marshalValue net)-  pathCompact-    (GetBlockMTP <$> paramLazy <*> paramDef)-    scottyBlockMTP-    (marshalEncoding net)-    (marshalValue net)-  pathCompact-    (GetTx <$> paramLazy)-    scottyTx-    (marshalEncoding net)-    (marshalValue net)-  pathCompact-    (GetTxRaw <$> paramLazy)-    scottyTxRaw-    toEncoding-    toJSON-  pathCompact-    (PostTx <$> parseBody)-    scottyPostTx-    toEncoding-    toJSON-  pathCompact-    (GetMempool <$> paramOptional <*> parseOffset)-    (fmap SerialList . scottyMempool)-    toEncoding-    toJSON-  pathCompact-    (GetAddrTxs <$> paramLazy <*> parseLimits)-    (fmap SerialList . scottyAddrTxs)-    toEncoding-    toJSON-  pathCompact-    (GetAddrBalance <$> paramLazy)-    scottyAddrBalance-    (marshalEncoding net)-    (marshalValue net)-  pathCompact-    (GetAddrUnspent <$> paramLazy <*> parseLimits)-    (fmap SerialList . scottyAddrUnspent)-    (list (marshalEncoding net) . (.get))-    (json_list (marshalValue net) . (.get))-  pathCompact-    (GetPeers & return)-    (fmap SerialList . scottyPeers)-    toEncoding-    toJSON-  pathCompact-    (GetHealth & return)-    scottyHealth-    toEncoding-    toJSON-  S.get "/events" scottyEvents-  S.get "/dbstats" scottyDbStats-  unless noSlow $ do-    pathCompact-      (GetBlocks <$> param <*> paramDef)-      (fmap SerialList . scottyBlocks)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetBlockRaw <$> paramLazy)-      scottyBlockRaw-      toEncoding-      toJSON-    pathCompact-      (GetBlockBestRaw & return)-      scottyBlockBestRaw-      toEncoding-      toJSON-    pathCompact-      (GetBlockLatest <$> paramDef)-      (fmap SerialList . scottyBlockLatest)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetBlockHeights <$> param <*> paramDef)-      (fmap SerialList . scottyBlockHeights)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetBlockHeightRaw <$> paramLazy)-      scottyBlockHeightRaw-      toEncoding-      toJSON-    pathCompact-      (GetBlockTimeRaw <$> paramLazy)-      scottyBlockTimeRaw-      toEncoding-      toJSON-    pathCompact-      (GetBlockMTPRaw <$> paramLazy)-      scottyBlockMTPRaw-      toEncoding-      toJSON-    pathCompact-      (GetTxs <$> param)-      (fmap SerialList . scottyTxs)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetTxsRaw <$> param)-      scottyTxsRaw-      toEncoding-      toJSON-    pathCompact-      (GetTxsBlock <$> paramLazy)-      (fmap SerialList . scottyTxsBlock)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetTxsBlockRaw <$> paramLazy)-      scottyTxsBlockRaw-      toEncoding-      toJSON-    pathCompact-      (GetTxAfter <$> paramLazy <*> paramLazy)-      scottyTxAfter-      toEncoding-      toJSON-    pathCompact-      (GetAddrsTxs <$> param <*> parseLimits)-      (fmap SerialList . scottyAddrsTxs)-      toEncoding-      toJSON-    pathCompact-      (GetAddrTxsFull <$> paramLazy <*> parseLimits)-      (fmap SerialList . scottyAddrTxsFull)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetAddrsTxsFull <$> param <*> parseLimits)-      (fmap SerialList . scottyAddrsTxsFull)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetAddrsBalance <$> param)-      (fmap SerialList . scottyAddrsBalance)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetAddrsUnspent <$> param <*> parseLimits)-      (fmap SerialList . scottyAddrsUnspent)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetXPub <$> paramLazy <*> paramDef <*> paramDef)-      scottyXPub-      toEncoding-      toJSON-    pathCompact-      (GetXPubTxs <$> paramLazy <*> paramDef <*> parseLimits <*> paramDef)-      (fmap SerialList . scottyXPubTxs)-      toEncoding-      toJSON-    pathCompact-      (GetXPubTxsFull <$> paramLazy <*> paramDef <*> parseLimits <*> paramDef)-      (fmap SerialList . scottyXPubTxsFull)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetXPubBalances <$> paramLazy <*> paramDef <*> paramDef)-      (fmap SerialList . scottyXPubBalances)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (GetXPubUnspent <$> paramLazy <*> paramDef <*> parseLimits <*> paramDef)-      (fmap SerialList . scottyXPubUnspent)-      (list (marshalEncoding net) . (.get))-      (json_list (marshalValue net) . (.get))-    pathCompact-      (DelCachedXPub <$> paramLazy <*> paramDef)-      scottyDelXPub-      toEncoding-      toJSON-    unless noBlockchainInfo $ do-      S.post "/blockchain/multiaddr" scottyMultiAddr-      S.get "/blockchain/multiaddr" scottyMultiAddr-      S.get "/blockchain/balance" scottyShortBal-      S.post "/blockchain/balance" scottyShortBal-      S.get "/blockchain/rawaddr/:addr" scottyRawAddr-      S.get "/blockchain/address/:addr" scottyRawAddr-      S.get "/blockchain/xpub/:addr" scottyRawAddr-      S.post "/blockchain/unspent" scottyBinfoUnspent-      S.get "/blockchain/unspent" scottyBinfoUnspent-      S.get "/blockchain/rawtx/:txid" scottyBinfoTx-      S.get "/blockchain/rawblock/:block" scottyBinfoBlock-      S.get "/blockchain/latestblock" scottyBinfoLatest-      S.get "/blockchain/unconfirmed-transactions" scottyBinfoMempool-      S.get "/blockchain/block-height/:height" scottyBinfoBlockHeight-      S.get "/blockchain/blocks/:milliseconds" scottyBinfoBlocksDay-      S.get "/blockchain/export-history" scottyBinfoHistory-      S.post "/blockchain/export-history" scottyBinfoHistory-      S.get "/blockchain/q/addresstohash/:addr" scottyBinfoAddrToHash-      S.get "/blockchain/q/hashtoaddress/:hash" scottyBinfoHashToAddr-      S.get "/blockchain/q/addrpubkey/:pubkey" scottyBinfoAddrPubkey-      S.get "/blockchain/q/pubkeyaddr/:addr" scottyBinfoPubKeyAddr-      S.get "/blockchain/q/hashpubkey/:pubkey" scottyBinfoHashPubkey-      S.get "/blockchain/q/getblockcount" scottyBinfoGetBlockCount-      S.get "/blockchain/q/latesthash" scottyBinfoLatestHash-      S.get "/blockchain/q/bcperblock" scottyBinfoSubsidy-      S.get "/blockchain/q/txtotalbtcoutput/:txid" scottyBinfoTotalOut-      S.get "/blockchain/q/txtotalbtcinput/:txid" scottyBinfoTotalInput-      S.get "/blockchain/q/txfee/:txid" scottyBinfoTxFees-      S.get "/blockchain/q/txresult/:txid/:addr" scottyBinfoTxResult-      S.get "/blockchain/q/getreceivedbyaddress/:addr" scottyBinfoReceived-      S.get "/blockchain/q/getsentbyaddress/:addr" scottyBinfoSent-      S.get "/blockchain/q/addressbalance/:addr" scottyBinfoAddrBalance-      S.get "/blockchain/q/addressfirstseen/:addr" scottyFirstSeen-  where-    json_list f = toJSONList . map f-    net = store.net--pathCompact ::-  (ApiResource a b, MonadIO m) =>-  WebT m a ->-  (a -> WebT m b) ->-  (b -> Encoding) ->-  (b -> Value) ->-  S.ScottyT Except (ReaderT WebState m) ()-pathCompact parser action encJson encValue =-  pathCommon parser action encJson encValue False--pathCommon ::-  (ApiResource a b, MonadIO m) =>-  WebT m a ->-  (a -> WebT m b) ->-  (b -> Encoding) ->-  (b -> Value) ->-  Bool ->-  S.ScottyT Except (ReaderT WebState m) ()-pathCommon parser action encJson encValue pretty =-  S.addroute (resourceMethod proxy) (capturePath proxy) $ do-    setHeaders-    proto <- setupContentType pretty-    apiRes <- parser-    res <- action apiRes-    S.raw $ protoSerial proto encJson encValue res-  where-    toProxy :: WebT m a -> Proxy a-    toProxy = const Proxy-    proxy = toProxy parser--streamEncoding :: (Monad m) => Encoding -> WebT m ()-streamEncoding e = do-  S.setHeader "Content-Type" "application/json; charset=utf-8"-  S.raw (encodingToLazyByteString e)--protoSerial ::-  (Serial a) =>-  SerialAs ->-  (a -> Encoding) ->-  (a -> Value) ->-  a ->-  L.ByteString-protoSerial SerialAsBinary _ _ = runPutL . serialize-protoSerial SerialAsJSON f _ = encodingToLazyByteString . f-protoSerial SerialAsPrettyJSON _ g =-  encodePretty' defConfig {confTrailingNewline = True} . g--setHeaders :: (Monad m, S.ScottyError e) => ActionT e m ()-setHeaders = S.setHeader "Access-Control-Allow-Origin" "*"--waiExcept :: Status -> Except -> Response-waiExcept s e =-  responseLBS s hs e'-  where-    hs =-      [ ("Access-Control-Allow-Origin", "*"),-        ("Content-Type", "application/json")-      ]-    e' = A.encode e--setupJSON :: (Monad m) => Bool -> ActionT Except m SerialAs-setupJSON pretty = do-  S.setHeader "Content-Type" "application/json"-  p <- S.param "pretty" `S.rescue` const (return pretty)-  return $ if p then SerialAsPrettyJSON else SerialAsJSON--setupBinary :: (Monad m) => ActionT Except m SerialAs-setupBinary = do-  S.setHeader "Content-Type" "application/octet-stream"-  return SerialAsBinary--setupContentType :: (Monad m) => Bool -> ActionT Except m SerialAs-setupContentType pretty = do-  accept <- S.header "accept"-  maybe (setupJSON pretty) setType accept-  where-    setType "application/octet-stream" = setupBinary-    setType _ = setupJSON pretty---- GET Block / GET Blocks ----scottyBlock ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetBlock -> WebT m BlockData-scottyBlock (GetBlock h (NoTx noTx)) = do-  setMetrics (.block)-  getBlock h >>= \case-    Nothing ->-      raise ThingNotFound-    Just b -> do-      addItemCount 1-      return $ pruneTx noTx b--getBlocks ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  [H.BlockHash] ->-  Bool ->-  WebT m [BlockData]-getBlocks hs notx =-  (pruneTx notx <$>) . catMaybes <$> mapM getBlock (nub hs)--scottyBlocks ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetBlocks -> WebT m [BlockData]-scottyBlocks (GetBlocks hs (NoTx notx)) = do-  setMetrics (.block)-  bs <- getBlocks hs notx-  addItemCount (length bs)-  return bs--pruneTx :: Bool -> BlockData -> BlockData-pruneTx False b = b-pruneTx True BlockData {..} = BlockData {txs = take 1 txs, ..}---- GET BlockRaw ----scottyBlockRaw ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockRaw ->-  WebT m (RawResult H.Block)-scottyBlockRaw (GetBlockRaw h) = do-  setMetrics (.blockRaw)-  b <- getRawBlock h-  addItemCount (1 + length b.txs)-  return $ RawResult b--getRawBlock ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  H.BlockHash ->-  WebT m H.Block-getRawBlock h = do-  b <- getBlock h >>= maybe (raise ThingNotFound) return-  lift (toRawBlock b)--toRawBlock :: (MonadUnliftIO m, StoreReadBase m) => BlockData -> m H.Block-toRawBlock b = do-  let ths = b.txs-  txs <- mapM f ths-  return H.Block {header = b.header, txs}-  where-    f x = withRunInIO $ \run ->-      unsafeInterleaveIO . run $-        getTransaction x >>= \case-          Nothing -> undefined-          Just t -> return $ transactionData t---- GET BlockBest / BlockBestRaw ----scottyBlockBest ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetBlockBest -> WebT m BlockData-scottyBlockBest (GetBlockBest (NoTx notx)) = do-  setMetrics (.block)-  getBestBlock >>= \case-    Nothing -> raise ThingNotFound-    Just bb ->-      getBlock bb >>= \case-        Nothing -> raise ThingNotFound-        Just b -> do-          addItemCount 1-          return $ pruneTx notx b--scottyBlockBestRaw ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockBestRaw ->-  WebT m (RawResult H.Block)-scottyBlockBestRaw _ = do-  setMetrics (.blockRaw)-  getBestBlock >>= \case-    Nothing -> raise ThingNotFound-    Just bb -> do-      b <- getRawBlock bb-      addItemCount (1 + length b.txs)-      return $ RawResult b---- GET BlockLatest ----scottyBlockLatest ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockLatest ->-  WebT m [BlockData]-scottyBlockLatest (GetBlockLatest (NoTx noTx)) = do-  setMetrics (.block)-  blocks <--    getBestBlock-      >>= maybe-        (raise ThingNotFound)-        (go [] <=< getBlock)-  addItemCount (length blocks)-  return blocks-  where-    go acc Nothing = return $ reverse acc-    go acc (Just b)-      | b.height <= 0 = return $ reverse acc-      | length acc == 99 = return . reverse $ pruneTx noTx b : acc-      | otherwise = go (pruneTx noTx b : acc) =<< getBlock b.header.prev---- GET BlockHeight / BlockHeights / BlockHeightRaw ----scottyBlockHeight ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetBlockHeight -> WebT m [BlockData]-scottyBlockHeight (GetBlockHeight h (NoTx notx)) = do-  setMetrics (.block)-  blocks <- (`getBlocks` notx) =<< getBlocksAtHeight (fromIntegral h)-  addItemCount (length blocks)-  return blocks--scottyBlockHeights ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockHeights ->-  WebT m [BlockData]-scottyBlockHeights (GetBlockHeights (HeightsParam heights) (NoTx notx)) = do-  setMetrics (.block)-  bhs <- concat <$> mapM getBlocksAtHeight (fromIntegral <$> heights)-  blocks <- getBlocks bhs notx-  addItemCount (length blocks)-  return blocks--scottyBlockHeightRaw ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockHeightRaw ->-  WebT m (RawResultList H.Block)-scottyBlockHeightRaw (GetBlockHeightRaw h) = do-  setMetrics (.blockRaw)-  blocks <- mapM getRawBlock =<< getBlocksAtHeight (fromIntegral h)-  addItemCount (length blocks + sum (map (length . (.txs)) blocks))-  return $ RawResultList blocks---- GET BlockTime / BlockTimeRaw ----scottyBlockTime ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockTime ->-  WebT m BlockData-scottyBlockTime (GetBlockTime (TimeParam t) (NoTx notx)) = do-  setMetrics (.block)-  ch <- lift $ asks (.config.store.chain)-  blockAtOrBefore ch t >>= \case-    Nothing -> raise ThingNotFound-    Just b -> do-      addItemCount 1-      return $ pruneTx notx b--scottyBlockMTP ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockMTP ->-  WebT m BlockData-scottyBlockMTP (GetBlockMTP (TimeParam t) (NoTx notx)) = do-  setMetrics (.block)-  ch <- lift $ asks (.config.store.chain)-  blockAtOrAfterMTP ch t >>= \case-    Nothing -> raise ThingNotFound-    Just b -> do-      addItemCount 1-      return $ pruneTx notx b--scottyBlockTimeRaw ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockTimeRaw ->-  WebT m (RawResult H.Block)-scottyBlockTimeRaw (GetBlockTimeRaw (TimeParam t)) = do-  setMetrics (.blockRaw)-  ch <- lift $ asks (.config.store.chain)-  blockAtOrBefore ch t >>= \case-    Nothing -> raise ThingNotFound-    Just b -> do-      raw <- lift $ toRawBlock b-      addItemCount (1 + length raw.txs)-      return $ RawResult raw--scottyBlockMTPRaw ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetBlockMTPRaw ->-  WebT m (RawResult H.Block)-scottyBlockMTPRaw (GetBlockMTPRaw (TimeParam t)) = do-  setMetrics (.blockRaw)-  ch <- lift $ asks (.config.store.chain)-  blockAtOrAfterMTP ch t >>= \case-    Nothing -> raise ThingNotFound-    Just b -> do-      raw <- lift $ toRawBlock b-      addItemCount (1 + length raw.txs)-      return $ RawResult raw---- GET Transactions ----scottyTx :: (MonadUnliftIO m, MonadLoggerIO m) => GetTx -> WebT m Transaction-scottyTx (GetTx txid) = do-  setMetrics (.tx)-  getTransaction txid >>= \case-    Nothing -> raise ThingNotFound-    Just tx -> do-      addItemCount 1-      return tx--scottyTxs ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetTxs -> WebT m [Transaction]-scottyTxs (GetTxs txids) = do-  setMetrics (.tx)-  txs <- catMaybes <$> mapM f (nub txids)-  addItemCount (length txs)-  return txs-  where-    f x = lift $-      withRunInIO $ \run ->-        unsafeInterleaveIO . run $-          getTransaction x--scottyTxRaw ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetTxRaw -> WebT m (RawResult Tx)-scottyTxRaw (GetTxRaw txid) = do-  setMetrics (.txRaw)-  getTransaction txid >>= \case-    Nothing -> raise ThingNotFound-    Just tx -> do-      addItemCount 1-      return $ RawResult (transactionData tx)--scottyTxsRaw ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetTxsRaw ->-  WebT m (RawResultList Tx)-scottyTxsRaw (GetTxsRaw txids) = do-  setMetrics (.txRaw)-  txs <- catMaybes <$> mapM f (nub txids)-  addItemCount (length txs)-  return $ RawResultList $ transactionData <$> txs-  where-    f x = lift $-      withRunInIO $ \run ->-        unsafeInterleaveIO . run $-          getTransaction x--getTxsBlock ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  H.BlockHash ->-  WebT m [Transaction]-getTxsBlock h =-  getBlock h >>= \case-    Nothing -> raise ThingNotFound-    Just b -> do-      txs <- mapM f b.txs-      addItemCount (length txs)-      return txs-  where-    f x = lift $-      withRunInIO $ \run ->-        unsafeInterleaveIO . run $-          getTransaction x >>= \case-            Nothing -> undefined-            Just t -> return t--scottyTxsBlock ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetTxsBlock ->-  WebT m [Transaction]-scottyTxsBlock (GetTxsBlock h) = do-  setMetrics (.txBlock)-  txs <- getTxsBlock h-  addItemCount (length txs)-  return txs--scottyTxsBlockRaw ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetTxsBlockRaw ->-  WebT m (RawResultList Tx)-scottyTxsBlockRaw (GetTxsBlockRaw h) = do-  setMetrics (.txBlockRaw)-  txs <- fmap transactionData <$> getTxsBlock h-  addItemCount (length txs)-  return $ RawResultList txs---- GET TransactionAfterHeight ----scottyTxAfter ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetTxAfter ->-  WebT m (GenericResult (Maybe Bool))-scottyTxAfter (GetTxAfter txid height) = do-  setMetrics (.txAfter)-  (result, count) <- cbAfterHeight (fromIntegral height) txid-  addItemCount count-  return $ GenericResult result---- | Check if any of the ancestors of this transaction is a coinbase after the--- specified height. Returns 'Nothing' if answer cannot be computed before--- hitting limits.-cbAfterHeight ::-  (MonadIO m, StoreReadBase m) =>-  H.BlockHeight ->-  TxHash ->-  m (Maybe Bool, Int)-cbAfterHeight height txid =-  inputs n HashSet.empty HashSet.empty [txid]-  where-    n = 10000-    inputs 0 _ _ [] = return (Nothing, 10000)-    inputs i is ns [] =-      let is' = HashSet.union is ns-          ns' = HashSet.empty-          ts = HashSet.toList (HashSet.difference ns is)-       in case ts of-            [] -> return (Just False, n - i)-            _ -> inputs i is' ns' ts-    inputs i is ns (t : ts) =-      getTransaction t >>= \case-        Nothing -> return (Nothing, n - i)-        Just tx-          | height_check tx ->-              if cb_check tx-                then return (Just True, n - i + 1)-                else-                  let ns' = HashSet.union (ins tx) ns-                   in inputs (i - 1) is ns' ts-          | otherwise -> inputs (i - 1) is ns ts-    cb_check = any isCoinbase . (.inputs)-    ins = HashSet.fromList . map (.outpoint.hash) . (.inputs)-    height_check tx =-      case tx.block of-        BlockRef h _ -> h > height-        MemRef _ -> True---- POST Transaction ----scottyPostTx :: (MonadUnliftIO m, MonadLoggerIO m) => PostTx -> WebT m TxId-scottyPostTx (PostTx tx) = do-  setMetrics (.txPost)-  addItemCount 1-  lift (asks (.config)) >>= \cfg ->-    lift (publishTx cfg tx) >>= \case-      Right () -> return (TxId (txHash tx))-      Left e@(PubReject _) -> raise $ UserError (show e)-      _ -> raise ServerError---- | Publish a new transaction to the network.-publishTx ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  WebConfig ->-  Tx ->-  m (Either PubExcept ())-publishTx cfg tx =-  withSubscription pub $ \s ->-    getTransaction (txHash tx) >>= \case-      Just _ -> return $ Right ()-      Nothing -> go s-  where-    pub = cfg.store.pub-    mgr = cfg.store.peerMgr-    net = cfg.store.net-    go s =-      getPeers mgr >>= \case-        [] -> return $ Left PubNoPeers-        OnlinePeer {mailbox = p} : _ -> do-          MTx tx `sendMessage` p-          let v =-                if net.segWit-                  then InvWitnessTx-                  else InvTx-          sendMessage-            (MGetData (GetData [InvVector v (txHash tx).get]))-            p-          f p s-    t = 5 * 1000 * 1000-    f p s-      | cfg.noMempool = return $ Right ()-      | otherwise =-          liftIO (UnliftIO.timeout t (g p s)) >>= \case-            Nothing -> return $ Left PubTimeout-            Just (Left e) -> return $ Left e-            Just (Right ()) -> return $ Right ()-    g p s =-      receive s >>= \case-        StoreTxReject p' h' c _-          | p == p' && h' == txHash tx -> return . Left $ PubReject c-        StorePeerDisconnected p'-          | p == p' -> return $ Left PubPeerDisconnected-        StoreMempoolNew h'-          | h' == txHash tx -> return $ Right ()-        _ -> g p s---- GET Mempool / Events ----scottyMempool ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetMempool -> WebT m [TxHash]-scottyMempool (GetMempool limitM (OffsetParam o)) = do-  setMetrics (.mempool)-  WebLimits {..} <- lift $ asks (.config.limits)-  let wl' = WebLimits {maxItemCount = 0, ..}-      l = Limits (validateLimit wl' False limitM) (fromIntegral o) Nothing-  ths <- map snd . applyLimits l <$> getMempool-  addItemCount 1-  return ths--webSocketEvents :: WebState -> Middleware-webSocketEvents s =-  websocketsOr defaultConnectionOptions events-  where-    pub = s.config.store.pub-    gauge = (.events) <$> s.metrics-    events pending = withSubscription pub $ \sub -> do-      let path = requestPath $ pendingRequest pending-      if path == "/events"-        then do-          conn <- acceptRequest pending-          forever $-            receiveEvent sub >>= \case-              Nothing -> return ()-              Just event -> sendTextData conn (A.encode event)-        else-          rejectRequestWith-            pending-            WebSockets.defaultRejectRequest-              { WebSockets.rejectBody =-                  L.toStrict $ A.encode ThingNotFound,-                WebSockets.rejectCode =-                  404,-                WebSockets.rejectMessage =-                  "Not Found",-                WebSockets.rejectHeaders =-                  [("Content-Type", "application/json")]-              }--scottyEvents :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyEvents =-  withGaugeIncrease (.events) $ do-    setHeaders-    proto <- setupContentType False-    pub <- lift $ asks (.config.store.pub)-    S.stream $ \io flush' ->-      withSubscription pub $ \sub ->-        forever $ do-          flush'-          receiveEvent sub >>= \case-            Nothing -> return ()-            Just msg -> io (serial proto msg)-  where-    serial proto e =-      lazyByteString $-        protoSerial proto toEncoding toJSON e <> newLine proto-    newLine SerialAsBinary = mempty-    newLine SerialAsJSON = "\n"-    newLine SerialAsPrettyJSON = mempty--receiveEvent :: Inbox StoreEvent -> IO (Maybe Event)-receiveEvent sub =-  go <$> receive sub-  where-    go = \case-      StoreBestBlock b -> Just (EventBlock b)-      StoreMempoolNew t -> Just (EventTx t)-      StoreMempoolDelete t -> Just (EventTx t)-      _ -> Nothing---- GET Address Transactions ----scottyAddrTxs ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrTxs -> WebT m [TxRef]-scottyAddrTxs (GetAddrTxs addr pLimits) = do-  setMetrics (.addressTx)-  txs <- getAddressTxs addr =<< paramToLimits False pLimits-  addItemCount (length txs)-  return txs--scottyAddrsTxs ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsTxs -> WebT m [TxRef]-scottyAddrsTxs (GetAddrsTxs addrs pLimits) = do-  setMetrics (.addressTx)-  txs <- getAddressesTxs addrs =<< paramToLimits False pLimits-  addItemCount (length txs)-  return txs--scottyAddrTxsFull ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetAddrTxsFull ->-  WebT m [Transaction]-scottyAddrTxsFull (GetAddrTxsFull addr pLimits) = do-  setMetrics (.addressTxFull)-  txs <- getAddressTxs addr =<< paramToLimits True pLimits-  ts <- catMaybes <$> mapM (getTransaction . (.txid)) txs-  addItemCount (length ts)-  return ts--scottyAddrsTxsFull ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetAddrsTxsFull ->-  WebT m [Transaction]-scottyAddrsTxsFull (GetAddrsTxsFull addrs pLimits) = do-  setMetrics (.addressTxFull)-  txs <- getAddressesTxs addrs =<< paramToLimits True pLimits-  ts <- catMaybes <$> mapM (getTransaction . (.txid)) txs-  addItemCount (length ts)-  return ts--scottyAddrBalance ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetAddrBalance ->-  WebT m Balance-scottyAddrBalance (GetAddrBalance addr) = do-  setMetrics (.addressBalance)-  addItemCount 1-  getDefaultBalance addr--scottyAddrsBalance ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsBalance -> WebT m [Balance]-scottyAddrsBalance (GetAddrsBalance addrs) = do-  setMetrics (.addressBalance)-  balances <- getBalances addrs-  addItemCount (length balances)-  return balances--scottyAddrUnspent ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrUnspent -> WebT m [Unspent]-scottyAddrUnspent (GetAddrUnspent addr pLimits) = do-  setMetrics (.addressUnspent)-  unspents <- getAddressUnspents addr =<< paramToLimits False pLimits-  addItemCount (length unspents)-  return unspents--scottyAddrsUnspent ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsUnspent -> WebT m [Unspent]-scottyAddrsUnspent (GetAddrsUnspent addrs pLimits) = do-  setMetrics (.addressUnspent)-  unspents <- getAddressesUnspents addrs =<< paramToLimits False pLimits-  addItemCount (length unspents)-  return unspents---- GET XPubs ----scottyXPub ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetXPub -> WebT m XPubSummary-scottyXPub (GetXPub xpub deriv (NoCache noCache)) = do-  setMetrics (.xpub)-  let xspec = XPubSpec xpub deriv-  xbals <- lift . runNoCache noCache $ xPubBals xspec-  addItemCount (length xbals)-  return $ xPubSummary xspec xbals--scottyDelXPub ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  DelCachedXPub ->-  WebT m (GenericResult Bool)-scottyDelXPub (DelCachedXPub xpub deriv) = do-  setMetrics (.xpubDelete)-  let xspec = XPubSpec xpub deriv-  cacheM <- lift $ asks (.config.store.cache)-  n <- lift $ withCache cacheM (cacheDelXPubs [xspec])-  addItemCount (fromIntegral n)-  return (GenericResult (n > 0))--getXPubTxs ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  XPubKey ->-  DeriveType ->-  LimitsParam ->-  Bool ->-  WebT m [TxRef]-getXPubTxs xpub deriv plimits nocache = do-  limits <- paramToLimits False plimits-  let xspec = XPubSpec xpub deriv-  xbals <- xPubBals xspec-  addItemCount (length xbals)-  lift . runNoCache nocache $ xPubTxs xspec xbals limits--scottyXPubTxs ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetXPubTxs -> WebT m [TxRef]-scottyXPubTxs (GetXPubTxs xpub deriv plimits (NoCache nocache)) = do-  setMetrics (.xpubTx)-  txs <- getXPubTxs xpub deriv plimits nocache-  addItemCount (length txs)-  return txs--scottyXPubTxsFull ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetXPubTxsFull ->-  WebT m [Transaction]-scottyXPubTxsFull (GetXPubTxsFull xpub deriv plimits (NoCache nocache)) = do-  setMetrics (.xpubTxFull)-  refs <- getXPubTxs xpub deriv plimits nocache-  txs <--    fmap catMaybes $-      lift . runNoCache nocache $-        mapM (getTransaction . (.txid)) refs-  addItemCount (length txs)-  return txs--scottyXPubBalances ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetXPubBalances -> WebT m [XPubBal]-scottyXPubBalances (GetXPubBalances xpub deriv (NoCache noCache)) = do-  setMetrics (.xpubBalance)-  balances <- lift (runNoCache noCache (xPubBals spec))-  addItemCount (length balances)-  return balances-  where-    spec = XPubSpec xpub deriv--scottyXPubUnspent ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetXPubUnspent ->-  WebT m [XPubUnspent]-scottyXPubUnspent (GetXPubUnspent xpub deriv pLimits (NoCache noCache)) = do-  setMetrics (.xpubUnspent)-  limits <- paramToLimits False pLimits-  let xspec = XPubSpec xpub deriv-  xbals <- xPubBals xspec-  addItemCount (length xbals)-  unspents <- lift . runNoCache noCache $ xPubUnspents xspec xbals limits-  addItemCount (length unspents)-  return unspents-------------------------------------------- Blockchain.info API Compatibility --------------------------------------------netBinfoSymbol :: Network -> BinfoSymbol-netBinfoSymbol net-  | net == btc =-      BinfoSymbol-        { code = "BTC",-          symbol = "BTC",-          name = "Bitcoin",-          conversion = 100 * 1000 * 1000,-          after = True,-          local = False-        }-  | net == bch =-      BinfoSymbol-        { code = "BCH",-          symbol = "BCH",-          name = "Bitcoin Cash",-          conversion = 100 * 1000 * 1000,-          after = True,-          local = False-        }-  | otherwise =-      BinfoSymbol-        { code = "XTS",-          symbol = "¤",-          name = "Test",-          conversion = 100 * 1000 * 1000,-          after = False,-          local = False-        }--binfoTickerToSymbol :: Text -> BinfoTicker -> BinfoSymbol-binfoTickerToSymbol code BinfoTicker {..} =-  BinfoSymbol-    { code,-      symbol,-      name,-      conversion = 100 * 1000 * 1000 / fifteen, -- sat/usd-      after = False,-      local = True-    }-  where-    name = case code of-      "EUR" -> "Euro"-      "USD" -> "U.S. dollar"-      "GBP" -> "British pound"-      x -> x--getBinfoAddrsParam ::-  (MonadIO m) =>-  Text ->-  WebT m (HashSet BinfoAddr)-getBinfoAddrsParam name = do-  net <- lift $ asks (.config.store.net)-  ctx <- lift $ asks (.config.store.ctx)-  p <- S.param (cs name) `S.rescue` const (return "")-  if T.null p-    then return HashSet.empty-    else case parseBinfoAddr net ctx p of-      Nothing -> raise (UserError "invalid address")-      Just xs -> return $ HashSet.fromList xs--getBinfoActive ::-  (MonadIO m) =>-  WebT m (HashSet XPubSpec, HashSet Address)-getBinfoActive = do-  active <- getBinfoAddrsParam "active"-  p2sh <- getBinfoAddrsParam "activeP2SH"-  bech32 <- getBinfoAddrsParam "activeBech32"-  let xspec d b = (`XPubSpec` d) <$> xpub b-      xspecs =-        HashSet.fromList $-          concat-            [ mapMaybe (xspec DeriveNormal) (HashSet.toList active),-              mapMaybe (xspec DeriveP2SH) (HashSet.toList p2sh),-              mapMaybe (xspec DeriveP2WPKH) (HashSet.toList bech32)-            ]-      addrs = HashSet.fromList . mapMaybe addr $ HashSet.toList active-  return (xspecs, addrs)-  where-    addr (BinfoAddr a) = Just a-    addr (BinfoXpub _) = Nothing-    xpub (BinfoXpub x) = Just x-    xpub (BinfoAddr _) = Nothing--getNumTxId :: (MonadIO m) => WebT m Bool-getNumTxId = fmap not $ S.param "txidindex" `S.rescue` const (return False)--getChainHeight :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m H.BlockHeight-getChainHeight = do-  ch <- lift $ asks (.config.store.chain)-  (.height) <$> chainGetBest ch--scottyBinfoUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoUnspent = do-  setMetrics (.binfoUnspent)-  (xspecs, addrs) <- getBinfoActive-  numtxid <- getNumTxId-  limit <- get_limit-  min_conf <- get_min_conf-  net <- lift $ asks (.config.store.net)-  ctx <- lift $ asks (.config.store.ctx)-  height <- getChainHeight-  let mn BinfoUnspent {..} = min_conf > confirmations-  xbals <- lift $ getXBals xspecs-  addItemCount . sum . map length $ HashMap.elems xbals-  counter <- getItemCounter-  bus <--    lift . runConduit $-      getBinfoUnspents counter numtxid height xbals xspecs addrs-        .| (dropWhileC mn >> takeC limit .| sinkList)-  setHeaders-  streamEncoding (marshalEncoding (net, ctx) (BinfoUnspents bus))-  where-    get_limit = fmap (min 1000) $ S.param "limit" `S.rescue` const (return 250)-    get_min_conf = S.param "confirmations" `S.rescue` const (return 0)--getBinfoUnspents ::-  (StoreReadExtra m, MonadIO m) =>-  (Int -> m ()) ->-  Bool ->-  H.BlockHeight ->-  HashMap XPubSpec [XPubBal] ->-  HashSet XPubSpec ->-  HashSet Address ->-  ConduitT () BinfoUnspent m ()-getBinfoUnspents counter numtxid height xbals xspecs addrs = do-  cs' <- conduits-  joinDescStreams cs' .| mapC (uncurry binfo)-  where-    binfo Unspent {..} xp =-      let conf = case block of-            MemRef _ -> 0-            BlockRef h _ -> height - h + 1-          hash = outpoint.hash-          idx = outpoint.index-          val = value-          script = script-          txi = encodeBinfoTxId numtxid hash-       in BinfoUnspent-            { txid = hash,-              index = idx,-              script,-              value = val,-              confirmations = fromIntegral conf,-              txidx = txi,-              xpub = xp-            }-    conduits = (<>) <$> xconduits <*> pure acounduits-    xconduits = lift $ do-      let f x (XPubUnspent u p) =-            let path = toSoft (listToPath p)-                xp = BinfoXPubPath x.key <$> path-             in (u, xp)-          g x = do-            let h l = do-                  us <- xPubUnspents x (xBals x xbals) l-                  counter (length us)-                  return us-                l = let Limits {..} = def in Limits {limit = 16, ..}-            return $ streamThings h Nothing l .| mapC (f x)-      mapM g (HashSet.toList xspecs)-    acounduits =-      let f u = (u, Nothing)-          h a l = do-            us <- getAddressUnspents a l-            counter (length us)-            return us-          l = let Limits {..} = def in Limits {limit = 16, ..}-          g a = streamThings (h a) Nothing l .| mapC f-       in map g (HashSet.toList addrs)--getXBals ::-  (StoreReadExtra m) =>-  HashSet XPubSpec ->-  m (HashMap XPubSpec [XPubBal])-getXBals =-  fmap HashMap.fromList . mapM f . HashSet.toList-  where-    f x = (x,) . filter (not . nullBalance . (.balance)) <$> xPubBals x--xBals :: XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]-xBals = HashMap.findWithDefault []--getBinfoTxs ::-  (StoreReadExtra m, MonadIO m) =>-  (Int -> m ()) -> -- counter-  HashMap XPubSpec [XPubBal] -> -- xpub balances-  HashMap Address (Maybe BinfoXPubPath) -> -- address book-  HashSet XPubSpec -> -- show xpubs-  HashSet Address -> -- show addrs-  HashSet Address -> -- balance addresses-  BinfoFilter ->-  Bool -> -- numtxid-  Bool -> -- prune outputs-  Int64 -> -- starting balance-  ConduitT () BinfoTx m ()-getBinfoTxs-  counter-  xbals-  abook-  sxspecs-  saddrs-  baddrs-  bfilter-  numtxid-  prune-  bal = do-    cs' <- conduits-    joinDescStreams cs' .| go bal-    where-      sxspecs_ls = HashSet.toList sxspecs-      saddrs_ls = HashSet.toList saddrs-      conduits =-        (<>)-          <$> mapM xpub_c sxspecs_ls-          <*> pure (map addr_c saddrs_ls)-      xpub_c x = do-        let f l = do-              ts <- xPubTxs x (xBals x xbals) l-              counter (length ts)-              return ts-            l = let Limits {..} = def in Limits {limit = 16, ..}-        lift . return $-          streamThings f (Just (.txid)) l-      addr_c a = do-        let f l = do-              as <- getAddressTxs a l-              counter (length as)-              return as-            l = let Limits {..} = def in Limits {limit = 16, ..}-        streamThings f (Just (.txid)) l-      binfo_tx = toBinfoTx numtxid abook prune-      compute_bal_change BinfoTx {..} =-        let ins = map (.output) inputs-            out = outputs-            f b BinfoTxOutput {..} =-              let val = fromIntegral value-               in case address of-                    Nothing -> 0-                    Just a-                      | a `HashSet.member` baddrs ->-                          if b then val else negate val-                      | otherwise -> 0-         in sum $ map (f False) ins <> map (f True) out-      go b =-        await >>= \case-          Nothing -> return ()-          Just (TxRef _ t) ->-            lift (getTransaction t) >>= \case-              Nothing -> go b-              Just x -> do-                lift $ counter 1-                let a = binfo_tx b x-                    b' = b - compute_bal_change a-                    c = isJust a.blockHeight-                    Just (d, _) = a.balance-                    r = d + fromIntegral a.fee-                case bfilter of-                  BinfoFilterAll ->-                    yield a >> go b'-                  BinfoFilterSent-                    | 0 > r -> yield a >> go b'-                    | otherwise -> go b'-                  BinfoFilterReceived-                    | r > 0 -> yield a >> go b'-                    | otherwise -> go b'-                  BinfoFilterMoved-                    | r == 0 -> yield a >> go b'-                    | otherwise -> go b'-                  BinfoFilterConfirmed-                    | c -> yield a >> go b'-                    | otherwise -> go b'-                  BinfoFilterMempool-                    | c -> return ()-                    | otherwise -> yield a >> go b'--getCashAddr :: (Monad m) => WebT m Bool-getCashAddr = S.param "cashaddr" `S.rescue` const (return False)--getAddress :: (Monad m, MonadUnliftIO m) => TL.Text -> WebT m Address-getAddress param' = do-  txt <- S.param param'-  net <- lift $ asks (.config.store.net)-  case textToAddr net txt of-    Nothing -> raise ThingNotFound-    Just a -> return a--getBinfoAddr :: (Monad m) => TL.Text -> WebT m BinfoAddr-getBinfoAddr param' = do-  txt <- S.param param'-  net <- lift $ asks (.config.store.net)-  ctx <- lift $ asks (.config.store.ctx)-  let x =-        BinfoAddr-          <$> textToAddr net txt-          <|> BinfoXpub <$> xPubImport net ctx txt-  maybe S.next return x--scottyBinfoHistory :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoHistory = do-  setMetrics (.binfoExportHistory)-  (xspecs, addrs) <- getBinfoActive-  (startM, endM) <- get_dates-  (code, price') <- getPrice-  xbals <- getXBals xspecs-  addItemCount . sum . map length $ HashMap.elems xbals-  counter <- getItemCounter-  let xaddrs = HashSet.fromList $ concatMap (map get_addr) (HashMap.elems xbals)-      aaddrs = xaddrs <> addrs-      cur = price'.fifteen-      cs' = conduits counter (HashMap.toList xbals) addrs endM-  txs <--    lift $-      runConduit $-        joinDescStreams cs'-          .| takeWhileC (is_newer startM)-          .| concatMapMC get_transaction-          .| sinkList-  addItemCount (length txs)-  let times = map (\Transaction {..} -> timestamp) txs-  net <- lift $ asks (.config.store.net)-  url <- lift $ asks (.config.priceHistoryURL)-  session <- lift $ asks (.session)-  rates <- map (.price) <$> lift (getRates net session url code times)-  addItemCount (length rates)-  let hs = zipWith (convert cur aaddrs) txs (rates <> repeat 0.0)-  setHeaders-  streamEncoding $ toEncoding hs-  where-    is_newer (Just b@BlockData {}) TxRef {block = t@BlockRef {}} =-      b.height <= t.height-    is_newer Nothing TxRef {} = True-    get_addr = (.balance.address)-    get_transaction TxRef {txid = h} =-      getTransaction h-    convert cur addrs tx rate =-      let ins = tx.inputs-          outs = tx.outputs-          fins = filter (input_addr addrs) ins-          fouts = filter (output_addr addrs) outs-          vin = fromIntegral . sum $ map (.value) fins-          vout = fromIntegral . sum $ map (.value) fouts-          fee = tx.fee-          v = vout - vin-          t = tx.timestamp-          h = txHash $ transactionData tx-       in toBinfoHistory v t rate cur fee h-    input_addr addrs' StoreInput {address = Just a} =-      a `HashSet.member` addrs'-    input_addr _ _ = False-    output_addr addrs' StoreOutput {address = Just a} =-      a `HashSet.member` addrs'-    output_addr _ _ = False-    get_dates = do-      BinfoDate start <- S.param "start"-      BinfoDate end' <- S.param "end"-      let end = end' + 24 * 60 * 60-      ch <- lift $ asks (.config.store.chain)-      startM <- blockAtOrAfter ch start-      endM <- blockAtOrBefore ch end-      return (startM, endM)-    conduits counter xpubs addrs endM =-      map (uncurry (xpub_c counter endM)) xpubs-        <> map (addr_c counter endM) (HashSet.toList addrs)-    addr_c counter endM a = do-      let f l = do-            ts <- getAddressTxs a l-            counter (length ts)-            return ts-          l =-            let Limits {..} = def-             in Limits-                  { limit = 16,-                    start = AtBlock . (.height) <$> endM,-                    ..-                  }-      streamThings f (Just (.txid)) l-    xpub_c counter endM x bs = do-      let f l = do-            ts <- xPubTxs x bs l-            counter (length ts)-            return ts-          l =-            let Limits {..} = def-             in Limits-                  { limit = 16,-                    start = AtBlock . (.height) <$> endM,-                    ..-                  }-      streamThings f (Just (.txid)) l--getPrice :: (MonadIO m) => WebT m (Text, BinfoTicker)-getPrice = do-  code <- T.toUpper <$> S.param "currency" `S.rescue` const (return "USD")-  ticker <- lift $ asks (.ticker)-  prices <- readTVarIO ticker-  case HashMap.lookup code prices of-    Nothing -> return (code, def)-    Just p -> return (code, p)--getSymbol :: (MonadIO m) => WebT m BinfoSymbol-getSymbol = uncurry binfoTickerToSymbol <$> getPrice--scottyBinfoBlocksDay :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoBlocksDay = do-  setMetrics (.binfoBlock)-  t <- min h . (`div` 1000) <$> S.param "milliseconds"-  ch <- lift $ asks (.config.store.chain)-  m <- blockAtOrBefore ch t-  bs <- go (d t) m-  addItemCount (length bs)-  streamEncoding $ toEncoding $ map toBinfoBlockInfo bs-  where-    h = fromIntegral (maxBound :: H.Timestamp)-    d = subtract (24 * 3600)-    go _ Nothing = return []-    go t (Just b)-      | b.header.timestamp <= fromIntegral t =-          return []-      | otherwise = do-          b' <- getBlock b.header.prev-          (b :) <$> go t b'--scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyMultiAddr = do-  setMetrics (.binfoMultiaddr)-  (addrs', _, saddrs, sxpubs, xspecs) <- get_addrs-  numtxid <- getNumTxId-  cashaddr <- getCashAddr-  local' <- getSymbol-  offset <- getBinfoOffset-  n <- getBinfoCount "n"-  prune <- get_prune-  fltr <- get_filter-  xbals <- getXBals xspecs-  addItemCount . sum . map length $ HashMap.elems xbals-  xtxns <- get_xpub_tx_count xbals xspecs-  addItemCount (length xtxns)-  let sxbals = only_show_xbals sxpubs xbals-      xabals = compute_xabals xbals-      addrs = addrs' `HashSet.difference` HashMap.keysSet xabals-  abals <- get_abals addrs-  addItemCount (length abals)-  let sxspecs = only_show_xspecs sxpubs xspecs-      sxabals = compute_xabals sxbals-      sabals = only_show_abals saddrs abals-      sallbals = sabals <> sxabals-      sbal = compute_bal sallbals-      allbals = abals <> xabals-      abook = compute_abook addrs xbals-      sxaddrs = compute_xaddrs sxbals-      salladdrs = saddrs <> sxaddrs-      bal = compute_bal allbals-      ibal = fromIntegral sbal-  counter <- getItemCounter-  ftxs <--    lift . runConduit $-      getBinfoTxs-        counter-        xbals-        abook-        sxspecs-        saddrs-        salladdrs-        fltr-        numtxid-        prune-        ibal-        .| (dropC offset >> takeC n .| sinkList)-  net <- lift $ asks (.config.store.net)-  ctx <- lift $ asks (.config.store.ctx)-  best <- get_best_block-  addItemCount 1-  peers <- get_peers-  addItemCount (fromIntegral peers)-  let baddrs = toBinfoAddrs sabals sxbals xtxns-      abaddrs = toBinfoAddrs abals xbals xtxns-      recv = sum $ map (.received) abaddrs-      sent' = sum $ map (.sent) abaddrs-      txn = fromIntegral $ length ftxs-      wallet =-        BinfoWallet-          { balance = bal,-            txs = txn,-            filtered = txn,-            received = recv,-            sent = sent'-          }-      coin = netBinfoSymbol net-  let block =-        BinfoBlockInfo-          { hash = H.headerHash best.header,-            height = best.height,-            timestamp = best.header.timestamp,-            index = best.height-          }-  let info =-        BinfoInfo-          { connected = peers,-            conversion = 100 * 1000 * 1000,-            fiat = local',-            crypto = coin,-            head = block-          }-  let multiaddr =-        BinfoMultiAddr-          { addresses = baddrs,-            wallet = wallet,-            txs = ftxs,-            info = info,-            recommendFee = True,-            cashAddr = cashaddr-          }-  setHeaders-  streamEncoding $ marshalEncoding (net, ctx) multiaddr-  where-    get_xpub_tx_count xbals =-      fmap HashMap.fromList-        . mapM-          ( \x ->-              (x,)-                . fromIntegral-                <$> xPubTxCount x (xBals x xbals)-          )-        . HashSet.toList-    get_filter =-      S.param "filter" `S.rescue` const (return BinfoFilterAll)-    get_best_block =-      getBestBlock >>= \case-        Nothing -> raise ThingNotFound-        Just bh ->-          getBlock bh >>= \case-            Nothing -> raise ThingNotFound-            Just b -> return b-    get_prune =-      fmap not $-        S.param "no_compact"-          `S.rescue` const (return False)-    only_show_xbals sxpubs =-      HashMap.filterWithKey (\k _ -> k.key `HashSet.member` sxpubs)-    only_show_xspecs sxpubs =-      HashSet.filter (\k -> k.key `HashSet.member` sxpubs)-    only_show_abals saddrs =-      HashMap.filterWithKey (\k _ -> k `HashSet.member` saddrs)-    addr (BinfoAddr a) = Just a-    addr (BinfoXpub _) = Nothing-    xpub (BinfoXpub x) = Just x-    xpub (BinfoAddr _) = Nothing-    get_addrs = do-      (xspecs, addrs) <- getBinfoActive-      sh <- getBinfoAddrsParam "onlyShow"-      let xpubs = HashSet.map (.key) xspecs-          actives =-            HashSet.map BinfoAddr addrs-              <> HashSet.map BinfoXpub xpubs-          sh' = if HashSet.null sh then actives else sh-          saddrs = HashSet.fromList $ mapMaybe addr $ HashSet.toList sh'-          sxpubs = HashSet.fromList $ mapMaybe xpub $ HashSet.toList sh'-      return (addrs, xpubs, saddrs, sxpubs, xspecs)-    get_abals =-      let f b = (b.address, b)-          g = HashMap.fromList . map f-       in fmap g . getBalances . HashSet.toList-    get_peers = do-      ps <- lift $ getPeersInformation =<< asks (.config.store.peerMgr)-      return (fromIntegral (length ps))-    compute_xabals =-      let f b = (b.balance.address, b.balance)-       in HashMap.fromList . concatMap (map f) . HashMap.elems-    compute_bal =-      let f b = b.confirmed + b.unconfirmed-       in sum . map f . HashMap.elems-    compute_abook addrs xbals =-      let f XPubSpec {..} XPubBal {..} =-            let a = balance.address-                e = error "lions and tigers and bears"-                s = toSoft (listToPath path)-             in (a, Just (BinfoXPubPath key (fromMaybe e s)))-          amap =-            HashMap.map (const Nothing) $-              HashSet.toMap addrs-          xmap =-            HashMap.fromList-              . concatMap (uncurry (map . f))-              $ HashMap.toList xbals-       in amap <> xmap-    compute_xaddrs =-      let f = map (.balance.address)-       in HashSet.fromList . concatMap f . HashMap.elems--getBinfoCount :: (MonadUnliftIO m, MonadLoggerIO m) => TL.Text -> WebT m Int-getBinfoCount str = do-  d <- lift $ asks (.config.limits.defItemCount)-  x <- lift $ asks (.config.limits.maxFullItemCount)-  i <- min x <$> (S.param str `S.rescue` const (return d))-  return (fromIntegral i :: Int)--getBinfoOffset ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  WebT m Int-getBinfoOffset = do-  x <- lift $ asks (.config.limits.maxOffset)-  o <- S.param "offset" `S.rescue` const (return 0)-  when (o > x) $-    raise $-      UserError $-        "offset exceeded: " <> show o <> " > " <> show x-  return (fromIntegral o :: Int)--scottyRawAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyRawAddr =-  setMetrics (.binfoAddressRaw)-    >> getBinfoAddr "addr"-    >>= \case-      BinfoAddr addr -> do_addr addr-      BinfoXpub xpub -> do_xpub xpub-  where-    do_xpub xpub = do-      numtxid <- getNumTxId-      derive <- S.param "derive" `S.rescue` const (return DeriveNormal)-      let xspec = XPubSpec xpub derive-      n <- getBinfoCount "limit"-      off <- getBinfoOffset-      xbals <- getXBals $ HashSet.singleton xspec-      addItemCount . sum . map length $ HashMap.elems xbals-      net <- lift $ asks (.config.store.net)-      let summary = xPubSummary xspec (xBals xspec xbals)-          abook = compute_abook xpub (xBals xspec xbals)-          xspecs = HashSet.singleton xspec-          saddrs = HashSet.empty-          baddrs = HashMap.keysSet abook-          bfilter = BinfoFilterAll-          amnt = summary.confirmed + summary.unconfirmed-      counter <- getItemCounter-      txs <--        lift $-          runConduit $-            getBinfoTxs-              counter-              xbals-              abook-              xspecs-              saddrs-              baddrs-              bfilter-              numtxid-              False-              (fromIntegral amnt)-              .| (dropC off >> takeC n .| sinkList)-      let ra =-            BinfoRawAddr-              { address = BinfoXpub xpub,-                balance = amnt,-                ntx = fromIntegral $ length txs,-                utxo = summary.utxo,-                received = summary.received,-                sent = fromIntegral summary.received - fromIntegral amnt,-                txs = txs-              }-      setHeaders-      ctx <- asks (.config.store.ctx)-      streamEncoding $ marshalEncoding (net, ctx) ra-    compute_abook xpub xbals =-      let f XPubBal {..} =-            let a = balance.address-                e = error "black hole swallows all your code"-                s = toSoft $ listToPath path-                m = fromMaybe e s-             in (a, Just (BinfoXPubPath xpub m))-       in HashMap.fromList $ map f xbals-    do_addr addr = do-      numtxid <- getNumTxId-      n <- getBinfoCount "limit"-      off <- getBinfoOffset-      bal <- fromMaybe (zeroBalance addr) <$> getBalance addr-      addItemCount 1-      net <- lift $ asks (.config.store.net)-      let abook = HashMap.singleton addr Nothing-          xspecs = HashSet.empty-          saddrs = HashSet.singleton addr-          bfilter = BinfoFilterAll-          amnt = bal.confirmed + bal.unconfirmed-      counter <- getItemCounter-      txs <--        lift $-          runConduit $-            getBinfoTxs-              counter-              HashMap.empty-              abook-              xspecs-              saddrs-              saddrs-              bfilter-              numtxid-              False-              (fromIntegral amnt)-              .| (dropC off >> takeC n .| sinkList)-      let ra =-            BinfoRawAddr-              { address = BinfoAddr addr,-                balance = amnt,-                ntx = bal.txs,-                utxo = bal.utxo,-                received = bal.received,-                sent = fromIntegral bal.received - fromIntegral amnt,-                txs = txs-              }-      setHeaders-      ctx <- asks (.config.store.ctx)-      streamEncoding $ marshalEncoding (net, ctx) ra--scottyBinfoReceived :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoReceived = do-  setMetrics (.binfoQgetreceivedbyaddress)-  a <- getAddress "addr"-  b <- fromMaybe (zeroBalance a) <$> getBalance a-  setHeaders-  addItemCount 1-  S.text $ cs $ show b.received--scottyBinfoSent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoSent = do-  setMetrics (.binfoQgetsentbyaddress)-  a <- getAddress "addr"-  b <- fromMaybe (zeroBalance a) <$> getBalance a-  setHeaders-  addItemCount 1-  S.text $ cs $ show $ b.received - b.confirmed - b.unconfirmed--scottyBinfoAddrBalance :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoAddrBalance = do-  setMetrics (.binfoQaddressbalance)-  a <- getAddress "addr"-  b <- fromMaybe (zeroBalance a) <$> getBalance a-  setHeaders-  addItemCount 1-  S.text $ cs $ show $ b.confirmed + b.unconfirmed--scottyFirstSeen :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyFirstSeen = do-  setMetrics (.binfoQaddressfirstseen)-  a <- getAddress "addr"-  ch <- lift $ asks (.config.store.chain)-  bb <- chainGetBest ch-  let top = bb.height-      bot = 0-  i <- go ch bb a bot top-  setHeaders-  addItemCount 1-  S.text $ cs $ show i-  where-    go ch bb a bot top = do-      let mid = bot + (top - bot) `div` 2-          n = top - bot < 2-      x <- hasone a bot-      y <- hasone a mid-      z <- hasone a top-      if-          | x -> getblocktime ch bb bot-          | n -> getblocktime ch bb top-          | y -> go ch bb a bot mid-          | z -> go ch bb a mid top-          | otherwise -> return 0-    getblocktime ch bb h =-      (.header.timestamp) . fromJust <$> chainGetAncestor h bb ch-    hasone a h = do-      let l = Limits 1 0 (Just (AtBlock h))-      not . null <$> getAddressTxs a l--scottyShortBal :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyShortBal = do-  setMetrics (.binfoBalance)-  (xspecs, addrs) <- getBinfoActive-  cashaddr <- getCashAddr-  net <- lift $ asks (.config.store.net)-  abals <--    catMaybes-      <$> mapM-        (get_addr_balance net cashaddr)-        (HashSet.toList addrs)-  addItemCount (length abals)-  xbals <- mapM (get_xspec_balance net) (HashSet.toList xspecs)-  let res = HashMap.fromList (abals <> xbals)-  setHeaders-  streamEncoding $ toEncoding res-  where-    to_short_bal Balance {..} =-      BinfoShortBal-        { final = confirmed + unconfirmed,-          ntx = txs,-          received = received-        }-    get_addr_balance net cashaddr a =-      let net' =-            if-                | cashaddr -> net-                | net == bch -> btc-                | net == bchTest -> btcTest-                | net == bchTest4 -> btcTest-                | otherwise -> net-       in case addrToText net' a of-            Nothing -> return Nothing-            Just a' ->-              getBalance a >>= \case-                Nothing -> return $ Just (a', to_short_bal (zeroBalance a))-                Just b -> return $ Just (a', to_short_bal b)-    is_ext XPubBal {path = 0 : _} = True-    is_ext _ = False-    get_xspec_balance net xpub = do-      xbals <- xPubBals xpub-      xts <- xPubTxCount xpub xbals-      addItemCount (length xbals + 1)-      let val = sum $ map (.balance.confirmed) xbals-          zro = sum $ map (.balance.unconfirmed) xbals-          exs = filter is_ext xbals-          rcv = sum $ map (.balance.received) exs-          sbl =-            BinfoShortBal-              { final = val + zro,-                ntx = fromIntegral xts,-                received = rcv-              }-      ctx <- asks (.config.store.ctx)-      return (xPubExport net ctx xpub.key, sbl)--getBinfoHex :: (Monad m) => WebT m Bool-getBinfoHex =-  (== ("hex" :: Text))-    <$> S.param "format" `S.rescue` const (return "json")--scottyBinfoBlockHeight :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoBlockHeight = do-  numtxid <- getNumTxId-  height <- S.param "height"-  setMetrics (.binfoBlockHeight)-  block_hashes <- getBlocksAtHeight height-  block_headers <- catMaybes <$> mapM getBlock block_hashes-  addItemCount (length block_headers)-  next_block_hashes <- getBlocksAtHeight (height + 1)-  next_block_headers <- catMaybes <$> mapM getBlock next_block_hashes-  addItemCount (length next_block_headers)-  binfo_blocks <--    mapM (get_binfo_blocks numtxid next_block_headers) block_headers-  setHeaders-  net <- lift $ asks (.config.store.net)-  ctx <- lift $ asks (.config.store.ctx)-  streamEncoding $ marshalEncoding (net, ctx) binfo_blocks-  where-    get_tx th =-      withRunInIO $ \run ->-        unsafeInterleaveIO $-          run $-            fromJust <$> getTransaction th-    get_binfo_blocks numtxid next_block_headers block_header = do-      let my_hash = H.headerHash block_header.header-          get_prev = (.header.prev)-          get_hash = H.headerHash . (.header)-      txs <- lift $ mapM get_tx block_header.txs-      addItemCount (length txs)-      let next_blocks =-            map get_hash $-              filter-                ((== my_hash) . get_prev)-                next_block_headers-          binfo_txs = map (toBinfoTxSimple numtxid) txs-          binfo_block = toBinfoBlock block_header binfo_txs next_blocks-      return binfo_block--scottyBinfoLatest :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoLatest = do-  numtxid <- getNumTxId-  setMetrics (.binfoBlockLatest)-  best <- get_best_block-  addItemCount 1-  streamEncoding $-    toEncoding-      BinfoHeader-        { hash = H.headerHash best.header,-          timestamp = best.header.timestamp,-          index = best.height,-          height = best.height,-          txids = map (encodeBinfoTxId numtxid) best.txs-        }-  where-    get_best_block =-      getBestBlock >>= \case-        Nothing -> raise ThingNotFound-        Just bh ->-          getBlock bh >>= \case-            Nothing -> raise ThingNotFound-            Just b -> return b--scottyBinfoBlock :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoBlock = do-  numtxid <- getNumTxId-  hex <- getBinfoHex-  setMetrics (.binfoBlockRaw)-  S.param "block" >>= \case-    BinfoBlockHash bh -> go numtxid hex bh-    BinfoBlockIndex i ->-      getBlocksAtHeight i >>= \case-        [] -> raise ThingNotFound-        bh : _ -> go numtxid hex bh-  where-    get_tx th =-      withRunInIO $ \run ->-        unsafeInterleaveIO $-          run $-            fromJust <$> getTransaction th-    go numtxid hex bh =-      getBlock bh >>= \case-        Nothing -> raise ThingNotFound-        Just b -> do-          addItemCount 1-          txs <- lift $ mapM get_tx b.txs-          addItemCount (length txs)-          let my_hash = H.headerHash b.header-              get_prev = (.header.prev)-              get_hash = H.headerHash . (.header)-          nxt_headers <--            fmap catMaybes $-              mapM getBlock-                =<< getBlocksAtHeight (b.height + 1)-          addItemCount (length nxt_headers)-          let nxt =-                map get_hash $-                  filter-                    ((== my_hash) . get_prev)-                    nxt_headers-          if hex-            then do-              let x = H.Block b.header (map transactionData txs)-              setHeaders-              S.text . encodeHexLazy . runPutL $ serialize x-            else do-              let btxs = map (toBinfoTxSimple numtxid) txs-                  y = toBinfoBlock b btxs nxt-              setHeaders-              net <- lift $ asks (.config.store.net)-              ctx <- lift $ asks (.config.store.ctx)-              streamEncoding $ marshalEncoding (net, ctx) y--getBinfoTx ::-  (MonadLoggerIO m, MonadUnliftIO m) =>-  BinfoTxId ->-  WebT m (Either Except Transaction)-getBinfoTx txid = do-  tx <- case txid of-    BinfoTxIdHash h -> maybeToList <$> getTransaction h-    BinfoTxIdIndex i -> getNumTransaction i-  case tx of-    [t] -> return $ Right t-    [] -> return $ Left ThingNotFound-    ts ->-      let tids = map (txHash . transactionData) ts-       in return $ Left (TxIndexConflict tids)--scottyBinfoTx :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoTx = do-  numtxid <- getNumTxId-  hex <- getBinfoHex-  txid <- S.param "txid"-  setMetrics (.binfoTxRaw)-  tx <--    getBinfoTx txid >>= \case-      Right t -> return t-      Left e -> raise e-  addItemCount 1-  if hex then hx tx else js numtxid tx-  where-    js numtxid t = do-      net <- lift $ asks (.config.store.net)-      ctx <- lift $ asks (.config.store.ctx)-      setHeaders-      streamEncoding $ marshalEncoding (net, ctx) $ toBinfoTxSimple numtxid t-    hx t = do-      setHeaders-      S.text . encodeHexLazy . runPutL . serialize $ transactionData t--scottyBinfoTotalOut :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoTotalOut = do-  txid <- S.param "txid"-  setMetrics (.binfoQtxtotalbtcoutput)-  tx <--    getBinfoTx txid >>= \case-      Right t -> return t-      Left e -> raise e-  addItemCount 1-  S.text $ cs $ show $ sum $ map (.value) tx.outputs--scottyBinfoTxFees :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoTxFees = do-  txid <- S.param "txid"-  setMetrics (.binfoQtxfee)-  tx <--    getBinfoTx txid >>= \case-      Right t -> return t-      Left e -> raise e-  let i = sum $ map (.value) $ filter f $ tx.inputs-      o = sum $ map (.value) $ tx.outputs-  addItemCount 1-  S.text . cs . show $ i - o-  where-    f StoreInput {} = True-    f StoreCoinbase {} = False--scottyBinfoTxResult :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoTxResult = do-  txid <- S.param "txid"-  addr <- getAddress "addr"-  setMetrics (.binfoQtxresult)-  tx <--    getBinfoTx txid >>= \case-      Right t -> return t-      Left e -> raise e-  let i = toInteger $ sum $ map (.value) $ filter (f addr) $ tx.inputs-      o = toInteger $ sum $ map (.value) $ filter (g addr) $ tx.outputs-  addItemCount 1-  S.text $ cs $ show $ o - i-  where-    f addr StoreInput {address = Just a} = a == addr-    f _ _ = False-    g addr StoreOutput {address = Just a} = a == addr-    g _ _ = False--scottyBinfoTotalInput :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoTotalInput = do-  txid <- S.param "txid"-  setMetrics (.binfoQtxtotalbtcinput)-  tx <--    getBinfoTx txid >>= \case-      Right t -> return t-      Left e -> raise e-  addItemCount 1-  S.text $ cs $ show $ sum $ map (.value) $ filter f $ tx.inputs-  where-    f StoreInput {} = True-    f StoreCoinbase {} = False--scottyBinfoMempool :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoMempool = do-  setMetrics (.binfoMempool)-  numtxid <- getNumTxId-  offset <- getBinfoOffset-  n <- getBinfoCount "limit"-  mempool <- getMempool-  let txids = map snd $ take n $ drop offset mempool-  txs <- catMaybes <$> mapM getTransaction txids-  net <- lift $ asks (.config.store.net)-  setHeaders-  let mem = BinfoMempool $ map (toBinfoTxSimple numtxid) txs-  addItemCount (length txs)-  ctx <- lift $ asks (.config.store.ctx)-  streamEncoding $ marshalEncoding (net, ctx) mem--scottyBinfoGetBlockCount :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoGetBlockCount = do-  setMetrics (.binfoQgetblockcount)-  ch <- asks (.config.store.chain)-  bn <- chainGetBest ch-  setHeaders-  addItemCount 1-  S.text $ cs $ show $ bn.height--scottyBinfoLatestHash :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoLatestHash = do-  setMetrics (.binfoQlatesthash)-  ch <- asks (.config.store.chain)-  bn <- chainGetBest ch-  setHeaders-  addItemCount 1-  S.text $ TL.fromStrict $ H.blockHashToHex $ H.headerHash $ bn.header--scottyBinfoSubsidy :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoSubsidy = do-  setMetrics (.binfoQbcperblock)-  ch <- asks (.config.store.chain)-  net <- asks (.config.store.net)-  bn <- chainGetBest ch-  setHeaders-  addItemCount 1-  S.text $-    cs $-      show $-        (/ (100 * 1000 * 1000 :: Double)) $-          fromIntegral $-            H.computeSubsidy net (bn.height + 1)--scottyBinfoAddrToHash :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoAddrToHash = do-  setMetrics (.binfoQaddresstohash)-  addr <- getAddress "addr"-  setHeaders-  addItemCount 1-  S.text $ encodeHexLazy $ runPutL $ serialize $ addr.hash160--scottyBinfoHashToAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoHashToAddr = do-  setMetrics (.binfoQhashtoaddress)-  bs <- maybe S.next return . decodeHex =<< S.param "hash"-  net <- asks (.config.store.net)-  hash <- either (const S.next) return (decode bs)-  addr <- maybe S.next return (addrToText net (PubKeyAddress hash))-  setHeaders-  addItemCount 1-  S.text $ TL.fromStrict addr--scottyBinfoAddrPubkey :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoAddrPubkey = do-  setMetrics (.binfoQaddrpubkey)-  hex <- S.param "pubkey"-  ctx <- lift $ asks (.config.store.ctx)-  pubkey <--    maybe S.next (return . pubKeyAddr ctx) $-      eitherToMaybe . unmarshal ctx =<< decodeHex hex-  net <- lift $ asks (.config.store.net)-  setHeaders-  case addrToText net pubkey of-    Nothing -> raise ThingNotFound-    Just a -> do-      addItemCount 1-      S.text $ TL.fromStrict a--scottyBinfoPubKeyAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoPubKeyAddr = do-  setMetrics (.binfoQpubkeyaddr)-  addr <- getAddress "addr"-  mi <- strm addr-  i <- case mi of-    Nothing -> raise ThingNotFound-    Just i -> return i-  pk <- case extr addr i of-    Left e -> raise $ UserError e-    Right t -> return t-  setHeaders-  S.text $ encodeHexLazy $ L.fromStrict pk-  where-    strm addr = do-      counter <- getItemCounter-      runConduit $ do-        let f l = do-              ts <- getAddressTxs addr l-              counter (length ts)-              return ts-            l = let Limits {..} = def in Limits {limit = 8, ..}-        streamThings f (Just (.txid)) l-          .| concatMapMC (getTransaction . (.txid))-          .| iterMC (\_ -> counter 1)-          .| concatMapC (filter (inp addr) . (.inputs))-          .| headC-    inp addr StoreInput {address = Just a} = a == addr-    inp _ _ = False-    extr addr StoreInput {script, pkscript, witness} = do-      Script sig <- decode script-      Script pks <- decode pkscript-      case addr of-        PubKeyAddress {} ->-          case sig of-            [OP_PUSHDATA _ _, OP_PUSHDATA pub _] ->-              Right pub-            [OP_PUSHDATA _ _] ->-              case pks of-                [OP_PUSHDATA pub _, OP_CHECKSIG] ->-                  Right pub-                _ -> Left "Could not parse scriptPubKey"-            _ -> Left "Could not parse scriptSig"-        WitnessPubKeyAddress {} ->-          case witness of-            [_, pub] -> return pub-            _ -> Left "Could not parse scriptPubKey"-        _ -> Left "Address does not have public key"-    extr _ _ = Left "Incorrect input type"--scottyBinfoHashPubkey :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyBinfoHashPubkey = do-  setMetrics (.binfoQhashpubkey)-  ctx <- lift $ asks (.config.store.ctx)-  pkm <- (eitherToMaybe . unmarshal ctx <=< decodeHex) <$> S.param "pubkey"-  addr <- case pkm of-    Nothing -> raise $ UserError "Could not decode public key"-    Just pk -> return $ pubKeyAddr ctx pk-  setHeaders-  addItemCount 1-  S.text $ encodeHexLazy $ runPutL $ serialize $ addr.hash160---- GET Network Information ----scottyPeers ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  GetPeers ->-  WebT m [PeerInfo]-scottyPeers _ = do-  setMetrics (.peers)-  ps <- lift $ getPeersInformation =<< asks (.config.store.peerMgr)-  addItemCount (length ps)-  return ps---- | Obtain information about connected peers from peer manager process.-getPeersInformation ::-  (MonadLoggerIO m) => PeerMgr -> m [PeerInfo]-getPeersInformation mgr =-  mapMaybe toInfo <$> getPeers mgr-  where-    toInfo op = do-      ver <- op.version-      return-        PeerInfo-          { userAgent = ver.userAgent.get,-            address = show op.address,-            version = ver.version,-            services = ver.services,-            relay = ver.relay-          }--scottyHealth ::-  (MonadUnliftIO m, MonadLoggerIO m) => GetHealth -> WebT m HealthCheck-scottyHealth _ = do-  setMetrics (.health)-  h <- asks (.health) >>= readTVarIO-  unless (isOK h) $ S.status status503-  addItemCount 1-  return h--blockHealthCheck ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  WebConfig ->-  m BlockHealth-blockHealthCheck cfg = do-  let ch = cfg.store.chain-  headers <- (.height) <$> chainGetBest ch-  blocks <--    maybe 0 (.height)-      <$> runMaybeT (MaybeT getBestBlock >>= MaybeT . getBlock)-  return-    BlockHealth-      { headers,-        blocks,-        max = fromIntegral cfg.maxLaggingBlocks-      }--lastBlockHealthCheck ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  Chain ->-  WebTimeouts ->-  m TimeHealth-lastBlockHealthCheck ch tos = do-  n <- fromIntegral . systemSeconds <$> liftIO getSystemTime-  t <- fromIntegral . (.header.timestamp) <$> chainGetBest ch-  return-    TimeHealth-      { age = n - t,-        max = fromIntegral tos.block-      }--lastTxHealthCheck ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  WebConfig ->-  m TimeHealth-lastTxHealthCheck WebConfig {..} = do-  n <- fromIntegral . systemSeconds <$> liftIO getSystemTime-  b <- fromIntegral . (.header.timestamp) <$> chainGetBest ch-  t <--    getMempool >>= \case-      t : _ ->-        let x = fromIntegral $ fst t-         in return $ max x b-      [] -> return b-  return-    TimeHealth-      { age = n - t,-        max = fromIntegral to-      }-  where-    ch = store.chain-    to =-      if noMempool-        then timeouts.block-        else timeouts.tx--pendingTxsHealthCheck ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  WebConfig ->-  m MaxHealth-pendingTxsHealthCheck cfg = do-  n <- blockStorePendingTxs cfg.store.block-  return-    MaxHealth-      { max = fromIntegral cfg.maxPendingTxs,-        count = fromIntegral n-      }--peerHealthCheck ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  WebConfig ->-  m CountHealth-peerHealthCheck cfg = do-  count <- fromIntegral . length <$> getPeers cfg.store.peerMgr-  return CountHealth {min = fromIntegral cfg.minPeers, count}--healthCheck ::-  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>-  WebConfig ->-  m HealthCheck-healthCheck cfg = do-  blocks <- blockHealthCheck cfg-  lastBlock <- lastBlockHealthCheck cfg.store.chain cfg.timeouts-  lastTx <- lastTxHealthCheck cfg-  pendingTxs <- pendingTxsHealthCheck cfg-  peers <- peerHealthCheck cfg-  time <- round . utcTimeToPOSIXSeconds <$> liftIO getCurrentTime-  let check =-        HealthCheck-          { network = cfg.store.net.name,-            version = cfg.version,-            ..-          }-  unless (isOK check) $ do-    let t = toStrict $ encodeToLazyText check-    $(logErrorS) "Web" $ "Health check failed: " <> t-  return check--scottyDbStats :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()-scottyDbStats = do-  setMetrics (.db)-  setHeaders-  db <- lift $ asks (.config.store.db.db)-  statsM <- lift (getProperty db Stats)-  addItemCount 1-  S.text $ maybe "Could not get stats" cs statsM---------------------------- Parameter Parsing ------------------------------ | Returns @Nothing@ if the parameter is not supplied. Raises an exception on--- parse failure.-paramOptional :: (Param a, MonadIO m) => WebT m (Maybe a)-paramOptional = go Proxy-  where-    go :: (Param a, MonadIO m) => Proxy a -> WebT m (Maybe a)-    go proxy = do-      net <- lift $ asks (.config.store.net)-      ctx <- lift $ asks (.config.store.ctx)-      tsM :: Maybe [Text] <- p `S.rescue` const (return Nothing)-      case tsM of-        Nothing -> return Nothing -- Parameter was not supplied-        Just ts -> maybe (raise err) (return . Just) $ parseParam net ctx ts-      where-        l = proxyLabel proxy-        p = Just <$> S.param (cs l)-        err = UserError $ "Unable to parse param " <> cs l---- | Raises an exception if the parameter is not supplied-param :: (Param a, MonadIO m) => WebT m a-param = go Proxy-  where-    go :: (Param a, MonadIO m) => Proxy a -> WebT m a-    go proxy = do-      resM <- paramOptional-      case resM of-        Just res -> return res-        _ ->-          raise . UserError $-            "The param " <> cs (proxyLabel proxy) <> " was not defined"---- | Returns the default value of a parameter if it is not supplied. Raises an--- exception on parse failure.-paramDef :: (Default a, Param a, MonadIO m) => WebT m a-paramDef = fromMaybe def <$> paramOptional---- | Does not raise exceptions. Will call @Scotty.next@ if the parameter is--- not supplied or if parsing fails.-paramLazy :: (Param a, MonadIO m) => WebT m a-paramLazy = do-  resM <- paramOptional `S.rescue` const (return Nothing)-  maybe S.next return resM--parseBody :: (MonadIO m, Serial a) => WebT m a-parseBody = do-  b <- L.toStrict <$> S.body-  case hex b <> bin b of-    Left _ -> raise $ UserError "Failed to parse request body"-    Right x -> return x-  where-    bin = runGetS deserialize-    hex b =-      let ns = C.filter (not . isSpace) b-       in if isBase16 ns-            then bin . decodeBase16 $ assertBase16 ns-            else Left "Invalid hex input"--parseOffset :: (MonadIO m) => WebT m OffsetParam-parseOffset = do-  res@(OffsetParam o) <- paramDef-  limits <- lift $ asks (.config.limits)-  when (limits.maxOffset > 0 && fromIntegral o > limits.maxOffset) $-    raise . UserError $-      "offset exceeded: " <> show o <> " > " <> show limits.maxOffset-  return res--parseStart ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  Maybe StartParam ->-  WebT m (Maybe Start)-parseStart Nothing = return Nothing-parseStart (Just s) =-  runMaybeT $-    case s of-      StartParamHash {hash = h} -> start_tx h <|> start_block h-      StartParamHeight {height = h} -> start_height h-      StartParamTime {time = q} -> start_time q-  where-    start_height h = return $ AtBlock $ fromIntegral h-    start_block h = do-      b <- MaybeT $ getBlock (H.BlockHash h)-      return $ AtBlock b.height-    start_tx h = do-      _ <- MaybeT $ getTxData (TxHash h)-      return $ AtTx (TxHash h)-    start_time q = do-      ch <- lift $ asks (.config.store.chain)-      b <- MaybeT $ blockAtOrBefore ch q-      return $ AtBlock b.height--parseLimits :: (MonadIO m) => WebT m LimitsParam-parseLimits = LimitsParam <$> paramOptional <*> parseOffset <*> paramOptional--paramToLimits ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  Bool ->-  LimitsParam ->-  WebT m Limits-paramToLimits full (LimitsParam limitM o startM) = do-  wl <- lift $ asks (.config.limits)-  Limits (validateLimit wl full limitM) (fromIntegral o) <$> parseStart startM--validateLimit :: WebLimits -> Bool -> Maybe LimitParam -> Word32-validateLimit wl full limitM =-  f m $ maybe d (fromIntegral . (.get)) limitM-  where-    m-      | full && wl.maxFullItemCount > 0 = wl.maxFullItemCount-      | otherwise = wl.maxItemCount-    d = wl.defItemCount-    f a 0 = a-    f 0 b = b-    f a b = min a b-------------------- Utilities --------------------runInWebReader ::-  (MonadIO m) =>-  CacheT (DatabaseReaderT m) a ->-  ReaderT WebState m a-runInWebReader f = do-  bdb <- asks (.config.store.db)-  mc <- asks (.config.store.cache)-  lift $ runReaderT (withCache mc f) bdb--runNoCache :: (MonadIO m) => Bool -> ReaderT WebState m a -> ReaderT WebState m a-runNoCache False f = f-runNoCache True f = local g f-  where-    g s = s {config = h s.config}-    h c = c {store = i c.store}-    i s = s {cache = Nothing}--logIt ::-  (MonadUnliftIO m, MonadLoggerIO m) =>-  Maybe WebMetrics ->-  m Middleware-logIt metrics = do-  runner <- askRunInIO-  return $ \app req respond -> do-    var <- newTVarIO B.empty-    req' <--      let rb = req_body var (getRequestBodyChunk req)-          rq = req {requestBody = rb}-       in case metrics of-            Nothing -> return rq-            Just m -> do-              stat_var <- newTVarIO Nothing-              let vt =-                    V.insert m.key stat_var $-                      vault rq-              return rq {vault = vt}-    bracket start (end var runner req') $ \_ ->-      app req' $ \res -> do-        b <- readTVarIO var-        let s = responseStatus res-            msg = fmtReq b req' <> ": " <> fmtStatus s-        if statusIsSuccessful s-          then runner $ $(logDebugS) "Web" msg-          else runner $ $(logErrorS) "Web" msg-        respond res-  where-    start = systemToUTCTime <$> getSystemTime-    req_body var old_body = do-      b <- old_body-      unless (B.null b) . atomically $ modifyTVar var (<> b)-      return b-    add_stat d s = do-      addStatQuery s-      addStatTime s d-    end var runner req t1 = do-      t2 <- systemToUTCTime <$> getSystemTime-      let diff = round $ diffUTCTime t2 t1 * 1000-      case metrics of-        Nothing -> return ()-        Just m -> do-          let m_stat_var = V.lookup m.key (vault req)-          add_stat diff m.all-          case m_stat_var of-            Nothing -> return ()-            Just stat_var ->-              readTVarIO stat_var >>= \case-                Nothing -> return ()-                Just f -> add_stat diff (f m)-      when (diff > 10000) $ do-        b <- readTVarIO var-        runner $-          $(logWarnS) "Web" $-            "Slow [" <> cs (show diff) <> " ms]: " <> fmtReq b req--reqSizeLimit :: (Integral i) => i -> Middleware-reqSizeLimit i = requestSizeLimitMiddleware lim-  where-    max_len _req = return (Just (fromIntegral i))-    lim =-      setOnLengthExceeded too_big $-        setMaxLengthForRequest-          max_len-          defaultRequestSizeLimitSettings-    too_big _ _app _req send =-      send $-        waiExcept requestEntityTooLarge413 RequestTooLarge--reqTimeout :: (Integral i) => i -> Middleware-reqTimeout = timeoutAs res . fromIntegral-  where-    err = ServerTimeout-    res = responseLBS sta [hdr] (A.encode err)-    sta = errStatus err-    hdr = (hContentType, "application/json")--fmtReq :: ByteString -> Request -> Text-fmtReq bs req =-  let m = requestMethod req-      v = httpVersion req-      p = rawPathInfo req-      q = rawQueryString req-      txt = case T.decodeUtf8' bs of-        Left _ -> " {invalid utf8}"-        Right "" -> ""-        Right t -> " [" <> t <> "]"-   in T.decodeUtf8 (m <> " " <> p <> q <> " " <> cs (show v)) <> txt+    runWeb,+  )+where++import Conduit+  ( ConduitT,+    await,+    concatMapC,+    concatMapMC,+    dropC,+    dropWhileC,+    headC,+    mapC,+    runConduit,+    sinkList,+    takeC,+    takeWhileC,+    yield,+    (.|),+  )+import Control.Applicative ((<|>))+import Control.Lens ((.~), (^.))+import Control.Monad+  ( forM_,+    forever,+    unless,+    when,+    (<=<),+  )+import Control.Monad.Logger+  ( MonadLoggerIO,+    logDebugS,+    logErrorS,+  )+import Control.Monad.Reader+  ( ReaderT,+    asks,+    local,+    runReaderT,+  )+import Control.Monad.Trans (lift)+import Control.Monad.Trans.Control+  ( liftWith,+    restoreT,+  )+import Control.Monad.Trans.Maybe+  ( MaybeT (..),+    runMaybeT,+  )+import Data.Aeson+  ( Encoding,+    ToJSON (..),+    Value,+  )+import Data.Aeson qualified as A+import Data.Aeson.Encode.Pretty+  ( Config (..),+    defConfig,+    encodePretty',+  )+import Data.Aeson.Encoding+  ( encodingToLazyByteString,+    list,+  )+import Data.Aeson.Text (encodeToLazyText)+import Data.Base16.Types (assertBase16)+import Data.ByteString.Base16 (decodeBase16, isBase16)+import Data.ByteString.Builder (lazyByteString)+import Data.ByteString.Char8 qualified as C+import Data.ByteString.Lazy qualified as L+import Data.Bytes.Get+import Data.Bytes.Put+import Data.Bytes.Serial+import Data.Char (isSpace)+import Data.Default (Default (..))+import Data.Function ((&))+import Data.HashMap.Strict (HashMap)+import Data.HashMap.Strict qualified as HashMap+import Data.HashSet (HashSet)+import Data.HashSet qualified as HashSet+import Data.Int (Int64)+import Data.List (nub)+import Data.Maybe+  ( catMaybes,+    fromMaybe,+    isJust,+    mapMaybe,+    maybeToList,+  )+import Data.Proxy (Proxy (..))+import Data.Serialize (decode)+import Data.String (fromString)+import Data.String.Conversions (cs)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import Data.Text.Lazy (toStrict)+import Data.Text.Lazy qualified as TL+import Data.Time.Clock.POSIX (getPOSIXTime)+import Data.Word (Word32, Word64)+import Database.RocksDB+  ( Property (..),+    getProperty,+  )+import Haskoin.Address+import Haskoin.Block qualified as H+import Haskoin.Crypto.Keys+import Haskoin.Network+import Haskoin.Node+  ( Chain,+    OnlinePeer (..),+    PeerMgr,+    chainGetAncestor,+    chainGetBest,+    getPeers,+    sendMessage,+  )+import Haskoin.Script+import Haskoin.Store.BlockStore+import Haskoin.Store.Cache+import Haskoin.Store.Common+import Haskoin.Store.Data+import Haskoin.Store.Database.Reader+import Haskoin.Store.Manager+import Haskoin.Store.WebCommon+import Haskoin.Transaction+import Haskoin.Util+import NQE+  ( Inbox,+    receive,+    withSubscription,+  )+import Network.HTTP.Types+  ( Status (..),+    status400,+    status404,+    status409,+    status413,+    status500,+    status503,+    statusIsClientError,+    statusIsServerError,+    statusIsSuccessful,+  )+import Network.Wai+  ( Middleware,+    Request (..),+    responseStatus,+  )+import Network.Wai.Handler.Warp+  ( defaultSettings,+    setHost,+    setPort,+  )+import Network.Wai.Handler.WebSockets (websocketsOr)+import Network.WebSockets+  ( acceptRequest,+    defaultConnectionOptions,+    pendingRequest,+    rejectRequestWith,+    requestPath,+    sendTextData,+  )+import Network.WebSockets qualified as WebSockets+import Network.Wreq qualified as Wreq+import Network.Wreq.Session as Wreq (Session)+import Network.Wreq.Session qualified as Wreq.Session+import System.Metrics.StatsD+import UnliftIO+  ( MonadIO,+    MonadUnliftIO,+    TVar,+    askRunInIO,+    atomically,+    bracket,+    bracket_,+    handleAny,+    liftIO,+    newTVarIO,+    readTVarIO,+    timeout,+    withAsync,+    writeTVar,+  )+import UnliftIO.Concurrent (threadDelay)+import Web.Scotty.Internal.Types (ActionT)+import Web.Scotty.Trans qualified as S++type WebT m = ActionT Except (ReaderT WebState m)++data WebLimits = WebLimits+  { maxItemCount :: !Word32,+    maxFullItemCount :: !Word32,+    maxOffset :: !Word32,+    defItemCount :: !Word32,+    xpubGap :: !Word32,+    xpubGapInit :: !Word32,+    txTimeout :: !Word64,+    blockTimeout :: !Word64+  }+  deriving (Eq, Show)++instance Default WebLimits where+  def =+    WebLimits+      { maxItemCount = 200000,+        maxFullItemCount = 5000,+        maxOffset = 50000,+        defItemCount = 100,+        xpubGap = 32,+        xpubGapInit = 20,+        txTimeout = 3600 `div` 2,+        blockTimeout = 4 * 3600+      }++data WebConfig = WebConfig+  { host :: !String,+    port :: !Int,+    store :: !Store,+    maxLaggingBlocks :: !Int,+    maxPendingTxs :: !Int,+    minPeers :: !Int,+    limits :: !WebLimits,+    version :: !String,+    noMempool :: !Bool,+    stats :: !(Maybe Stats),+    tickerRefresh :: !Int,+    tickerURL :: !String,+    priceHistoryURL :: !String,+    noSlow :: !Bool,+    noBlockchainInfo :: !Bool,+    healthCheckInterval :: !Int+  }++data WebState = WebState+  { config :: !WebConfig,+    ticker :: !(TVar (HashMap Text BinfoTicker)),+    metrics :: !(Maybe WebMetrics),+    session :: !Wreq.Session,+    health :: !(TVar HealthCheck)+  }++data WebMetrics = WebMetrics+  { -- Addresses+    addressTx :: !StatTiming,+    addressTxFull :: !StatTiming,+    addressBalance :: !StatTiming,+    addressUnspent :: !StatTiming,+    xpub :: !StatTiming,+    xpubDelete :: !StatTiming,+    xpubTxFull :: !StatTiming,+    xpubTx :: !StatTiming,+    xpubBalance :: !StatTiming,+    xpubUnspent :: !StatTiming,+    -- Transactions+    tx :: !StatTiming,+    txRaw :: !StatTiming,+    txAfter :: !StatTiming,+    txBlock :: !StatTiming,+    txBlockRaw :: !StatTiming,+    txPost :: !StatTiming,+    mempool :: !StatTiming,+    -- Blocks+    block :: !StatTiming,+    blockRaw :: !StatTiming,+    -- Blockchain+    binfoMultiaddr :: !StatTiming,+    binfoBalance :: !StatTiming,+    binfoAddressRaw :: !StatTiming,+    binfoUnspent :: !StatTiming,+    binfoTxRaw :: !StatTiming,+    binfoBlock :: !StatTiming,+    binfoBlockHeight :: !StatTiming,+    binfoBlockLatest :: !StatTiming,+    binfoBlockRaw :: !StatTiming,+    binfoMempool :: !StatTiming,+    binfoExportHistory :: !StatTiming,+    -- Blockchain /q endpoints+    binfoQaddresstohash :: !StatTiming,+    binfoQhashtoaddress :: !StatTiming,+    binfoQaddrpubkey :: !StatTiming,+    binfoQpubkeyaddr :: !StatTiming,+    binfoQhashpubkey :: !StatTiming,+    binfoQgetblockcount :: !StatTiming,+    binfoQlatesthash :: !StatTiming,+    binfoQbcperblock :: !StatTiming,+    binfoQtxtotalbtcoutput :: !StatTiming,+    binfoQtxtotalbtcinput :: !StatTiming,+    binfoQtxfee :: !StatTiming,+    binfoQtxresult :: !StatTiming,+    binfoQgetreceivedbyaddress :: !StatTiming,+    binfoQgetsentbyaddress :: !StatTiming,+    binfoQaddressbalance :: !StatTiming,+    binfoQaddressfirstseen :: !StatTiming,+    -- Errors+    serverErrors :: StatCounter,+    clientErrors :: StatCounter,+    -- Others+    health :: !StatTiming,+    peers :: !StatTiming,+    db :: !StatTiming,+    events :: !StatGauge+  }++createMetrics :: (MonadIO m) => Stats -> m WebMetrics+createMetrics s = liftIO $ do+  -- Addresses+  addressTx <- d "address_transactions"+  addressTxFull <- d "address_transactions_full"+  addressBalance <- d "address_balance"+  addressUnspent <- d "address_unspent"+  xpub <- d "xpub"+  xpubDelete <- d "xpub_delete"+  xpubTxFull <- d "xpub_transactions_full"+  xpubTx <- d "xpub_transactions"+  xpubBalance <- d "xpub_balances"+  xpubUnspent <- d "xpub_unspent"++  -- Transactions+  tx <- d "transaction"+  txRaw <- d "transaction_raw"+  txAfter <- d "transaction_after"+  txPost <- d "transaction_post"+  txBlock <- d "transactions_block"+  txBlockRaw <- d "transactions_block_raw"+  mempool <- d "mempool"++  -- Blocks+  block <- d "block"+  blockRaw <- d "block_raw"++  -- Blockchain+  binfoMultiaddr <- d "blockchain_multiaddr"+  binfoBalance <- d "blockchain_balance"+  binfoAddressRaw <- d "blockchain_rawaddr"+  binfoUnspent <- d "blockchain_unspent"+  binfoTxRaw <- d "blockchain_rawtx"+  binfoBlock <- d "blockchain_blocks"+  binfoBlockHeight <- d "blockchain_block_height"+  binfoBlockLatest <- d "blockchain_latestblock"+  binfoBlockRaw <- d "blockchain_rawblock"+  binfoMempool <- d "blockchain_mempool"+  binfoExportHistory <- d "blockchain_export_history"++  -- Blockchain /q endpoints+  binfoQaddresstohash <- d "blockchain_q_addresstohash"+  binfoQhashtoaddress <- d "blockchain_q_hashtoaddress"+  binfoQaddrpubkey <- d "blockckhain_q_addrpubkey"+  binfoQpubkeyaddr <- d "blockchain_q_pubkeyaddr"+  binfoQhashpubkey <- d "blockchain_q_hashpubkey"+  binfoQgetblockcount <- d "blockchain_q_getblockcount"+  binfoQlatesthash <- d "blockchain_q_latesthash"+  binfoQbcperblock <- d "blockchain_q_bcperblock"+  binfoQtxtotalbtcoutput <- d "blockchain_q_txtotalbtcoutput"+  binfoQtxtotalbtcinput <- d "blockchain_q_txtotalbtcinput"+  binfoQtxfee <- d "blockchain_q_txfee"+  binfoQtxresult <- d "blockchain_q_txresult"+  binfoQgetreceivedbyaddress <- d "blockchain_q_getreceivedbyaddress"+  binfoQgetsentbyaddress <- d "blockchain_q_getsentbyaddress"+  binfoQaddressbalance <- d "blockchain_q_addressbalance"+  binfoQaddressfirstseen <- d "blockchain_q_addressfirstseen"++  -- Errors+  serverErrors <- c "server_errors"+  clientErrors <- c "client_errors"++  -- Others+  health <- d "health"+  peers <- d "peers"+  db <- d "dbstats"++  events <- g "events_connected"+  return WebMetrics {..}+  where+    d x = newStatTiming s ("web." <> x) 10+    g x = newStatGauge s ("web." <> x) 0+    c x = newStatCounter s ("web." <> x) 10++withGaugeIO :: (MonadUnliftIO m) => StatGauge -> m a -> m a+withGaugeIO g = bracket_ (incrementGauge g 1) (decrementGauge g 1)++withGaugeIncrease ::+  (MonadUnliftIO m) =>+  (WebMetrics -> StatGauge) ->+  WebT m a ->+  WebT m a+withGaugeIncrease gf go =+  lift (asks (.metrics)) >>= \case+    Nothing -> go+    Just m -> do+      s <- liftWith $ \run -> withGaugeIO (gf m) (run go)+      restoreT $ return s++withMetrics ::+  (MonadUnliftIO m) => (WebMetrics -> StatTiming) -> WebT m a -> WebT m a+withMetrics df go =+  asks (.metrics) >>= \case+    Nothing -> go+    Just m ->+      restoreT . return+        =<< liftWith (\run -> bracket time (stop m) (const (run go)))+  where+    time = round . (* 1000) <$> liftIO getPOSIXTime+    stop m t1 = do+      t2 <- time+      let ms = t2 - t1+      liftIO $ addTiming (df m) ms++data SerialAs = SerialAsBinary | SerialAsJSON | SerialAsPrettyJSON+  deriving (Eq, Show)++instance+  (MonadUnliftIO m) =>+  StoreReadBase (ReaderT WebState m)+  where+  getCtx = runInWebReader getCtx+  getNetwork = runInWebReader getNetwork+  getBestBlock = runInWebReader getBestBlock+  getBlocksAtHeight height = runInWebReader (getBlocksAtHeight height)+  getBlock bh = runInWebReader (getBlock bh)+  getTxData th = runInWebReader (getTxData th)+  getSpender op = runInWebReader (getSpender op)+  getUnspent op = runInWebReader (getUnspent op)+  getBalance a = runInWebReader (getBalance a)+  getMempool = runInWebReader getMempool++instance+  (MonadUnliftIO m, MonadLoggerIO m) =>+  StoreReadExtra (ReaderT WebState m)+  where+  getMaxGap = runInWebReader getMaxGap+  getInitialGap = runInWebReader getInitialGap+  getBalances as = runInWebReader (getBalances as)+  getAddressesTxs as = runInWebReader . getAddressesTxs as+  getAddressTxs a = runInWebReader . getAddressTxs a+  getAddressUnspents a = runInWebReader . getAddressUnspents a+  getAddressesUnspents as = runInWebReader . getAddressesUnspents as+  xPubBals = runInWebReader . xPubBals+  xPubUnspents xpub xbals = runInWebReader . xPubUnspents xpub xbals+  xPubTxs xpub xbals = runInWebReader . xPubTxs xpub xbals+  xPubTxCount xpub = runInWebReader . xPubTxCount xpub+  getNumTxData = runInWebReader . getNumTxData++instance (MonadUnliftIO m) => StoreReadBase (WebT m) where+  getCtx = lift getCtx+  getNetwork = lift getNetwork+  getBestBlock = lift getBestBlock+  getBlocksAtHeight = lift . getBlocksAtHeight+  getBlock = lift . getBlock+  getTxData = lift . getTxData+  getSpender = lift . getSpender+  getUnspent = lift . getUnspent+  getBalance = lift . getBalance+  getMempool = lift getMempool++instance (MonadUnliftIO m, MonadLoggerIO m) => StoreReadExtra (WebT m) where+  getBalances = lift . getBalances+  getAddressesTxs as = lift . getAddressesTxs as+  getAddressTxs a = lift . getAddressTxs a+  getAddressUnspents a = lift . getAddressUnspents a+  getAddressesUnspents as = lift . getAddressesUnspents as+  xPubBals = lift . xPubBals+  xPubUnspents xpub xbals = lift . xPubUnspents xpub xbals+  xPubTxs xpub xbals = lift . xPubTxs xpub xbals+  xPubTxCount xpub = lift . xPubTxCount xpub+  getMaxGap = lift getMaxGap+  getInitialGap = lift getInitialGap+  getNumTxData = lift . getNumTxData++-------------------+-- Path Handlers --+-------------------++runWeb :: (MonadUnliftIO m, MonadLoggerIO m) => WebConfig -> m ()+runWeb config = do+  ticker <- newTVarIO HashMap.empty+  metrics <- mapM createMetrics config.stats+  session <- liftIO Wreq.Session.newAPISession+  health <- runHealthCheck >>= newTVarIO+  let state = WebState {..}+  withAsync (priceUpdater session ticker) $ \_a1 ->+    withAsync (healthCheckLoop health) $ \_a2 -> do+      logger <- logIt+      runner <- askRunInIO+      S.scottyOptsT opts (runner . flip runReaderT state) $ do+        S.middleware $ webSocketEvents state+        S.middleware logger+        S.defaultHandler defHandler+        handlePaths config+        S.notFound $ raise ThingNotFound+  where+    priceUpdater session =+      unless (config.noSlow || config.noBlockchainInfo)+        . price+          config.store.net+          session+          config.tickerURL+          config.tickerRefresh+    runHealthCheck = runReaderT (healthCheck config) config.store.db+    healthCheckLoop v = forever $ do+      threadDelay (config.healthCheckInterval * 1000 * 1000)+      runHealthCheck >>= atomically . writeTVar v+    opts = def {S.settings = settings defaultSettings}+    settings = setPort config.port . setHost (fromString config.host)++getRates ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  Network ->+  Wreq.Session ->+  String ->+  Text ->+  [Word64] ->+  m [BinfoRate]+getRates net session url currency times = do+  handleAny err $ do+    r <-+      liftIO $+        Wreq.asJSON+          =<< Wreq.Session.postWith opts session url body+    return $ r ^. Wreq.responseBody+  where+    err _ = do+      $(logErrorS) "Web" "Could not get historic prices"+      return []+    body = toJSON times+    base =+      Wreq.defaults+        & Wreq.param "base" .~ [T.toUpper $ T.pack net.name]+    opts = base & Wreq.param "quote" .~ [currency]++price ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  Network ->+  Wreq.Session ->+  String ->+  Int ->+  TVar (HashMap Text BinfoTicker) ->+  m ()+price net session url pget v = forM_ purl $ \u -> forever $ do+  let err e = $(logErrorS) "Price" $ cs (show e)+  handleAny err $ do+    r <- liftIO $ Wreq.asJSON =<< Wreq.Session.get session u+    atomically . writeTVar v $ r ^. Wreq.responseBody+  threadDelay pget+  where+    purl = case code of+      Nothing -> Nothing+      Just x -> Just (url <> "?base=" <> x)+      where+        code+          | net == btc = Just "btc"+          | net == bch = Just "bch"+          | otherwise = Nothing++raise :: (MonadIO m) => Except -> WebT m a+raise err = do+  asks (.metrics) >>= mapM_ \m -> do+    let status = errStatus err+    liftIO $+      mapM_ (`incrementCounter` 1) $+        if+          | statusIsClientError status -> Just m.clientErrors+          | statusIsServerError status -> Just m.serverErrors+          | otherwise -> Nothing+  S.raise err++errStatus :: Except -> Status+errStatus ThingNotFound = status404+errStatus BadRequest = status400+errStatus UserError {} = status400+errStatus StringError {} = status400+errStatus ServerError = status500+errStatus TxIndexConflict {} = status409+errStatus ServerTimeout = status500+errStatus RequestTooLarge = status413++defHandler :: (Monad m) => Except -> WebT m ()+defHandler e = do+  setHeaders+  S.status $ errStatus e+  S.json e++handlePaths ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  WebConfig ->+  S.ScottyT Except (ReaderT WebState m) ()+handlePaths WebConfig {..} = do+  -- Block Paths+  pathCompact+    (GetBlock <$> paramLazy <*> paramDef)+    scottyBlock+    (marshalEncoding net)+    (marshalValue net)+  pathCompact+    (GetBlockBest <$> paramDef)+    scottyBlockBest+    (marshalEncoding net)+    (marshalValue net)+  pathCompact+    (GetBlockHeight <$> paramLazy <*> paramDef)+    (fmap SerialList . scottyBlockHeight)+    (list (marshalEncoding net) . (.get))+    (json_list (marshalValue net) . (.get))+  pathCompact+    (GetBlockTime <$> paramLazy <*> paramDef)+    scottyBlockTime+    (marshalEncoding net)+    (marshalValue net)+  pathCompact+    (GetBlockMTP <$> paramLazy <*> paramDef)+    scottyBlockMTP+    (marshalEncoding net)+    (marshalValue net)+  pathCompact+    (GetTx <$> paramLazy)+    scottyTx+    (marshalEncoding net)+    (marshalValue net)+  pathCompact+    (GetTxRaw <$> paramLazy)+    scottyTxRaw+    toEncoding+    toJSON+  pathCompact+    (PostTx <$> parseBody)+    scottyPostTx+    toEncoding+    toJSON+  pathCompact+    (GetMempool <$> paramOptional <*> parseOffset)+    (fmap SerialList . scottyMempool)+    toEncoding+    toJSON+  pathCompact+    (GetAddrTxs <$> paramLazy <*> parseLimits)+    (fmap SerialList . scottyAddrTxs)+    toEncoding+    toJSON+  pathCompact+    (GetAddrBalance <$> paramLazy)+    scottyAddrBalance+    (marshalEncoding net)+    (marshalValue net)+  pathCompact+    (GetAddrUnspent <$> paramLazy <*> parseLimits)+    (fmap SerialList . scottyAddrUnspent)+    (list (marshalEncoding net) . (.get))+    (json_list (marshalValue net) . (.get))+  pathCompact+    (GetPeers & return)+    (fmap SerialList . scottyPeers)+    toEncoding+    toJSON+  pathCompact+    (GetHealth & return)+    scottyHealth+    toEncoding+    toJSON+  S.get "/events" scottyEvents+  S.get "/dbstats" scottyDbStats+  unless noSlow $ do+    pathCompact+      (GetBlocks <$> param <*> paramDef)+      (fmap SerialList . scottyBlocks)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetBlockRaw <$> paramLazy)+      scottyBlockRaw+      toEncoding+      toJSON+    pathCompact+      (GetBlockBestRaw & return)+      scottyBlockBestRaw+      toEncoding+      toJSON+    pathCompact+      (GetBlockLatest <$> paramDef)+      (fmap SerialList . scottyBlockLatest)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetBlockHeights <$> param <*> paramDef)+      (fmap SerialList . scottyBlockHeights)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetBlockHeightRaw <$> paramLazy)+      scottyBlockHeightRaw+      toEncoding+      toJSON+    pathCompact+      (GetBlockTimeRaw <$> paramLazy)+      scottyBlockTimeRaw+      toEncoding+      toJSON+    pathCompact+      (GetBlockMTPRaw <$> paramLazy)+      scottyBlockMTPRaw+      toEncoding+      toJSON+    pathCompact+      (GetTxs <$> param)+      (fmap SerialList . scottyTxs)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetTxsRaw <$> param)+      scottyTxsRaw+      toEncoding+      toJSON+    pathCompact+      (GetTxsBlock <$> paramLazy)+      (fmap SerialList . scottyTxsBlock)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetTxsBlockRaw <$> paramLazy)+      scottyTxsBlockRaw+      toEncoding+      toJSON+    pathCompact+      (GetTxAfter <$> paramLazy <*> paramLazy)+      scottyTxAfter+      toEncoding+      toJSON+    pathCompact+      (GetAddrsTxs <$> param <*> parseLimits)+      (fmap SerialList . scottyAddrsTxs)+      toEncoding+      toJSON+    pathCompact+      (GetAddrTxsFull <$> paramLazy <*> parseLimits)+      (fmap SerialList . scottyAddrTxsFull)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetAddrsTxsFull <$> param <*> parseLimits)+      (fmap SerialList . scottyAddrsTxsFull)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetAddrsBalance <$> param)+      (fmap SerialList . scottyAddrsBalance)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetAddrsUnspent <$> param <*> parseLimits)+      (fmap SerialList . scottyAddrsUnspent)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetXPub <$> paramLazy <*> paramDef <*> paramDef)+      scottyXPub+      toEncoding+      toJSON+    pathCompact+      (GetXPubTxs <$> paramLazy <*> paramDef <*> parseLimits <*> paramDef)+      (fmap SerialList . scottyXPubTxs)+      toEncoding+      toJSON+    pathCompact+      (GetXPubTxsFull <$> paramLazy <*> paramDef <*> parseLimits <*> paramDef)+      (fmap SerialList . scottyXPubTxsFull)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetXPubBalances <$> paramLazy <*> paramDef <*> paramDef)+      (fmap SerialList . scottyXPubBalances)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (GetXPubUnspent <$> paramLazy <*> paramDef <*> parseLimits <*> paramDef)+      (fmap SerialList . scottyXPubUnspent)+      (list (marshalEncoding net) . (.get))+      (json_list (marshalValue net) . (.get))+    pathCompact+      (DelCachedXPub <$> paramLazy <*> paramDef)+      scottyDelXPub+      toEncoding+      toJSON+    unless noBlockchainInfo $ do+      S.post "/blockchain/multiaddr" scottyMultiAddr+      S.get "/blockchain/multiaddr" scottyMultiAddr+      S.get "/blockchain/balance" scottyShortBal+      S.post "/blockchain/balance" scottyShortBal+      S.get "/blockchain/rawaddr/:addr" scottyRawAddr+      S.get "/blockchain/address/:addr" scottyRawAddr+      S.get "/blockchain/xpub/:addr" scottyRawAddr+      S.post "/blockchain/unspent" scottyBinfoUnspent+      S.get "/blockchain/unspent" scottyBinfoUnspent+      S.get "/blockchain/rawtx/:txid" scottyBinfoTx+      S.get "/blockchain/rawblock/:block" scottyBinfoBlock+      S.get "/blockchain/latestblock" scottyBinfoLatest+      S.get "/blockchain/unconfirmed-transactions" scottyBinfoMempool+      S.get "/blockchain/block-height/:height" scottyBinfoBlockHeight+      S.get "/blockchain/blocks/:milliseconds" scottyBinfoBlocksDay+      S.get "/blockchain/export-history" scottyBinfoHistory+      S.post "/blockchain/export-history" scottyBinfoHistory+      S.get "/blockchain/q/addresstohash/:addr" scottyBinfoAddrToHash+      S.get "/blockchain/q/hashtoaddress/:hash" scottyBinfoHashToAddr+      S.get "/blockchain/q/addrpubkey/:pubkey" scottyBinfoAddrPubkey+      S.get "/blockchain/q/pubkeyaddr/:addr" scottyBinfoPubKeyAddr+      S.get "/blockchain/q/hashpubkey/:pubkey" scottyBinfoHashPubkey+      S.get "/blockchain/q/getblockcount" scottyBinfoGetBlockCount+      S.get "/blockchain/q/latesthash" scottyBinfoLatestHash+      S.get "/blockchain/q/bcperblock" scottyBinfoSubsidy+      S.get "/blockchain/q/txtotalbtcoutput/:txid" scottyBinfoTotalOut+      S.get "/blockchain/q/txtotalbtcinput/:txid" scottyBinfoTotalInput+      S.get "/blockchain/q/txfee/:txid" scottyBinfoTxFees+      S.get "/blockchain/q/txresult/:txid/:addr" scottyBinfoTxResult+      S.get "/blockchain/q/getreceivedbyaddress/:addr" scottyBinfoReceived+      S.get "/blockchain/q/getsentbyaddress/:addr" scottyBinfoSent+      S.get "/blockchain/q/addressbalance/:addr" scottyBinfoAddrBalance+      S.get "/blockchain/q/addressfirstseen/:addr" scottyFirstSeen+  where+    json_list f = toJSONList . map f+    net = store.net++pathCompact ::+  (ApiResource a b, MonadIO m) =>+  WebT m a ->+  (a -> WebT m b) ->+  (b -> Encoding) ->+  (b -> Value) ->+  S.ScottyT Except (ReaderT WebState m) ()+pathCompact parser action encJson encValue =+  pathCommon parser action encJson encValue False++pathCommon ::+  (ApiResource a b, MonadIO m) =>+  WebT m a ->+  (a -> WebT m b) ->+  (b -> Encoding) ->+  (b -> Value) ->+  Bool ->+  S.ScottyT Except (ReaderT WebState m) ()+pathCommon parser action encJson encValue pretty =+  S.addroute (resourceMethod proxy) (capturePath proxy) $ do+    setHeaders+    proto <- setupContentType pretty+    apiRes <- parser+    res <- action apiRes+    S.raw $ protoSerial proto encJson encValue res+  where+    toProxy :: WebT m a -> Proxy a+    toProxy = const Proxy+    proxy = toProxy parser++streamEncoding :: (Monad m) => Encoding -> WebT m ()+streamEncoding e = do+  S.setHeader "Content-Type" "application/json; charset=utf-8"+  S.raw (encodingToLazyByteString e)++protoSerial ::+  (Serial a) =>+  SerialAs ->+  (a -> Encoding) ->+  (a -> Value) ->+  a ->+  L.ByteString+protoSerial SerialAsBinary _ _ = runPutL . serialize+protoSerial SerialAsJSON f _ = encodingToLazyByteString . f+protoSerial SerialAsPrettyJSON _ g =+  encodePretty' defConfig {confTrailingNewline = True} . g++setHeaders :: (Monad m) => ActionT e m ()+setHeaders = S.setHeader "Access-Control-Allow-Origin" "*"++setupJSON :: (Monad m) => Bool -> ActionT Except m SerialAs+setupJSON pretty = do+  S.setHeader "Content-Type" "application/json"+  p <- S.param "pretty" `S.rescue` const (return pretty)+  return $ if p then SerialAsPrettyJSON else SerialAsJSON++setupBinary :: (Monad m) => ActionT Except m SerialAs+setupBinary = do+  S.setHeader "Content-Type" "application/octet-stream"+  return SerialAsBinary++setupContentType :: (Monad m) => Bool -> ActionT Except m SerialAs+setupContentType pretty = do+  accept <- S.header "accept"+  maybe (setupJSON pretty) setType accept+  where+    setType "application/octet-stream" = setupBinary+    setType _ = setupJSON pretty++-- GET Block / GET Blocks --++scottyBlock ::+  (MonadUnliftIO m) => GetBlock -> WebT m BlockData+scottyBlock (GetBlock h (NoTx noTx)) = withMetrics (.block) $ do+  getBlock h >>= \case+    Nothing ->+      raise ThingNotFound+    Just b -> do+      return $ pruneTx noTx b++getBlocks ::+  (MonadUnliftIO m) =>+  [H.BlockHash] ->+  Bool ->+  WebT m [BlockData]+getBlocks hs notx =+  (pruneTx notx <$>) . catMaybes <$> mapM getBlock (nub hs)++scottyBlocks ::+  (MonadUnliftIO m) => GetBlocks -> WebT m [BlockData]+scottyBlocks (GetBlocks hs (NoTx notx)) =+  withMetrics (.block) $+    getBlocks hs notx++pruneTx :: Bool -> BlockData -> BlockData+pruneTx False b = b+pruneTx True BlockData {..} = BlockData {txs = take 1 txs, ..}++-- GET BlockRaw --++scottyBlockRaw ::+  (MonadUnliftIO m) =>+  GetBlockRaw ->+  WebT m (RawResult H.Block)+scottyBlockRaw (GetBlockRaw h) =+  withMetrics (.blockRaw) $+    RawResult <$> getRawBlock h++getRawBlock ::+  (MonadUnliftIO m) =>+  H.BlockHash ->+  WebT m H.Block+getRawBlock h =+  getBlock h >>= maybe (raise ThingNotFound) return >>= lift . toRawBlock++toRawBlock :: (StoreReadBase m) => BlockData -> m H.Block+toRawBlock b = do+  txs <- map transactionData . catMaybes <$> mapM getTransaction b.txs+  return H.Block {header = b.header, txs}++-- GET BlockBest / BlockBestRaw --++scottyBlockBest ::+  (MonadUnliftIO m) => GetBlockBest -> WebT m BlockData+scottyBlockBest (GetBlockBest (NoTx notx)) =+  withMetrics (.block) $+    maybe (raise ThingNotFound) (return . pruneTx notx) <=< runMaybeT $+      MaybeT getBestBlock >>= MaybeT . getBlock++scottyBlockBestRaw ::+  (MonadUnliftIO m) =>+  GetBlockBestRaw ->+  WebT m (RawResult H.Block)+scottyBlockBestRaw _ =+  withMetrics (.blockRaw) $+    maybe (raise ThingNotFound) (return . RawResult) <=< runMaybeT $+      MaybeT getBestBlock >>= lift . getRawBlock++-- GET BlockLatest --++scottyBlockLatest ::+  (MonadUnliftIO m) =>+  GetBlockLatest ->+  WebT m [BlockData]+scottyBlockLatest (GetBlockLatest (NoTx noTx)) =+  withMetrics (.block) $+    getBestBlock >>= maybe (raise ThingNotFound) (go [] <=< getBlock)+  where+    go acc Nothing = return $ reverse acc+    go acc (Just b)+      | b.height <= 0 = return $ reverse acc+      | length acc == 99 = return . reverse $ pruneTx noTx b : acc+      | otherwise = go (pruneTx noTx b : acc) =<< getBlock b.header.prev++-- GET BlockHeight / BlockHeights / BlockHeightRaw --++scottyBlockHeight ::+  (MonadUnliftIO m) => GetBlockHeight -> WebT m [BlockData]+scottyBlockHeight (GetBlockHeight h (NoTx notx)) =+  withMetrics (.block) $+    getBlocksAtHeight (fromIntegral h)+      >>= (`getBlocks` notx)++scottyBlockHeights ::+  (MonadUnliftIO m) =>+  GetBlockHeights ->+  WebT m [BlockData]+scottyBlockHeights (GetBlockHeights (HeightsParam heights) (NoTx notx)) =+  withMetrics (.block) $+    mapM (getBlocksAtHeight . fromIntegral) heights+      >>= (`getBlocks` notx) . concat++scottyBlockHeightRaw ::+  (MonadUnliftIO m) =>+  GetBlockHeightRaw ->+  WebT m (RawResultList H.Block)+scottyBlockHeightRaw (GetBlockHeightRaw h) =+  withMetrics (.blockRaw) $+    fmap RawResultList $+      mapM getRawBlock =<< getBlocksAtHeight (fromIntegral h)++-- GET BlockTime / BlockTimeRaw --++scottyBlockTime ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetBlockTime ->+  WebT m BlockData+scottyBlockTime (GetBlockTime (TimeParam t) (NoTx notx)) =+  withMetrics (.block) $ do+    ch <- asks (.config.store.chain)+    blockAtOrBefore ch t >>= \case+      Nothing -> raise ThingNotFound+      Just b -> return $ pruneTx notx b++scottyBlockMTP ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetBlockMTP ->+  WebT m BlockData+scottyBlockMTP (GetBlockMTP (TimeParam t) (NoTx notx)) =+  withMetrics (.block) $ do+    ch <- asks (.config.store.chain)+    blockAtOrAfterMTP ch t >>= \case+      Nothing -> raise ThingNotFound+      Just b -> return $ pruneTx notx b++scottyBlockTimeRaw ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetBlockTimeRaw ->+  WebT m (RawResult H.Block)+scottyBlockTimeRaw (GetBlockTimeRaw (TimeParam t)) =+  withMetrics (.blockRaw) $ do+    ch <- asks (.config.store.chain)+    blockAtOrBefore ch t >>= \case+      Nothing -> raise ThingNotFound+      Just b -> RawResult <$> lift (toRawBlock b)++scottyBlockMTPRaw ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetBlockMTPRaw ->+  WebT m (RawResult H.Block)+scottyBlockMTPRaw (GetBlockMTPRaw (TimeParam t)) =+  withMetrics (.blockRaw) $ do+    ch <- asks (.config.store.chain)+    blockAtOrAfterMTP ch t >>= \case+      Nothing -> raise ThingNotFound+      Just b -> RawResult <$> lift (toRawBlock b)++-- GET Transactions --++scottyTx :: (MonadUnliftIO m) => GetTx -> WebT m Transaction+scottyTx (GetTx txid) =+  withMetrics (.tx) $+    getTransaction txid >>= maybe (raise ThingNotFound) return++scottyTxs ::+  (MonadUnliftIO m) => GetTxs -> WebT m [Transaction]+scottyTxs (GetTxs txids) =+  withMetrics (.tx) $+    catMaybes <$> mapM getTransaction (nub txids)++scottyTxRaw ::+  (MonadUnliftIO m) => GetTxRaw -> WebT m (RawResult Tx)+scottyTxRaw (GetTxRaw txid) =+  withMetrics (.txRaw) $+    getTransaction txid+      >>= \case+        Nothing -> raise ThingNotFound+        Just tx -> return $ RawResult (transactionData tx)++scottyTxsRaw ::+  (MonadUnliftIO m) =>+  GetTxsRaw ->+  WebT m (RawResultList Tx)+scottyTxsRaw (GetTxsRaw txids) =+  withMetrics (.txRaw) $+    RawResultList . map transactionData . catMaybes+      <$> mapM getTransaction (nub txids)++getTxsBlock ::+  (MonadUnliftIO m) =>+  H.BlockHash ->+  WebT m [Transaction]+getTxsBlock h =+  getBlock h >>= \case+    Nothing -> raise ThingNotFound+    Just b -> catMaybes <$> mapM getTransaction b.txs++scottyTxsBlock ::+  (MonadUnliftIO m) =>+  GetTxsBlock ->+  WebT m [Transaction]+scottyTxsBlock (GetTxsBlock h) =+  withMetrics (.txBlock) $ getTxsBlock h++scottyTxsBlockRaw ::+  (MonadUnliftIO m) =>+  GetTxsBlockRaw ->+  WebT m (RawResultList Tx)+scottyTxsBlockRaw (GetTxsBlockRaw h) =+  withMetrics (.txBlockRaw) $+    RawResultList . map transactionData <$> getTxsBlock h++-- GET TransactionAfterHeight --++scottyTxAfter ::+  (MonadUnliftIO m) =>+  GetTxAfter ->+  WebT m (GenericResult (Maybe Bool))+scottyTxAfter (GetTxAfter txid height) =+  withMetrics (.txAfter) $+    GenericResult . fst <$> cbAfterHeight (fromIntegral height) txid++-- | Check if any of the ancestors of this transaction is a coinbase after the+-- specified height. Returns 'Nothing' if answer cannot be computed before+-- hitting limits.+cbAfterHeight ::+  (StoreReadBase m) =>+  H.BlockHeight ->+  TxHash ->+  m (Maybe Bool, Int)+cbAfterHeight height txid =+  inputs n HashSet.empty HashSet.empty [txid]+  where+    n = 10000+    inputs 0 _ _ [] = return (Nothing, 10000)+    inputs i is ns [] =+      let is' = HashSet.union is ns+          ns' = HashSet.empty+          ts = HashSet.toList (HashSet.difference ns is)+       in case ts of+            [] -> return (Just False, n - i)+            _ -> inputs i is' ns' ts+    inputs i is ns (t : ts) =+      getTransaction t >>= \case+        Nothing -> return (Nothing, n - i)+        Just tx+          | height_check tx ->+              if cb_check tx+                then return (Just True, n - i + 1)+                else+                  let ns' = HashSet.union (ins tx) ns+                   in inputs (i - 1) is ns' ts+          | otherwise -> inputs (i - 1) is ns ts+    cb_check = any isCoinbase . (.inputs)+    ins = HashSet.fromList . map (.outpoint.hash) . (.inputs)+    height_check tx =+      case tx.block of+        BlockRef h _ -> h > height+        MemRef _ -> True++-- POST Transaction --++scottyPostTx :: (MonadUnliftIO m) => PostTx -> WebT m TxId+scottyPostTx (PostTx tx) =+  withMetrics (.txPost) $ do+    cfg <- asks (.config)+    lift (publishTx cfg tx) >>= \case+      Right () -> return (TxId (txHash tx))+      Left e@(PubReject _) -> raise $ UserError (show e)+      _ -> raise ServerError++-- | Publish a new transaction to the network.+publishTx ::+  (MonadUnliftIO m, StoreReadBase m) =>+  WebConfig ->+  Tx ->+  m (Either PubExcept ())+publishTx cfg tx =+  withSubscription pub $ \s ->+    getTransaction (txHash tx) >>= \case+      Just _ -> return $ Right ()+      Nothing -> go s+  where+    pub = cfg.store.pub+    mgr = cfg.store.peerMgr+    net = cfg.store.net+    go s =+      getPeers mgr >>= \case+        [] -> return $ Left PubNoPeers+        OnlinePeer {mailbox = p} : _ -> do+          MTx tx `sendMessage` p+          let v =+                if net.segWit+                  then InvWitnessTx+                  else InvTx+          sendMessage+            (MGetData (GetData [InvVector v (txHash tx).get]))+            p+          f p s+    t = 5 * 1000 * 1000+    f p s+      | cfg.noMempool = return $ Right ()+      | otherwise =+          liftIO (UnliftIO.timeout t (g p s)) >>= \case+            Nothing -> return $ Left PubTimeout+            Just (Left e) -> return $ Left e+            Just (Right ()) -> return $ Right ()+    g p s =+      receive s >>= \case+        StoreTxReject p' h' c _+          | p == p' && h' == txHash tx -> return . Left $ PubReject c+        StorePeerDisconnected p'+          | p == p' -> return $ Left PubPeerDisconnected+        StoreMempoolNew h'+          | h' == txHash tx -> return $ Right ()+        _ -> g p s++-- GET Mempool / Events --++scottyMempool ::+  (MonadUnliftIO m) => GetMempool -> WebT m [TxHash]+scottyMempool (GetMempool limitM (OffsetParam o)) =+  withMetrics (.mempool) $ do+    WebLimits {..} <- asks (.config.limits)+    let wl' = WebLimits {maxItemCount = 0, ..}+        l = Limits (validateLimit wl' False limitM) (fromIntegral o) Nothing+    map snd . applyLimits l <$> getMempool++webSocketEvents :: WebState -> Middleware+webSocketEvents s =+  websocketsOr defaultConnectionOptions (wrap . events)+  where+    pub = s.config.store.pub+    gauge = (.events) <$> s.metrics+    wrap f = case gauge of+      Nothing -> f+      Just g -> withGaugeIO g f+    events pending = withSubscription pub $ \sub -> do+      let path = requestPath $ pendingRequest pending+      if path == "/events"+        then do+          conn <- acceptRequest pending+          forever $+            receiveEvent sub >>= \case+              Nothing -> return ()+              Just event -> sendTextData conn (A.encode event)+        else+          rejectRequestWith+            pending+            WebSockets.defaultRejectRequest+              { WebSockets.rejectBody =+                  L.toStrict $ A.encode ThingNotFound,+                WebSockets.rejectCode =+                  404,+                WebSockets.rejectMessage =+                  "Not Found",+                WebSockets.rejectHeaders =+                  [("Content-Type", "application/json")]+              }++scottyEvents :: (MonadUnliftIO m) => WebT m ()+scottyEvents =+  withGaugeIncrease (.events) $ do+    setHeaders+    proto <- setupContentType False+    pub <- lift $ asks (.config.store.pub)+    S.stream $ \io flush' ->+      withSubscription pub $ \sub ->+        forever $ do+          flush'+          receiveEvent sub >>= \case+            Nothing -> return ()+            Just msg -> io (serial proto msg)+  where+    serial proto e =+      lazyByteString $+        protoSerial proto toEncoding toJSON e <> newLine proto+    newLine SerialAsBinary = mempty+    newLine SerialAsJSON = "\n"+    newLine SerialAsPrettyJSON = mempty++receiveEvent :: Inbox StoreEvent -> IO (Maybe Event)+receiveEvent sub =+  go <$> receive sub+  where+    go = \case+      StoreBestBlock b -> Just (EventBlock b)+      StoreMempoolNew t -> Just (EventTx t)+      StoreMempoolDelete t -> Just (EventTx t)+      _ -> Nothing++-- GET Address Transactions --++scottyAddrTxs ::+  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrTxs -> WebT m [TxRef]+scottyAddrTxs (GetAddrTxs addr pLimits) =+  withMetrics (.addressTx) $+    getAddressTxs addr =<< paramToLimits False pLimits++scottyAddrsTxs ::+  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsTxs -> WebT m [TxRef]+scottyAddrsTxs (GetAddrsTxs addrs pLimits) =+  withMetrics (.addressTx) $+    getAddressesTxs addrs =<< paramToLimits False pLimits++scottyAddrTxsFull ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetAddrTxsFull ->+  WebT m [Transaction]+scottyAddrTxsFull (GetAddrTxsFull addr pLimits) =+  withMetrics (.addressTxFull) $ do+    txs <- getAddressTxs addr =<< paramToLimits True pLimits+    catMaybes <$> mapM (getTransaction . (.txid)) txs++scottyAddrsTxsFull ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetAddrsTxsFull ->+  WebT m [Transaction]+scottyAddrsTxsFull (GetAddrsTxsFull addrs pLimits) =+  withMetrics (.addressTxFull) $ do+    txs <- getAddressesTxs addrs =<< paramToLimits True pLimits+    catMaybes <$> mapM (getTransaction . (.txid)) txs++scottyAddrBalance :: (MonadUnliftIO m) => GetAddrBalance -> WebT m Balance+scottyAddrBalance (GetAddrBalance addr) =+  withMetrics (.addressBalance) $ getDefaultBalance addr++scottyAddrsBalance ::+  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsBalance -> WebT m [Balance]+scottyAddrsBalance (GetAddrsBalance addrs) =+  withMetrics (.addressBalance) $ getBalances addrs++scottyAddrUnspent ::+  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrUnspent -> WebT m [Unspent]+scottyAddrUnspent (GetAddrUnspent addr pLimits) =+  withMetrics (.addressUnspent) $+    getAddressUnspents addr =<< paramToLimits False pLimits++scottyAddrsUnspent ::+  (MonadUnliftIO m, MonadLoggerIO m) => GetAddrsUnspent -> WebT m [Unspent]+scottyAddrsUnspent (GetAddrsUnspent addrs pLimits) =+  withMetrics (.addressUnspent) $+    getAddressesUnspents addrs =<< paramToLimits False pLimits++-- GET XPubs --++scottyXPub ::+  (MonadUnliftIO m, MonadLoggerIO m) => GetXPub -> WebT m XPubSummary+scottyXPub (GetXPub xpub deriv (NoCache noCache)) =+  withMetrics (.xpub) $+    let xs = XPubSpec xpub deriv+     in xPubSummary xs <$> lift (runNoCache noCache $ xPubBals xs)++scottyDelXPub ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  DelCachedXPub ->+  WebT m (GenericResult Bool)+scottyDelXPub (DelCachedXPub xpub deriv) =+  withMetrics (.xpubDelete) $ do+    c <- asks (.config.store.cache)+    n <- lift (withCache c $ cacheDelXPubs [XPubSpec xpub deriv])+    return $ GenericResult (n > 0)++getXPubTxs ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  XPubKey ->+  DeriveType ->+  LimitsParam ->+  Bool ->+  WebT m [TxRef]+getXPubTxs xpub deriv plimits nocache = do+  limits <- paramToLimits False plimits+  let xs = XPubSpec xpub deriv+  xbals <- xPubBals xs+  lift $ runNoCache nocache $ xPubTxs xs xbals limits++scottyXPubTxs ::+  (MonadUnliftIO m, MonadLoggerIO m) => GetXPubTxs -> WebT m [TxRef]+scottyXPubTxs (GetXPubTxs xpub deriv plimits (NoCache nocache)) =+  withMetrics (.xpubTx) $+    getXPubTxs xpub deriv plimits nocache++scottyXPubTxsFull ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetXPubTxsFull ->+  WebT m [Transaction]+scottyXPubTxsFull (GetXPubTxsFull xpub deriv plimits (NoCache nocache)) =+  withMetrics (.xpubTxFull) $+    fmap catMaybes $+      lift . runNoCache nocache . mapM (getTransaction . (.txid))+        =<< getXPubTxs xpub deriv plimits nocache++scottyXPubBalances ::+  (MonadUnliftIO m, MonadLoggerIO m) => GetXPubBalances -> WebT m [XPubBal]+scottyXPubBalances (GetXPubBalances xpub deriv (NoCache noCache)) =+  withMetrics (.xpubBalance) $+    lift $+      runNoCache noCache $+        xPubBals (XPubSpec xpub deriv)++scottyXPubUnspent ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetXPubUnspent ->+  WebT m [XPubUnspent]+scottyXPubUnspent (GetXPubUnspent xpub deriv pLimits (NoCache noCache)) =+  withMetrics (.xpubUnspent) $ do+    limits <- paramToLimits False pLimits+    let xspec = XPubSpec xpub deriv+    xbals <- xPubBals xspec+    lift $ runNoCache noCache $ xPubUnspents xspec xbals limits++---------------------------------------+-- Blockchain.info API Compatibility --+---------------------------------------++netBinfoSymbol :: Network -> BinfoSymbol+netBinfoSymbol net+  | net == btc =+      BinfoSymbol+        { code = "BTC",+          symbol = "BTC",+          name = "Bitcoin",+          conversion = 100 * 1000 * 1000,+          after = True,+          local = False+        }+  | net == bch =+      BinfoSymbol+        { code = "BCH",+          symbol = "BCH",+          name = "Bitcoin Cash",+          conversion = 100 * 1000 * 1000,+          after = True,+          local = False+        }+  | otherwise =+      BinfoSymbol+        { code = "XTS",+          symbol = "¤",+          name = "Test",+          conversion = 100 * 1000 * 1000,+          after = False,+          local = False+        }++binfoTickerToSymbol :: Text -> BinfoTicker -> BinfoSymbol+binfoTickerToSymbol code BinfoTicker {..} =+  BinfoSymbol+    { code,+      symbol,+      name,+      conversion = 100 * 1000 * 1000 / fifteen, -- sat/usd+      after = False,+      local = True+    }+  where+    name = case code of+      "EUR" -> "Euro"+      "USD" -> "U.S. dollar"+      "GBP" -> "British pound"+      x -> x++getBinfoAddrsParam ::+  (MonadIO m) =>+  Text ->+  WebT m (HashSet BinfoAddr)+getBinfoAddrsParam name = do+  net <- asks (.config.store.net)+  ctx <- asks (.config.store.ctx)+  p <- S.param (cs name) `S.rescue` const (return "")+  if T.null p+    then return HashSet.empty+    else case parseBinfoAddr net ctx p of+      Nothing -> raise (UserError "invalid address")+      Just xs -> return $ HashSet.fromList xs++getBinfoActive ::+  (MonadIO m) =>+  WebT m (HashSet XPubSpec, HashSet Address)+getBinfoActive = do+  active <- getBinfoAddrsParam "active"+  p2sh <- getBinfoAddrsParam "activeP2SH"+  bech32 <- getBinfoAddrsParam "activeBech32"+  let xspec d b = (`XPubSpec` d) <$> xpub b+      xspecs =+        HashSet.fromList $+          concat+            [ mapMaybe (xspec DeriveNormal) (HashSet.toList active),+              mapMaybe (xspec DeriveP2SH) (HashSet.toList p2sh),+              mapMaybe (xspec DeriveP2WPKH) (HashSet.toList bech32)+            ]+      addrs = HashSet.fromList $ mapMaybe addr $ HashSet.toList active+  return (xspecs, addrs)+  where+    addr (BinfoAddr a) = Just a+    addr (BinfoXpub _) = Nothing+    xpub (BinfoXpub x) = Just x+    xpub (BinfoAddr _) = Nothing++getNumTxId :: (MonadIO m) => WebT m Bool+getNumTxId = fmap not $ S.param "txidindex" `S.rescue` const (return False)++getChainHeight :: (MonadUnliftIO m) => WebT m H.BlockHeight+getChainHeight = fmap (.height) $ chainGetBest =<< asks (.config.store.chain)++scottyBinfoUnspent :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoUnspent =+  withMetrics (.binfoUnspent) $ do+    (xspecs, addrs) <- getBinfoActive+    numtxid <- getNumTxId+    limit <- get_limit+    min_conf <- get_min_conf+    net <- lift $ asks (.config.store.net)+    ctx <- lift $ asks (.config.store.ctx)+    height <- getChainHeight+    let mn u = min_conf > u.confirmations+    xbals <- lift $ getXBals xspecs+    bus <-+      lift . runConduit $+        getBinfoUnspents numtxid height xbals xspecs addrs+          .| (dropWhileC mn >> takeC limit .| sinkList)+    setHeaders+    streamEncoding (marshalEncoding (net, ctx) (BinfoUnspents bus))+  where+    get_limit = fmap (min 1000) $ S.param "limit" `S.rescue` const (return 250)+    get_min_conf = S.param "confirmations" `S.rescue` const (return 0)++getBinfoUnspents ::+  (StoreReadExtra m, MonadIO m) =>+  Bool ->+  H.BlockHeight ->+  HashMap XPubSpec [XPubBal] ->+  HashSet XPubSpec ->+  HashSet Address ->+  ConduitT () BinfoUnspent m ()+getBinfoUnspents numtxid height xbals xspecs addrs = do+  cs' <- conduits+  joinDescStreams cs' .| mapC (uncurry binfo)+  where+    binfo u xp =+      let conf = case u.block of+            MemRef _ -> 0+            BlockRef h _ -> height - h + 1+       in BinfoUnspent+            { txid = u.outpoint.hash,+              index = u.outpoint.index,+              script = u.script,+              value = u.value,+              confirmations = fromIntegral conf,+              txidx = encodeBinfoTxId numtxid u.outpoint.hash,+              xpub = xp+            }+    conduits = (<>) <$> xconduits <*> pure acounduits+    xconduits = lift $ do+      let f x (XPubUnspent u p) =+            let path = toSoft (listToPath p)+                xp = BinfoXPubPath x.key <$> path+             in (u, xp)+          g x = do+            let h = xPubUnspents x (xBals x xbals)+                l = let Limits {..} = def in Limits {limit = 16, ..}+            return $ streamThings h Nothing l .| mapC (f x)+      mapM g (HashSet.toList xspecs)+    acounduits =+      let f u = (u, Nothing)+          h = getAddressUnspents+          l = let Limits {..} = def in Limits {limit = 16, ..}+          g a = streamThings (h a) Nothing l .| mapC f+       in map g (HashSet.toList addrs)++getXBals ::+  (StoreReadExtra m) =>+  HashSet XPubSpec ->+  m (HashMap XPubSpec [XPubBal])+getXBals =+  fmap HashMap.fromList . mapM f . HashSet.toList+  where+    f x = (x,) . filter (not . nullBalance . (.balance)) <$> xPubBals x++xBals :: XPubSpec -> HashMap XPubSpec [XPubBal] -> [XPubBal]+xBals = HashMap.findWithDefault []++getBinfoTxs ::+  (StoreReadExtra m, MonadIO m) =>+  HashMap XPubSpec [XPubBal] -> -- xpub balances+  HashMap Address (Maybe BinfoXPubPath) -> -- address book+  HashSet XPubSpec -> -- show xpubs+  HashSet Address -> -- show addrs+  HashSet Address -> -- balance addresses+  BinfoFilter ->+  Bool -> -- numtxid+  Bool -> -- prune outputs+  Int64 -> -- starting balance+  ConduitT () BinfoTx m ()+getBinfoTxs+  xbals+  abook+  sxspecs+  saddrs+  baddrs+  bfilter+  numtxid+  prune+  bal = do+    cs' <- conduits+    joinDescStreams cs' .| go bal+    where+      sxspecs_ls = HashSet.toList sxspecs+      saddrs_ls = HashSet.toList saddrs+      conduits =+        (<>)+          <$> mapM xpub_c sxspecs_ls+          <*> pure (map addr_c saddrs_ls)+      xpub_c x = do+        let f = xPubTxs x (xBals x xbals)+            l = Limits {limit = 16, offset = 0, start = Nothing}+        lift . return $+          streamThings f (Just (.txid)) l+      addr_c a = do+        let l = Limits {limit = 16, offset = 0, start = Nothing}+        streamThings (getAddressTxs a) (Just (.txid)) l+      binfo_tx = toBinfoTx numtxid abook prune+      compute_bal_change t =+        let ins = map (.output) t.inputs+            out = t.outputs+            f b BinfoTxOutput {..} =+              let val = fromIntegral value+               in case address of+                    Nothing -> 0+                    Just a+                      | a `HashSet.member` baddrs ->+                          if b then val else negate val+                      | otherwise -> 0+         in sum $ map (f False) ins <> map (f True) out+      go b =+        await >>= \case+          Nothing -> return ()+          Just (TxRef _ t) ->+            lift (getTransaction t) >>= \case+              Nothing -> go b+              Just x -> do+                let a = binfo_tx b x+                    b' = b - compute_bal_change a+                    c = isJust a.blockHeight+                    Just (d, _) = a.balance+                    r = d + fromIntegral a.fee+                case bfilter of+                  BinfoFilterAll ->+                    yield a >> go b'+                  BinfoFilterSent+                    | 0 > r -> yield a >> go b'+                    | otherwise -> go b'+                  BinfoFilterReceived+                    | r > 0 -> yield a >> go b'+                    | otherwise -> go b'+                  BinfoFilterMoved+                    | r == 0 -> yield a >> go b'+                    | otherwise -> go b'+                  BinfoFilterConfirmed+                    | c -> yield a >> go b'+                    | otherwise -> go b'+                  BinfoFilterMempool+                    | c -> return ()+                    | otherwise -> yield a >> go b'++getCashAddr :: (Monad m) => WebT m Bool+getCashAddr = S.param "cashaddr" `S.rescue` const (return False)++getAddress :: (MonadUnliftIO m) => TL.Text -> WebT m Address+getAddress param' = do+  txt <- S.param param'+  net <- asks (.config.store.net)+  case textToAddr net txt of+    Nothing -> raise ThingNotFound+    Just a -> return a++getBinfoAddr :: (Monad m) => TL.Text -> WebT m BinfoAddr+getBinfoAddr param' = do+  txt <- S.param param'+  net <- asks (.config.store.net)+  ctx <- asks (.config.store.ctx)+  let x =+        BinfoAddr+          <$> textToAddr net txt+          <|> BinfoXpub <$> xPubImport net ctx txt+  maybe S.next return x++scottyBinfoHistory :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoHistory =+  withMetrics (.binfoExportHistory) $ do+    (xspecs, addrs) <- getBinfoActive+    (startM, endM) <- get_dates+    (code, price') <- getPrice+    xbals <- getXBals xspecs+    let xaddrs = HashSet.fromList $ concatMap (map get_addr) (HashMap.elems xbals)+        aaddrs = xaddrs <> addrs+        cur = price'.fifteen+        cs' = conduits (HashMap.toList xbals) addrs endM+    txs <-+      lift $+        runConduit $+          joinDescStreams cs'+            .| takeWhileC (is_newer startM)+            .| concatMapMC get_transaction+            .| sinkList+    let times = map (\Transaction {..} -> timestamp) txs+    net <- asks (.config.store.net)+    url <- asks (.config.priceHistoryURL)+    session <- asks (.session)+    rates <- map (.price) <$> lift (getRates net session url code times)+    let hs = zipWith (convert cur aaddrs) txs (rates <> repeat 0.0)+    setHeaders+    streamEncoding $ toEncoding hs+  where+    is_newer+      (Just BlockData {height = bh})+      TxRef {block = BlockRef {height = th}} =+        bh <= th+    is_newer Nothing TxRef {} = True+    get_addr = (.balance.address)+    get_transaction TxRef {txid = h} =+      getTransaction h+    convert cur addrs tx rate =+      let ins = tx.inputs+          outs = tx.outputs+          fins = filter (input_addr addrs) ins+          fouts = filter (output_addr addrs) outs+          vin = fromIntegral . sum $ map (.value) fins+          vout = fromIntegral . sum $ map (.value) fouts+          fee = tx.fee+          v = vout - vin+          t = tx.timestamp+          h = txHash $ transactionData tx+       in toBinfoHistory v t rate cur fee h+    input_addr addrs' StoreInput {address = Just a} =+      a `HashSet.member` addrs'+    input_addr _ _ = False+    output_addr addrs' StoreOutput {address = Just a} =+      a `HashSet.member` addrs'+    output_addr _ _ = False+    get_dates = do+      BinfoDate start <- S.param "start"+      BinfoDate end' <- S.param "end"+      let end = end' + 24 * 60 * 60+      ch <- lift $ asks (.config.store.chain)+      startM <- blockAtOrAfter ch start+      endM <- blockAtOrBefore ch end+      return (startM, endM)+    conduits xpubs addrs endM =+      map (uncurry (xpub_c endM)) xpubs+        <> map (addr_c endM) (HashSet.toList addrs)+    lim endM =+      Limits+        { limit = 16,+          offset = 0,+          start = AtBlock . (.height) <$> endM+        }+    addr_c endM a =+      streamThings (getAddressTxs a) (Just (.txid)) (lim endM)+    xpub_c endM x bs =+      streamThings (xPubTxs x bs) (Just (.txid)) (lim endM)++getPrice :: (MonadIO m) => WebT m (Text, BinfoTicker)+getPrice = do+  code <- T.toUpper <$> S.param "currency" `S.rescue` const (return "USD")+  ticker <- lift $ asks (.ticker)+  prices <- readTVarIO ticker+  case HashMap.lookup code prices of+    Nothing -> return (code, def)+    Just p -> return (code, p)++getSymbol :: (MonadIO m) => WebT m BinfoSymbol+getSymbol = uncurry binfoTickerToSymbol <$> getPrice++scottyBinfoBlocksDay :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoBlocksDay =+  withMetrics (.binfoBlock) $ do+    t <- min h . (`div` 1000) <$> S.param "milliseconds"+    ch <- asks (.config.store.chain)+    m <- blockAtOrBefore ch t+    bs <- go (d t) m+    streamEncoding $ toEncoding $ map toBinfoBlockInfo bs+  where+    h = fromIntegral (maxBound :: H.Timestamp)+    d = subtract (24 * 3600)+    go _ Nothing = return []+    go t (Just b)+      | b.header.timestamp <= fromIntegral t =+          return []+      | otherwise = do+          b' <- getBlock b.header.prev+          (b :) <$> go t b'++scottyMultiAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyMultiAddr =+  withMetrics (.binfoMultiaddr) $ do+    (addrs', _, saddrs, sxpubs, xspecs) <- get_addrs+    numtxid <- getNumTxId+    cashaddr <- getCashAddr+    local' <- getSymbol+    offset <- getBinfoOffset+    n <- getBinfoCount "n"+    prune <- get_prune+    fltr <- get_filter+    xbals <- getXBals xspecs+    xtxns <- get_xpub_tx_count xbals xspecs+    let sxbals = only_show_xbals sxpubs xbals+        xabals = compute_xabals xbals+        addrs = addrs' `HashSet.difference` HashMap.keysSet xabals+    abals <- get_abals addrs+    let sxspecs = only_show_xspecs sxpubs xspecs+        sxabals = compute_xabals sxbals+        sabals = only_show_abals saddrs abals+        sallbals = sabals <> sxabals+        sbal = compute_bal sallbals+        allbals = abals <> xabals+        abook = compute_abook addrs xbals+        sxaddrs = compute_xaddrs sxbals+        salladdrs = saddrs <> sxaddrs+        bal = compute_bal allbals+        ibal = fromIntegral sbal+    ftxs <-+      lift . runConduit $+        getBinfoTxs+          xbals+          abook+          sxspecs+          saddrs+          salladdrs+          fltr+          numtxid+          prune+          ibal+          .| (dropC offset >> takeC n .| sinkList)+    net <- asks (.config.store.net)+    ctx <- asks (.config.store.ctx)+    best <- get_best_block+    peers <- get_peers+    let baddrs = toBinfoAddrs sabals sxbals xtxns+        abaddrs = toBinfoAddrs abals xbals xtxns+        recv = sum $ map (.received) abaddrs+        sent' = sum $ map (.sent) abaddrs+        txn = fromIntegral $ length ftxs+        wallet =+          BinfoWallet+            { balance = bal,+              txs = txn,+              filtered = txn,+              received = recv,+              sent = sent'+            }+        coin = netBinfoSymbol net+    let block =+          BinfoBlockInfo+            { hash = H.headerHash best.header,+              height = best.height,+              timestamp = best.header.timestamp,+              index = best.height+            }+    let info =+          BinfoInfo+            { connected = peers,+              conversion = 100 * 1000 * 1000,+              fiat = local',+              crypto = coin,+              head = block+            }+    let multiaddr =+          BinfoMultiAddr+            { addresses = baddrs,+              wallet = wallet,+              txs = ftxs,+              info = info,+              recommendFee = True,+              cashAddr = cashaddr+            }+    setHeaders+    streamEncoding $ marshalEncoding (net, ctx) multiaddr+  where+    get_xpub_tx_count xbals =+      fmap HashMap.fromList+        . mapM+          ( \x ->+              (x,)+                . fromIntegral+                <$> xPubTxCount x (xBals x xbals)+          )+        . HashSet.toList+    get_filter =+      S.param "filter" `S.rescue` const (return BinfoFilterAll)+    get_best_block =+      getBestBlock >>= \case+        Nothing -> raise ThingNotFound+        Just bh ->+          getBlock bh >>= \case+            Nothing -> raise ThingNotFound+            Just b -> return b+    get_prune =+      fmap not $+        S.param "no_compact"+          `S.rescue` const (return False)+    only_show_xbals sxpubs =+      HashMap.filterWithKey (\k _ -> k.key `HashSet.member` sxpubs)+    only_show_xspecs sxpubs =+      HashSet.filter (\k -> k.key `HashSet.member` sxpubs)+    only_show_abals saddrs =+      HashMap.filterWithKey (\k _ -> k `HashSet.member` saddrs)+    addr (BinfoAddr a) = Just a+    addr (BinfoXpub _) = Nothing+    xpub (BinfoXpub x) = Just x+    xpub (BinfoAddr _) = Nothing+    get_addrs = do+      (xspecs, addrs) <- getBinfoActive+      sh <- getBinfoAddrsParam "onlyShow"+      let xpubs = HashSet.map (.key) xspecs+          actives =+            HashSet.map BinfoAddr addrs+              <> HashSet.map BinfoXpub xpubs+          sh' = if HashSet.null sh then actives else sh+          saddrs = HashSet.fromList $ mapMaybe addr $ HashSet.toList sh'+          sxpubs = HashSet.fromList $ mapMaybe xpub $ HashSet.toList sh'+      return (addrs, xpubs, saddrs, sxpubs, xspecs)+    get_abals =+      let f b = (b.address, b)+          g = HashMap.fromList . map f+       in fmap g . getBalances . HashSet.toList+    get_peers = do+      ps <- lift $ getPeersInformation =<< asks (.config.store.peerMgr)+      return (fromIntegral (length ps))+    compute_xabals =+      let f b = (b.balance.address, b.balance)+       in HashMap.fromList . concatMap (map f) . HashMap.elems+    compute_bal =+      let f b = b.confirmed + b.unconfirmed+       in sum . map f . HashMap.elems+    compute_abook addrs xbals =+      let f xs xb =+            let a = xb.balance.address+                e = error "lions and tigers and bears"+                s = toSoft (listToPath xb.path)+             in (a, Just (BinfoXPubPath xs.key (fromMaybe e s)))+          amap =+            HashMap.map (const Nothing) $+              HashSet.toMap addrs+          xmap =+            HashMap.fromList+              . concatMap (uncurry (map . f))+              $ HashMap.toList xbals+       in amap <> xmap+    compute_xaddrs =+      let f = map (.balance.address)+       in HashSet.fromList . concatMap f . HashMap.elems++getBinfoCount :: (MonadUnliftIO m) => TL.Text -> WebT m Int+getBinfoCount str = do+  d <- asks (.config.limits.defItemCount)+  x <- asks (.config.limits.maxFullItemCount)+  i <- min x <$> (S.param str `S.rescue` const (return d))+  return (fromIntegral i :: Int)++getBinfoOffset ::+  (MonadUnliftIO m) =>+  WebT m Int+getBinfoOffset = do+  x <- asks (.config.limits.maxOffset)+  o <- S.param "offset" `S.rescue` const (return 0)+  when (o > x) $+    raise $+      UserError $+        "offset exceeded: " <> show o <> " > " <> show x+  return (fromIntegral o :: Int)++scottyRawAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyRawAddr =+  withMetrics (.binfoAddressRaw) $+    getBinfoAddr "addr" >>= \case+      BinfoAddr addr -> do_addr addr+      BinfoXpub xpub -> do_xpub xpub+  where+    do_xpub xpub = do+      numtxid <- getNumTxId+      derive <- S.param "derive" `S.rescue` const (return DeriveNormal)+      let xspec = XPubSpec xpub derive+      n <- getBinfoCount "limit"+      off <- getBinfoOffset+      xbals <- getXBals $ HashSet.singleton xspec+      net <- lift $ asks (.config.store.net)+      let summary = xPubSummary xspec (xBals xspec xbals)+          abook = compute_abook xpub (xBals xspec xbals)+          xspecs = HashSet.singleton xspec+          saddrs = HashSet.empty+          baddrs = HashMap.keysSet abook+          bfilter = BinfoFilterAll+          amnt = summary.confirmed + summary.unconfirmed+      txs <-+        lift $+          runConduit $+            getBinfoTxs+              xbals+              abook+              xspecs+              saddrs+              baddrs+              bfilter+              numtxid+              False+              (fromIntegral amnt)+              .| (dropC off >> takeC n .| sinkList)+      let ra =+            BinfoRawAddr+              { address = BinfoXpub xpub,+                balance = amnt,+                ntx = fromIntegral $ length txs,+                utxo = summary.utxo,+                received = summary.received,+                sent = fromIntegral summary.received - fromIntegral amnt,+                txs = txs+              }+      setHeaders+      ctx <- asks (.config.store.ctx)+      streamEncoding $ marshalEncoding (net, ctx) ra+    compute_abook xpub xbals =+      let f xb =+            let a = xb.balance.address+                e = error "black hole swallows all your code"+                s = toSoft $ listToPath xb.path+                m = fromMaybe e s+             in (a, Just (BinfoXPubPath xpub m))+       in HashMap.fromList $ map f xbals+    do_addr addr = do+      numtxid <- getNumTxId+      n <- getBinfoCount "limit"+      off <- getBinfoOffset+      bal <- fromMaybe (zeroBalance addr) <$> getBalance addr+      net <- lift $ asks (.config.store.net)+      let abook = HashMap.singleton addr Nothing+          xspecs = HashSet.empty+          saddrs = HashSet.singleton addr+          bfilter = BinfoFilterAll+          balance = bal.confirmed + bal.unconfirmed+      txs <-+        lift . runConduit $+          getBinfoTxs+            HashMap.empty+            abook+            xspecs+            saddrs+            saddrs+            bfilter+            numtxid+            False+            (fromIntegral balance)+            .| (dropC off >> takeC n .| sinkList)+      let ra =+            BinfoRawAddr+              { address = BinfoAddr addr,+                balance,+                ntx = bal.txs,+                utxo = bal.utxo,+                received = bal.received,+                sent = fromIntegral bal.received - fromIntegral balance,+                txs+              }+      setHeaders+      ctx <- asks (.config.store.ctx)+      streamEncoding $ marshalEncoding (net, ctx) ra++scottyBinfoReceived :: (MonadUnliftIO m) => WebT m ()+scottyBinfoReceived =+  withMetrics (.binfoQgetreceivedbyaddress) $ do+    a <- getAddress "addr"+    b <- fromMaybe (zeroBalance a) <$> getBalance a+    setHeaders+    S.text $ cs $ show b.received++scottyBinfoSent :: (MonadUnliftIO m) => WebT m ()+scottyBinfoSent =+  withMetrics (.binfoQgetsentbyaddress) $ do+    a <- getAddress "addr"+    b <- fromMaybe (zeroBalance a) <$> getBalance a+    setHeaders+    S.text $ cs $ show $ b.received - b.confirmed - b.unconfirmed++scottyBinfoAddrBalance :: (MonadUnliftIO m) => WebT m ()+scottyBinfoAddrBalance =+  withMetrics (.binfoQaddressbalance) $ do+    a <- getAddress "addr"+    b <- fromMaybe (zeroBalance a) <$> getBalance a+    setHeaders+    S.text $ cs $ show $ b.confirmed + b.unconfirmed++scottyFirstSeen :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyFirstSeen =+  withMetrics (.binfoQaddressfirstseen) $ do+    a <- getAddress "addr"+    ch <- asks (.config.store.chain)+    bb <- chainGetBest ch+    let top = bb.height+        bot = 0+    i <- go ch bb a bot top+    setHeaders+    S.text $ cs $ show i+  where+    go ch bb a bot top = do+      let mid = bot + (top - bot) `div` 2+          n = top - bot < 2+      x <- hasone a bot+      y <- hasone a mid+      z <- hasone a top+      if+        | x -> getblocktime ch bb bot+        | n -> getblocktime ch bb top+        | y -> go ch bb a bot mid+        | z -> go ch bb a mid top+        | otherwise -> return 0+    getblocktime ch bb h =+      chainGetAncestor h bb ch >>= \case+        Just b -> return b.header.timestamp+        Nothing -> do+          lift . $(logErrorS) "Web" $+            "Could not get ancestor at height "+              <> cs (show h)+              <> " for block "+              <> H.blockHashToHex (H.headerHash bb.header)+          error "Block ancestor retreival error"+    hasone a h = do+      let l = Limits 1 0 (Just (AtBlock h))+      not . null <$> getAddressTxs a l++scottyShortBal :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyShortBal =+  withMetrics (.binfoBalance) $ do+    (xspecs, addrs) <- getBinfoActive+    cashaddr <- getCashAddr+    net <- asks (.config.store.net)+    abals <- catMaybes <$> mapM (getabal net cashaddr) (HashSet.toList addrs)+    xbals <- mapM (getxbal net) (HashSet.toList xspecs)+    let res = HashMap.fromList (abals <> xbals)+    setHeaders+    streamEncoding $ toEncoding res+  where+    shorten bal =+      BinfoShortBal+        { final = bal.confirmed + bal.unconfirmed,+          ntx = bal.txs,+          received = bal.received+        }+    getabal net cashaddr a =+      let net' =+            if+              | cashaddr -> net+              | net == bch -> btc+              | net == bchTest -> btcTest+              | net == bchTest4 -> btcTest+              | otherwise -> net+       in case addrToText net' a of+            Nothing -> return Nothing+            Just a' ->+              getBalance a >>= \case+                Nothing -> return $ Just (a', shorten (zeroBalance a))+                Just b -> return $ Just (a', shorten b)+    getxbal net xpub = do+      xbals <- xPubBals xpub+      ntx <- fromIntegral <$> xPubTxCount xpub xbals+      let val = sum $ map (.balance.confirmed) xbals+          zro = sum $ map (.balance.unconfirmed) xbals+          exs = [x | x@XPubBal {path = 0 : _} <- xbals]+          final = val + zro+          received = sum $ map (.balance.received) exs+          sbl = BinfoShortBal {final, ntx, received}+      ctx <- asks (.config.store.ctx)+      return (xPubExport net ctx xpub.key, sbl)++getBinfoHex :: (Monad m) => WebT m Bool+getBinfoHex =+  (== ("hex" :: Text))+    <$> S.param "format" `S.rescue` const (return "json")++scottyBinfoBlockHeight :: (MonadUnliftIO m) => WebT m ()+scottyBinfoBlockHeight =+  withMetrics (.binfoBlockHeight) $ do+    numtxid <- getNumTxId+    height <- S.param "height"+    bs <- fmap catMaybes $ getBlocksAtHeight height >>= mapM getBlock+    ns <- fmap catMaybes $ getBlocksAtHeight (height + 1) >>= mapM getBlock+    is <- mapM (get_binfo_blocks numtxid ns) bs+    setHeaders+    net <- asks (.config.store.net)+    ctx <- asks (.config.store.ctx)+    streamEncoding $ marshalEncoding (net, ctx) is+  where+    get_binfo_blocks numtxid ns b = do+      txs <- catMaybes <$> mapM getTransaction b.txs+      let h x = H.headerHash x.header+          nbs = [h n | n <- ns, n.header.prev == h b]+          bts = map (toBinfoTxSimple numtxid) txs+      return $ toBinfoBlock b bts nbs++scottyBinfoLatest :: (MonadUnliftIO m) => WebT m ()+scottyBinfoLatest =+  withMetrics (.binfoBlockLatest) $ do+    numtxid <- getNumTxId+    mb <- runMaybeT $ MaybeT getBestBlock >>= MaybeT . getBlock+    b <- maybe (raise ThingNotFound) return mb+    streamEncoding $+      toEncoding+        BinfoHeader+          { hash = H.headerHash b.header,+            timestamp = b.header.timestamp,+            index = b.height,+            height = b.height,+            txids = map (encodeBinfoTxId numtxid) b.txs+          }++scottyBinfoBlock :: (MonadUnliftIO m) => WebT m ()+scottyBinfoBlock =+  withMetrics (.binfoBlockRaw) $ do+    numtxid <- getNumTxId+    hex <- getBinfoHex+    S.param "block" >>= \case+      BinfoBlockHash bh -> go numtxid hex bh+      BinfoBlockIndex i ->+        getBlocksAtHeight i >>= \case+          [] -> raise ThingNotFound+          bh : _ -> go numtxid hex bh+  where+    go numtxid hex bh = do+      b <- maybe (raise ThingNotFound) return =<< getBlock bh+      txs <- catMaybes <$> mapM getTransaction b.txs+      nhs <- fmap catMaybes $ getBlocksAtHeight (b.height + 1) >>= mapM getBlock+      let h x = H.headerHash x.header+          nxt = [h n | n <- nhs, n.header.prev == h b]+      if hex+        then do+          let x = H.Block b.header (map transactionData txs)+          setHeaders+          S.text . encodeHexLazy . runPutL $ serialize x+        else do+          let bts = map (toBinfoTxSimple numtxid) txs+              y = toBinfoBlock b bts nxt+          setHeaders+          net <- asks (.config.store.net)+          ctx <- asks (.config.store.ctx)+          streamEncoding $ marshalEncoding (net, ctx) y++getBinfoTx ::+  (MonadLoggerIO m, MonadUnliftIO m) =>+  BinfoTxId ->+  WebT m (Either Except Transaction)+getBinfoTx txid = do+  tx <- case txid of+    BinfoTxIdHash h -> maybeToList <$> getTransaction h+    BinfoTxIdIndex i -> getNumTransaction i+  case tx of+    [t] -> return $ Right t+    [] -> return $ Left ThingNotFound+    ts ->+      let tids = map (txHash . transactionData) ts+       in return $ Left (TxIndexConflict tids)++scottyBinfoTx :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoTx =+  withMetrics (.binfoTxRaw) $ do+    numtxid <- getNumTxId+    hex <- getBinfoHex+    txid <- S.param "txid"+    tx <-+      getBinfoTx txid >>= \case+        Right t -> return t+        Left e -> raise e+    if hex then hx tx else js numtxid tx+  where+    js numtxid t = do+      net <- asks (.config.store.net)+      ctx <- asks (.config.store.ctx)+      setHeaders+      streamEncoding $ marshalEncoding (net, ctx) $ toBinfoTxSimple numtxid t+    hx t = do+      setHeaders+      S.text . encodeHexLazy . runPutL . serialize $ transactionData t++scottyBinfoTotalOut :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoTotalOut =+  withMetrics (.binfoQtxtotalbtcoutput) $ do+    txid <- S.param "txid"+    tx <-+      getBinfoTx txid >>= \case+        Right t -> return t+        Left e -> raise e+    S.text $ cs $ show $ sum $ map (.value) tx.outputs++scottyBinfoTxFees :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoTxFees =+  withMetrics (.binfoQtxfee) $ do+    txid <- S.param "txid"+    tx <-+      getBinfoTx txid >>= \case+        Right t -> return t+        Left e -> raise e+    let i = sum $ map (.value) $ filter f tx.inputs+        o = sum $ map (.value) tx.outputs+    S.text . cs . show $ i - o+  where+    f StoreInput {} = True+    f StoreCoinbase {} = False++scottyBinfoTxResult :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoTxResult =+  withMetrics (.binfoQtxresult) $ do+    txid <- S.param "txid"+    addr <- getAddress "addr"+    tx <-+      getBinfoTx txid >>= \case+        Right t -> return t+        Left e -> raise e+    let i = toInteger $ sum $ map (.value) $ filter (f addr) tx.inputs+        o = toInteger $ sum $ map (.value) $ filter (g addr) tx.outputs+    S.text $ cs $ show $ o - i+  where+    f addr StoreInput {address = Just a} = a == addr+    f _ _ = False+    g addr StoreOutput {address = Just a} = a == addr+    g _ _ = False++scottyBinfoTotalInput :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoTotalInput =+  withMetrics (.binfoQtxtotalbtcinput) $ do+    txid <- S.param "txid"+    tx <-+      getBinfoTx txid >>= \case+        Right t -> return t+        Left e -> raise e+    S.text $ cs $ show $ sum $ map (.value) $ filter f $ tx.inputs+  where+    f StoreInput {} = True+    f StoreCoinbase {} = False++scottyBinfoMempool :: (MonadUnliftIO m) => WebT m ()+scottyBinfoMempool =+  withMetrics (.binfoMempool) $ do+    numtxid <- getNumTxId+    offset <- getBinfoOffset+    n <- getBinfoCount "limit"+    mempool <- getMempool+    let txids = map snd $ take n $ drop offset mempool+    txs <- catMaybes <$> mapM getTransaction txids+    net <- lift $ asks (.config.store.net)+    setHeaders+    let mem = BinfoMempool $ map (toBinfoTxSimple numtxid) txs+    ctx <- lift $ asks (.config.store.ctx)+    streamEncoding $ marshalEncoding (net, ctx) mem++scottyBinfoGetBlockCount :: (MonadUnliftIO m) => WebT m ()+scottyBinfoGetBlockCount =+  withMetrics (.binfoQgetblockcount) $ do+    ch <- asks (.config.store.chain)+    bn <- chainGetBest ch+    setHeaders+    S.text $ cs $ show bn.height++scottyBinfoLatestHash :: (MonadUnliftIO m) => WebT m ()+scottyBinfoLatestHash =+  withMetrics (.binfoQlatesthash) $ do+    ch <- asks (.config.store.chain)+    bn <- chainGetBest ch+    setHeaders+    S.text $ TL.fromStrict $ H.blockHashToHex $ H.headerHash bn.header++scottyBinfoSubsidy :: (MonadUnliftIO m) => WebT m ()+scottyBinfoSubsidy =+  withMetrics (.binfoQbcperblock) $ do+    ch <- asks (.config.store.chain)+    net <- asks (.config.store.net)+    bn <- chainGetBest ch+    setHeaders+    S.text $+      cs $+        show $+          (/ (100 * 1000 * 1000 :: Double)) $+            fromIntegral $+              H.computeSubsidy net (bn.height + 1)++scottyBinfoAddrToHash :: (MonadUnliftIO m) => WebT m ()+scottyBinfoAddrToHash =+  withMetrics (.binfoQaddresstohash) $ do+    addr <- getAddress "addr"+    setHeaders+    S.text $ encodeHexLazy $ runPutL $ serialize addr.hash160++scottyBinfoHashToAddr :: (MonadUnliftIO m) => WebT m ()+scottyBinfoHashToAddr =+  withMetrics (.binfoQhashtoaddress) $ do+    bs <- maybe S.next return . decodeHex =<< S.param "hash"+    net <- asks (.config.store.net)+    hash <- either (const S.next) return $ decode bs+    addr <- maybe S.next return $ addrToText net $ PubKeyAddress hash+    setHeaders+    S.text $ TL.fromStrict addr++scottyBinfoAddrPubkey :: (MonadUnliftIO m) => WebT m ()+scottyBinfoAddrPubkey =+  withMetrics (.binfoQaddrpubkey) $ do+    hex <- S.param "pubkey"+    ctx <- asks (.config.store.ctx)+    pubkey <-+      maybe S.next (return . pubKeyAddr ctx) $+        eitherToMaybe . unmarshal ctx =<< decodeHex hex+    net <- asks (.config.store.net)+    setHeaders+    case addrToText net pubkey of+      Nothing -> raise ThingNotFound+      Just a -> do+        S.text $ TL.fromStrict a++scottyBinfoPubKeyAddr :: (MonadUnliftIO m, MonadLoggerIO m) => WebT m ()+scottyBinfoPubKeyAddr =+  withMetrics (.binfoQpubkeyaddr) $ do+    addr <- getAddress "addr"+    mi <- strm addr+    i <- case mi of+      Nothing -> raise ThingNotFound+      Just i -> return i+    pk <- case extr addr i of+      Left e -> raise $ UserError e+      Right t -> return t+    setHeaders+    S.text $ encodeHexLazy $ L.fromStrict pk+  where+    strm addr = do+      runConduit $ do+        let l = Limits {limit = 8, offset = 0, start = Nothing}+        streamThings (getAddressTxs addr) (Just (.txid)) l+          .| concatMapMC (getTransaction . (.txid))+          .| concatMapC (filter (inp addr) . (.inputs))+          .| headC+    inp addr StoreInput {address = Just a} = a == addr+    inp _ _ = False+    extr addr StoreInput {script, pkscript, witness} = do+      Script sig <- decode script+      Script pks <- decode pkscript+      case addr of+        PubKeyAddress {} ->+          case sig of+            [OP_PUSHDATA _ _, OP_PUSHDATA pub _] ->+              Right pub+            [OP_PUSHDATA _ _] ->+              case pks of+                [OP_PUSHDATA pub _, OP_CHECKSIG] ->+                  Right pub+                _ -> Left "Could not parse scriptPubKey"+            _ -> Left "Could not parse scriptSig"+        WitnessPubKeyAddress {} ->+          case witness of+            [_, pub] -> return pub+            _ -> Left "Could not parse scriptPubKey"+        _ -> Left "Address does not have public key"+    extr _ _ = Left "Incorrect input type"++scottyBinfoHashPubkey :: (MonadUnliftIO m) => WebT m ()+scottyBinfoHashPubkey =+  withMetrics (.binfoQhashpubkey) $ do+    ctx <- asks (.config.store.ctx)+    pkm <- (eitherToMaybe . unmarshal ctx <=< decodeHex) <$> S.param "pubkey"+    addr <- case pkm of+      Nothing -> raise $ UserError "Could not decode public key"+      Just pk -> return $ pubKeyAddr ctx pk+    setHeaders+    S.text $ encodeHexLazy $ runPutL $ serialize addr.hash160++-- GET Network Information --++scottyPeers ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  GetPeers ->+  WebT m [PeerInfo]+scottyPeers _ =+  withMetrics (.peers) $ do+    lift . getPeersInformation =<< asks (.config.store.peerMgr)++-- | Obtain information about connected peers from peer manager process.+getPeersInformation ::+  (MonadLoggerIO m) => PeerMgr -> m [PeerInfo]+getPeersInformation mgr =+  mapMaybe toInfo <$> getPeers mgr+  where+    toInfo op = do+      ver <- op.version+      return+        PeerInfo+          { userAgent = ver.userAgent.get,+            address = show op.address,+            version = ver.version,+            services = ver.services,+            relay = ver.relay+          }++scottyHealth ::+  (MonadUnliftIO m) => GetHealth -> WebT m HealthCheck+scottyHealth _ =+  withMetrics (.health) $ do+    h <- asks (.health) >>= readTVarIO+    unless (isOK h) $ S.status status503+    return h++blockHealthCheck ::+  (MonadUnliftIO m, StoreReadBase m) =>+  WebConfig ->+  m BlockHealth+blockHealthCheck cfg = do+  let ch = cfg.store.chain+  headers <- (.height) <$> chainGetBest ch+  blocks <-+    maybe 0 (.height)+      <$> runMaybeT (MaybeT getBestBlock >>= MaybeT . getBlock)+  return+    BlockHealth+      { headers,+        blocks,+        max = fromIntegral cfg.maxLaggingBlocks+      }++lastBlockHealthCheck ::+  (MonadUnliftIO m, StoreReadBase m) =>+  Chain ->+  WebLimits ->+  m TimeHealth+lastBlockHealthCheck ch WebLimits {blockTimeout} = do+  n <- round <$> liftIO getPOSIXTime+  t <- fromIntegral . (.header.timestamp) <$> chainGetBest ch+  return+    TimeHealth+      { age = n - t,+        max = fromIntegral blockTimeout+      }++lastTxHealthCheck ::+  (MonadUnliftIO m, StoreReadBase m) =>+  WebConfig ->+  m TimeHealth+lastTxHealthCheck WebConfig {noMempool, store, limits} = do+  n <- round <$> liftIO getPOSIXTime+  b <- fromIntegral . (.header.timestamp) <$> chainGetBest ch+  t <-+    getMempool >>= \case+      t : _ ->+        let x = fromIntegral $ fst t+         in return $ max x b+      [] -> return b+  return+    TimeHealth+      { age = n - t,+        max = fromIntegral to+      }+  where+    ch = store.chain+    to =+      if noMempool+        then limits.blockTimeout+        else limits.txTimeout++pendingTxsHealthCheck ::+  (MonadUnliftIO m, StoreReadBase m) =>+  WebConfig ->+  m MaxHealth+pendingTxsHealthCheck cfg = do+  n <- blockStorePendingTxs cfg.store.block+  return+    MaxHealth+      { max = fromIntegral cfg.maxPendingTxs,+        count = fromIntegral n+      }++peerHealthCheck ::+  (MonadUnliftIO m, StoreReadBase m) =>+  WebConfig ->+  m CountHealth+peerHealthCheck cfg = do+  count <- fromIntegral . length <$> getPeers cfg.store.peerMgr+  return CountHealth {min = fromIntegral cfg.minPeers, count}++healthCheck ::+  (MonadUnliftIO m, MonadLoggerIO m, StoreReadBase m) =>+  WebConfig ->+  m HealthCheck+healthCheck cfg = do+  blocks <- blockHealthCheck cfg+  lastBlock <- lastBlockHealthCheck cfg.store.chain cfg.limits+  lastTx <- lastTxHealthCheck cfg+  pendingTxs <- pendingTxsHealthCheck cfg+  peers <- peerHealthCheck cfg+  time <- round <$> liftIO getPOSIXTime+  let check =+        HealthCheck+          { network = cfg.store.net.name,+            version = cfg.version,+            ..+          }+  unless (isOK check) $ do+    let t = toStrict $ encodeToLazyText check+    $(logErrorS) "Web" $ "Health check failed: " <> t+  return check++scottyDbStats :: (MonadUnliftIO m) => WebT m ()+scottyDbStats =+  withMetrics (.db) $ do+    setHeaders+    db <- lift $ asks (.config.store.db.db)+    statsM <- lift (getProperty db Stats)+    S.text $ maybe "Could not get stats" cs statsM++-----------------------+-- Parameter Parsing --+-----------------------++-- | Returns @Nothing@ if the parameter is not supplied. Raises an exception on+-- parse failure.+paramOptional :: (Param a, MonadIO m) => WebT m (Maybe a)+paramOptional = go Proxy+  where+    go :: (Param a, MonadIO m) => Proxy a -> WebT m (Maybe a)+    go proxy = do+      net <- lift $ asks (.config.store.net)+      ctx <- lift $ asks (.config.store.ctx)+      tsM :: Maybe [Text] <- p `S.rescue` const (return Nothing)+      case tsM of+        Nothing -> return Nothing -- Parameter was not supplied+        Just ts -> maybe (raise err) (return . Just) $ parseParam net ctx ts+      where+        l = proxyLabel proxy+        p = Just <$> S.param (cs l)+        err = UserError $ "Unable to parse param " <> cs l++-- | Raises an exception if the parameter is not supplied+param :: (Param a, MonadIO m) => WebT m a+param = go Proxy+  where+    go :: (Param a, MonadIO m) => Proxy a -> WebT m a+    go proxy = do+      resM <- paramOptional+      case resM of+        Just res -> return res+        _ ->+          raise . UserError $+            "The param " <> cs (proxyLabel proxy) <> " was not defined"++-- | Returns the default value of a parameter if it is not supplied. Raises an+-- exception on parse failure.+paramDef :: (Default a, Param a, MonadIO m) => WebT m a+paramDef = fromMaybe def <$> paramOptional++-- | Does not raise exceptions. Will call @Scotty.next@ if the parameter is+-- not supplied or if parsing fails.+paramLazy :: (Param a, MonadIO m) => WebT m a+paramLazy = do+  resM <- paramOptional `S.rescue` const (return Nothing)+  maybe S.next return resM++parseBody :: (MonadIO m, Serial a) => WebT m a+parseBody = do+  b <- L.toStrict <$> S.body+  case hex b <> bin b of+    Left _ -> raise $ UserError "Failed to parse request body"+    Right x -> return x+  where+    bin = runGetS deserialize+    hex b =+      let ns = C.filter (not . isSpace) b+       in if isBase16 ns+            then bin . decodeBase16 $ assertBase16 ns+            else Left "Invalid hex input"++parseOffset :: (MonadIO m) => WebT m OffsetParam+parseOffset = do+  res@(OffsetParam o) <- paramDef+  limits <- lift $ asks (.config.limits)+  when (limits.maxOffset > 0 && fromIntegral o > limits.maxOffset) $+    raise . UserError $+      "offset exceeded: " <> show o <> " > " <> show limits.maxOffset+  return res++parseStart ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  Maybe StartParam ->+  WebT m (Maybe Start)+parseStart Nothing = return Nothing+parseStart (Just s) =+  runMaybeT $+    case s of+      StartParamHash {hash = h} -> start_tx h <|> start_block h+      StartParamHeight {height = h} -> start_height h+      StartParamTime {time = q} -> start_time q+  where+    start_height h = return $ AtBlock $ fromIntegral h+    start_block h = do+      b <- MaybeT $ getBlock (H.BlockHash h)+      return $ AtBlock b.height+    start_tx h = do+      _ <- MaybeT $ getTxData (TxHash h)+      return $ AtTx (TxHash h)+    start_time q = do+      ch <- lift $ asks (.config.store.chain)+      b <- MaybeT $ blockAtOrBefore ch q+      return $ AtBlock b.height++parseLimits :: (MonadIO m) => WebT m LimitsParam+parseLimits = LimitsParam <$> paramOptional <*> parseOffset <*> paramOptional++paramToLimits ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  Bool ->+  LimitsParam ->+  WebT m Limits+paramToLimits full (LimitsParam limitM o startM) = do+  wl <- lift $ asks (.config.limits)+  Limits (validateLimit wl full limitM) (fromIntegral o) <$> parseStart startM++validateLimit :: WebLimits -> Bool -> Maybe LimitParam -> Word32+validateLimit wl full limitM =+  f m $ maybe d (fromIntegral . (.get)) limitM+  where+    m+      | full && wl.maxFullItemCount > 0 = wl.maxFullItemCount+      | otherwise = wl.maxItemCount+    d = wl.defItemCount+    f a 0 = a+    f 0 b = b+    f a b = min a b++---------------+-- Utilities --+---------------++runInWebReader ::+  (MonadIO m) =>+  CacheT (DatabaseReaderT m) a ->+  ReaderT WebState m a+runInWebReader f = do+  bdb <- asks (.config.store.db)+  mc <- asks (.config.store.cache)+  lift $ runReaderT (withCache mc f) bdb++runNoCache ::+  (MonadIO m) =>+  Bool ->+  ReaderT WebState m a ->+  ReaderT WebState m a+runNoCache False = id+runNoCache True = local $ \s ->+  s {config = s.config {store = s.config.store {cache = Nothing}}}++logIt ::+  (MonadUnliftIO m, MonadLoggerIO m) =>+  m Middleware+logIt = do+  runner <- askRunInIO+  return $ \app req respond ->+    app req $ \res -> do+      let s = responseStatus res+          msg = fmtReq req <> ": " <> fmtStatus s+      if statusIsSuccessful s+        then runner $ $(logDebugS) "Web" msg+        else runner $ $(logErrorS) "Web" msg+      respond res++fmtReq :: Request -> Text+fmtReq req =+  let m = requestMethod req+      v = httpVersion req+      p = rawPathInfo req+      q = rawQueryString req+   in T.decodeUtf8 (m <> " " <> p <> q <> " " <> cs (show v))  fmtStatus :: Status -> Text fmtStatus s = cs (show (statusCode s)) <> " " <> cs (statusMessage s)