Merge #2111

2111: Faster listing of stake pools. r=jonathanknowles a=jonathanknowles

## Issue Number

#2082 (_Listing stake pools time grows when there are wallets syncing in background_.)

## Overview

This PR:

* changes the implementation of `ListStakePools` to execute a small number of handwritten SQL queries with native joins, rather than issuing multiple queries and joining together the results in memory.

* adds a new operation [`listPoolLifeCycleData`](https://github.com/input-output-hk/cardano-wallet/blob/d00c608e47d2d189a282a02946cc8e46b843375b/lib/core/src/Cardano/Pool/DB.hs#L180). The [SQLite implementation](https://github.com/input-output-hk/cardano-wallet/blob/d00c608e47d2d189a282a02946cc8e46b843375b/lib/core/src/Cardano/Pool/DB/Sqlite.hs#L384) of this operation uses a [single hand-optimized query](https://github.com/input-output-hk/cardano-wallet/blob/d00c608e47d2d189a282a02946cc8e46b843375b/lib/core/src/Cardano/Pool/DB/Sqlite.hs#L595) to return lifecycle data for all pools.

## Benefits

### ⭐ **Faster execution time**

  The time taken to execute `ListStakePools` is greatly reduced, even when there are multiple wallets syncing in the background.
  <details><summary>Click to view data</summary><br>

  | No. of <br>Wallets<br>Syncing | Time Required<br>(seconds)<br>`master` | Time Required<br>(seconds)<br>`more-efficient-list-pools` |
  | ---: | ---: | ---: |
  | 0 | 8 | 3 |
  | 5 | 30 | 7 |
  | 10 | 60 | 8 |
  | 15 | 72 | 9 |
  | 20 | 95 | 10 |
  </details>

### ⭐ **Fewer database queries**

  The number of `select` queries required for a single call to `ListStakePools` is greatly reduced.
  <details><summary>Click to view data</summary><br>
  
  | Branch | Network | No. of Pools | No. of Queries |
  | :--- | :--- | ---: | ---: | 
  | `master` | `mainnet` |  1,124 |  12,365 |
  | `more-efficient-list-pools`| `mainnet` | 1,124  | 4 |
  </details>

## Testing

### ✔️ Properties

This PR adds a [property test](https://github.com/input-output-hk/cardano-wallet/blob/d00c608e47d2d189a282a02946cc8e46b843375b/lib/core/test/unit/Cardano/Pool/DB/Properties.hs#L987) for `listPoolLifeCycleData`, consisting of the following steps:
1. Add an arbitrary sequence of pool registration and retirement certificates to the database, for multiple pools.
2. Call `listPoolLifeCycleData` once to fetch lifecycle data for all active pools.
3. Call `readPoolLifeCycleStatus` multiple times, once for each known pool, and coalesce the results. 
4. Test that the results returned in steps 2 and 3 are identical.

### ✔️ Live Data

Run the following command to get a list of all stake pools sorted by ID:
```sh
cardano-wallet stake-pool list --stake 1000 | jq 'sort_by(.id)' > stake-pool-list
```
The results should be identical for both `master` and this branch.

## Notes

### System used for Benchmarking

The system used for benchmarking (4 cores):

```
vendor_id       : GenuineIntel
cpu family      : 6
model           : 85
model name      : Intel(R) Xeon(R) CPU
stepping        : 7
microcode       : 0x1
cpu MHz         : 2800.176
cache size      : 33792 KB
```

Co-authored-by: Jonathan Knowles <jonathan.knowles@iohk.io>

lib/core/src/Cardano/Pool/DB.hs

@@ -177,6 +177,13 @@ data DBLayer m = forall stm. (MonadFail stm, MonadIO stm) => DBLayer
  -- ^ List all pools with an active retirement epoch that is earlier
  -- than or equal to the specified epoch.
 
+ , listPoolLifeCycleData
+ :: EpochNo
+ -> stm [PoolLifeCycleStatus]
+ -- ^ List the lifecycle data of all non-retired pools: pools that
+ -- either don't have an active retirement epoch or pools that have
+ -- an active retirement epoch that is later than the given epoch.
+
  , putPoolMetadata
  :: StakePoolMetadataHash
  -> StakePoolMetadata

lib/core/src/Cardano/Pool/DB/Log.hs

@@ -8,6 +8,7 @@
 --
 module Cardano.Pool.DB.Log
  ( PoolDbLog (..)
+ , ParseFailure (..)
  ) where
 
 import Prelude
@@ -22,6 +23,8 @@ import Cardano.Wallet.Logging
  ( BracketLog )
 import Cardano.Wallet.Primitive.Types
  ( EpochNo, PoolId, PoolRetirementCertificate )
+import Data.Text
+ ( Text )
 import Data.Text.Class
  ( ToText (..), toText )
 import Fmt
@@ -31,23 +34,41 @@ import qualified Data.Text as T
 
 data PoolDbLog
  = MsgGeneric DBLog
+ | MsgParseFailure ParseFailure
  | MsgRemovingPool PoolId
  | MsgRemovingRetiredPools [PoolRetirementCertificate]
  | MsgRemovingRetiredPoolsForEpoch EpochNo BracketLog
  deriving (Eq, Show)
 
+data ParseFailure = ParseFailure
+ { parseFailureOperationName
+ :: Text
+ -- ^ The name of the operation in which the parse failure occurred.
+ , parseFailure
+ :: Text
+ -- ^ A description of the parse failure.
+ }
+ deriving (Eq, Show)
+
 instance HasPrivacyAnnotation PoolDbLog
 
 instance HasSeverityAnnotation PoolDbLog where
  getSeverityAnnotation = \case
  MsgGeneric e -> getSeverityAnnotation e
+ MsgParseFailure {} -> Error
  MsgRemovingPool {} -> Notice
  MsgRemovingRetiredPools {} -> Debug
  MsgRemovingRetiredPoolsForEpoch {} -> Debug
 
 instance ToText PoolDbLog where
  toText = \case
  MsgGeneric e -> toText e
+ MsgParseFailure e -> mconcat
+ [ "Unexpected parse failure in '"
+ , parseFailureOperationName e
+ , "'. Description of error: "
+ , parseFailure e
+ ]
  MsgRemovingPool p -> mconcat
  [ "Removing the following pool from the database: "
  , toText p

lib/core/src/Cardano/Pool/DB/MVar.hs

@@ -65,6 +65,8 @@ import Data.Generics.Internal.VL.Lens
 import Data.Tuple
  ( swap )
 
+import qualified Data.Set as Set
+
 -- | Instantiate a new in-memory "database" layer that simply stores data in
 -- a local MVar. Data vanishes if the software is shut down.
 newDBLayer :: TimeInterpreter Identity -> IO (DBLayer IO)
@@ -124,6 +126,14 @@ newDBLayer timeInterpreter = do
  listRetiredPools epochNo =
  modifyMVar db (pure . swap . mListRetiredPools epochNo)
 
+ listPoolLifeCycleData epochNo = do
+ registeredPools <- Set.fromList
+ <$> listRegisteredPools
+ retiredPools <- Set.fromList . fmap (view #poolId)
+ <$> listRetiredPools epochNo
+ let nonRetiredPools = registeredPools `Set.difference` retiredPools
+ mapM readPoolLifeCycleStatus $ Set.toList nonRetiredPools
+
  putPoolMetadata a0 a1 =
  void $ alterPoolDB (const Nothing) db (mPutPoolMetadata a0 a1)