Skip to content

Commit fe984a8

Browse files
iohk-bors[bot]KtorZAnviking
authored
Merge #1444
1444: Store pool retirement certificates + fix stake distribution fetching & combining. r=KtorZ a=KtorZ # Issue Number <!-- Put here a reference to the issue this PR relates to and which requirements it tackles --> #1442 # Overview <!-- Detail in a few bullet points the work accomplished in this PR --> - c748037 bump versions in README compatibility matrix - ded40cc add Jörmungandr binary deserialisers for pool retirement certificates - 42e387d track 'PoolRetirementCertificate' in the stake pool worker The corresponding database function doesn't exist _yet_, coming in the next commit. So far, this would simply add the retirement certificates into a new table but, do nothing with them. - 61203d4 implement initial behavior for 'putPoolRetirement' in the database layer Any pool that has submitted a retirement certificate will be removed from the list, regardless of the retirement time set by the pool. Ideally, we would prefer to only discard pool when they are actually retired (i.e. based on the time they set). - 7c8623a Fetch stake distribution by epoch instead of latest one - 9d2fd50 Ignore blocks produced by pools not in the stake distribution. The erroring was originally a precaution. While I haven't checked, it must be that jormungandr removes pools in the stake-distribution... before they are retired? This patch seems to solve the problem. - 7f43e64 cleanup ErrMetricsInconsistency now obsolete - 0858080 update jormungandr.nix references for 0.8.14 # Comments <!-- Additional comments or screenshots to attach if any --> :warning: turns out that handling de-registration certificates was kinda useless. Problem was that we were trying to merge all-time production with stake distribution of the latest epoch which.. doesn't work. On the way fixing this, I also implemented fetching the stake distribution based on the relevant epoch number, so this is now done as part of the forward loop and should automatically make the metrics & ranking much more stable. Also added code for managing retirement certificates. We still do nothing with that but.. it's there now :man_shrugging: ... when relevant, we can then think about notifying frontend applications about de-registered pools. <!-- Don't forget to: ✓ Self-review your changes to make sure nothing unexpected slipped through ✓ Assign yourself to the PR ✓ Assign one or several reviewer(s) ✓ Once created, link this PR to its corresponding ticket ✓ Assign the PR to a corresponding milestone ✓ Acknowledge any changes required to the Wiki --> Co-authored-by: KtorZ <matthias.benkort@gmail.com> Co-authored-by: Johannes Lund <johannes.lund@iohk.io>
2 parents 203184f + 31e270b commit fe984a8

File tree

12 files changed

+87
-131
lines changed

12 files changed

+87
-131
lines changed

README.md

Lines changed: 7 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -45,12 +45,13 @@ See **Installation Instructions** for each available [release](https://github.co
4545

4646
> ### Latest releases
4747
>
48-
> | cardano-wallet | Jörmungandr (compatible versions) |
49-
> | --- | --- |
50-
> | `master` branch | [v0.8.13](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.13) |
51-
> | [v2020-02-17](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-02-17) | [v0.8.9](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.9) |
52-
> | [v2020-01-27](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-01-27) | [v0.8.7](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.7) |
53-
> | [v2020-01-14](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-01-14) | [v0.8.5](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.5) |
48+
> | cardano-wallet | jörmungandr (compatible versions) | cardano-node (compatible versions)
49+
> | --- | --- | ---
50+
> | `master` branch | [v0.8.14](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.14) | [1.6.0](https://github.com/input-output-hk/cardano-node/releases/tag/1.6.0)
51+
> | [v2020-03-11](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-03-11) | [v0.8.13](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.13) | [1.6.0](https://github.com/input-output-hk/cardano-node/releases/tag/1.6.0)
52+
> | [v2020-02-17](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-02-17) | [v0.8.9](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.9) | N/A
53+
> | [v2020-01-27](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-01-27) | [v0.8.7](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.7) | N/A
54+
> | [v2020-01-14](https://github.com/input-output-hk/cardano-wallet/releases/tag/v2020-01-14) | [v0.8.5](https://github.com/input-output-hk/jormungandr/releases/tag/v0.8.5) | N/A
5455
5556
## How to build from sources
5657

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

Lines changed: 42 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -8,6 +8,7 @@
88
{-# LANGUAGE RankNTypes #-}
99
{-# LANGUAGE RecordWildCards #-}
1010
{-# LANGUAGE ScopedTypeVariables #-}
11+
{-# LANGUAGE TupleSections #-}
1112

1213
-- | This module can fold over a blockchain to collect metrics about
1314
-- Stake pools.
@@ -30,7 +31,6 @@ module Cardano.Pool.Metrics
3031
, monitorStakePools
3132

3233
-- * Combining Metrics
33-
, ErrMetricsInconsistency (..)
3434
, combineMetrics
3535

3636
-- * Associating metadata
@@ -81,7 +81,7 @@ import Cardano.Wallet.Unsafe
8181
import Control.Arrow
8282
( first )
8383
import Control.Monad
84-
( forM_, when )
84+
( forM, forM_, when )
8585
import Control.Monad.IO.Class
8686
( liftIO )
8787
import Control.Monad.Trans.Class
@@ -93,13 +93,13 @@ import Control.Tracer
9393
import Data.Functor
9494
( (<&>) )
9595
import Data.Generics.Internal.VL.Lens
96-
( (^.) )
96+
( view, (^.) )
9797
import Data.List
9898
( nub, nubBy, sortOn, (\\) )
9999
import Data.List.NonEmpty
100100
( NonEmpty )
101101
import Data.Map.Merge.Strict
102-
( traverseMissing, zipWithMatched )
102+
( dropMissing, traverseMissing, zipWithMatched )
103103
import Data.Map.Strict
104104
( Map )
105105
import Data.Ord
@@ -122,6 +122,7 @@ import System.Random
122122
( StdGen )
123123

124124
import qualified Cardano.Pool.Ranking as Ranking
125+
import qualified Data.List.NonEmpty as NE
125126
import qualified Data.Map.Merge.Strict as Map
126127
import qualified Data.Map.Strict as Map
127128

@@ -192,15 +193,19 @@ monitorStakePools tr (block0, Quantity k) nl db@DBLayer{..} = do
192193
-> BlockHeader
193194
-> IO (FollowAction ErrMonitorStakePools)
194195
forward blocks nodeTip = handler $ do
195-
(ep, dist) <- withExceptT ErrMonitorStakePoolsNetworkUnavailable $
196-
stakeDistribution nl
196+
let epochs = NE.nub $ view (#header . #slotId . #epochNumber) <$> blocks
197+
distributions <- forM epochs $ \ep -> do
198+
liftIO $ traceWith tr $ MsgStakeDistribution ep
199+
withExceptT ErrMonitorStakePoolsNetworkUnavailable $
200+
(ep,) <$> stakeDistribution nl ep
201+
197202
currentTip <- withExceptT ErrMonitorStakePoolsCurrentNodeTip $
198203
currentNodeTip nl
199204
when (nodeTip /= currentTip) $ throwE ErrMonitorStakePoolsWrongTip
200205

201-
liftIO $ traceWith tr $ MsgStakeDistribution ep
202206
mapExceptT atomically $ do
203-
lift $ putStakeDistribution ep (Map.toList dist)
207+
forM_ distributions $ \(ep, dist) ->
208+
lift $ putStakeDistribution ep (Map.toList dist)
204209
forM_ blocks $ \b -> do
205210
forM_ (poolRegistrations b) $ \pool -> do
206211
lift $ putPoolRegistration (b ^. #header . #slotId) pool
@@ -248,7 +253,6 @@ data StakePoolLayer m = StakePoolLayer
248253

249254
data ErrListStakePools
250255
= ErrMetricsIsUnsynced (Quantity "percent" Percentage)
251-
| ErrListStakePoolsMetricsInconsistency ErrMetricsInconsistency
252256
| ErrListStakePoolsCurrentNodeTip ErrCurrentNodeTip
253257
deriving (Show)
254258

@@ -334,18 +338,16 @@ newStakePoolLayer tr block0H getEpCst db@DBLayer{..} nl metadataDir = StakePoolL
334338
liftIO $ do
335339
traceWith tr $ MsgUsingTotalStakeForRanking totalStake
336340
traceWith tr $ MsgUsingRankingEpochConstants epConstants
337-
case combineMetrics distr prod perfs of
338-
Left e ->
339-
throwE $ ErrListStakePoolsMetricsInconsistency e
340-
Right ps -> lift $ do
341-
let len = fromIntegral (length ps)
342-
let avg = if null ps
343-
then 0
344-
else sum ((\(_,_,c) -> c) <$> (Map.elems ps)) / len
345-
ns <- readNewcomers db (Map.keys ps) avg
346-
pools <- atomically $
347-
Map.traverseMaybeWithKey mergeRegistration (ps <> ns)
348-
sortResults $ Map.elems pools
341+
let ps = combineMetrics distr prod perfs
342+
lift $ do
343+
let len = fromIntegral (length ps)
344+
let avg = if null ps
345+
then 0
346+
else sum ((\(_,_,c) -> c) <$> (Map.elems ps)) / len
347+
ns <- readNewcomers db (Map.keys ps) avg
348+
pools <- atomically $
349+
Map.traverseMaybeWithKey mergeRegistration (ps <> ns)
350+
sortResults $ Map.elems pools
349351
where
350352
totalStake =
351353
Quantity $ Map.foldl' (\a (Quantity b) -> a + b) 0 distr
@@ -413,56 +415,32 @@ readNewcomers DBLayer{..} elders avg = do
413415
-- 2. A pool-production map
414416
-- 3. A pool-performance map
415417
--
416-
-- If a pool has produced a block without existing in the stake-distribution,
417-
-- i.e it exists in (2) but not (1), this function will return
418-
-- @Left ErrMetricsInconsistency@.
419-
--
420-
-- If a pool is in (1) but not (2), it simply means it has produced 0 blocks so
421-
-- far.
422-
--
423-
-- Similarly, if we do have metrics about a pool in (3), but this pool is
424-
-- unknown from (1) & (2), this function also returns
425-
-- @Left ErrMetricsInconsistency@.
418+
-- If a pool is in 2 or 3 but not in 1, it means that the pool has been
419+
-- de-registered.
426420
--
427421
-- If a pool is in (1+2) but not in (3), it simply means it has produced 0
428422
-- blocks so far.
429423
combineMetrics
430424
:: Map PoolId (Quantity "lovelace" Word64)
431425
-> Map PoolId (Quantity "block" Word64)
432426
-> Map PoolId Double
433-
-> Either
434-
ErrMetricsInconsistency
435-
( Map PoolId
436-
( Quantity "lovelace" Word64
437-
, Quantity "block" Word64
438-
, Double
439-
)
427+
-> Map PoolId
428+
( Quantity "lovelace" Word64
429+
, Quantity "block" Word64
430+
, Double
440431
)
441-
combineMetrics mStake mProd mPerf = do
442-
let errMissingLeft = ErrProducerNotInDistribution
443-
mActivity <- zipWithRightDefault (,) errMissingLeft (Quantity 0) mStake mProd
444-
zipWithRightDefault unzipZip3 errMissingLeft 0 mActivity mPerf
432+
combineMetrics mStake mProd mPerf =
433+
let
434+
mActivity = zipWithRightDefault (,) (Quantity 0) mStake mProd
435+
in
436+
zipWithRightDefault unzipZip3 0 mActivity mPerf
445437
where
446438
unzipZip3 :: (a,b) -> c -> (a,b,c)
447439
unzipZip3 (a,b) c = (a,b,c)
448440

449-
-- | Possible errors returned by 'combineMetrics'.
450-
newtype ErrMetricsInconsistency
451-
= ErrProducerNotInDistribution PoolId
452-
-- ^ Somehow, we tried to combine invalid metrics together and passed
453-
-- a passed a block production that doesn't match the producers found in
454-
-- the stake activity.
455-
--
456-
-- Note that the opposite case is okay as we only observe pools that
457-
-- have produced blocks. So it could be the case that a pool exists in
458-
-- the distribution but not in the production! (In which case, we'll
459-
-- assign it a production of '0').
460-
deriving (Show, Eq)
461-
462441
-- | Combine two maps with the given zipping function. It defaults when elements
463-
-- of the first map (left) are not present in the second (right), but returns an
464-
-- error when elements of the second (right) map are not present in the first
465-
-- (left).
442+
-- of the first map (left) are not present in the second (right), and discards
443+
-- elements in the second (right) map are not present in the first (left).
466444
--
467445
-- Example:
468446
--
@@ -471,24 +449,20 @@ newtype ErrMetricsInconsistency
471449
-- let m2 = Map.fromList [(2, True)]
472450
-- @
473451
--
474-
-- >>> zipWithRightDefault (,) ErrMissing False m1 m2
475-
-- Right (Map.fromList [(1, ('a', False)), (2, ('b', True)), (3, ('c', False))])
476-
--
477-
-- >>> zipWithRightDefault (,) ErrMissing False m2 m1
478-
-- Left (ErrMissing 1)
452+
-- >>> zipWithRightDefault (,) False m1 m2
453+
-- Map.fromList [(1, ('a', False)), (2, ('b', True)), (3, ('c', False))])
479454
zipWithRightDefault
480455
:: Ord k
481456
=> (l -> r -> a)
482-
-> (k -> errMissingLeft)
483457
-> r
484458
-> Map k l
485459
-> Map k r
486-
-> Either errMissingLeft (Map k a)
487-
zipWithRightDefault combine onMissing rZero =
488-
Map.mergeA leftButNotRight rightButNotLeft bothPresent
460+
-> Map k a
461+
zipWithRightDefault combine rZero =
462+
Map.merge leftButNotRight rightButNotLeft bothPresent
489463
where
490464
leftButNotRight = traverseMissing $ \_k l -> pure (combine l rZero)
491-
rightButNotLeft = traverseMissing $ \k _r -> Left (onMissing k)
465+
rightButNotLeft = dropMissing
492466
bothPresent = zipWithMatched $ \_k l r -> (combine l r)
493467

494468
-- | Given a mapping from 'PoolId' -> 'PoolOwner' and a mapping between

lib/core/src/Cardano/Wallet/Api/Server.hs

Lines changed: 1 addition & 16 deletions
Original file line numberDiff line numberDiff line change
@@ -40,11 +40,7 @@ import Prelude
4040
import Cardano.Pool.Metadata
4141
( StakePoolMetadata )
4242
import Cardano.Pool.Metrics
43-
( ErrListStakePools (..)
44-
, ErrMetricsInconsistency (..)
45-
, StakePool (..)
46-
, StakePoolLayer (..)
47-
)
43+
( ErrListStakePools (..), StakePool (..), StakePoolLayer (..) )
4844
import Cardano.Wallet
4945
( ErrAdjustForFee (..)
5046
, ErrCannotJoin (..)
@@ -2089,7 +2085,6 @@ instance LiftHandler ErrCurrentNodeTip where
20892085

20902086
instance LiftHandler ErrListStakePools where
20912087
handler = \case
2092-
ErrListStakePoolsMetricsInconsistency e -> handler e
20932088
ErrListStakePoolsCurrentNodeTip e -> handler e
20942089
ErrMetricsIsUnsynced p ->
20952090
apiError err503 NotSynced $ mconcat
@@ -2098,16 +2093,6 @@ instance LiftHandler ErrListStakePools where
20982093
, toText p
20992094
]
21002095

2101-
instance LiftHandler ErrMetricsInconsistency where
2102-
handler = \case
2103-
ErrProducerNotInDistribution producer ->
2104-
apiError err500 UnexpectedError $ mconcat
2105-
[ "Something is terribly wrong with the metrics I collected. "
2106-
, "I recorded that some blocks were produced by "
2107-
, toText producer
2108-
, " but the node doesn't know about this stake pool!"
2109-
]
2110-
21112096
instance LiftHandler ErrSelectForDelegation where
21122097
handler = \case
21132098
ErrSelectForDelegationNoSuchWallet e -> handler e

lib/core/src/Cardano/Wallet/Network.hs

Lines changed: 3 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -122,10 +122,9 @@ data NetworkLayer m target block = NetworkLayer
122122
-- ^ Broadcast a transaction to the chain producer
123123

124124
, stakeDistribution
125-
:: ExceptT ErrNetworkUnavailable m
126-
( EpochNo
127-
, Map PoolId (Quantity "lovelace" Word64)
128-
)
125+
:: EpochNo
126+
-> ExceptT ErrNetworkUnavailable m
127+
(Map PoolId (Quantity "lovelace" Word64))
129128

130129
, getAccountBalance
131130
:: ChimericAccount

lib/core/src/Cardano/Wallet/Primitive/Types.hs

Lines changed: 3 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1202,6 +1202,9 @@ newtype EpochNo = EpochNo { unEpochNo :: Word31 }
12021202
deriving stock (Show, Read, Eq, Ord, Generic)
12031203
deriving newtype (Num, Bounded, Enum)
12041204

1205+
instance ToText EpochNo where
1206+
toText = T.pack . show . unEpochNo
1207+
12051208
instance Buildable EpochNo where
12061209
build (EpochNo e) = build $ fromIntegral @Word31 @Word32 e
12071210

lib/core/test/unit/Cardano/Pool/MetricsSpec.hs

Lines changed: 5 additions & 17 deletions
Original file line numberDiff line numberDiff line change
@@ -109,7 +109,6 @@ import Test.QuickCheck
109109
, checkCoverage
110110
, choose
111111
, counterexample
112-
, cover
113112
, elements
114113
, frequency
115114
, property
@@ -159,7 +158,7 @@ prop_combineDefaults
159158
prop_combineDefaults mStake = do
160159
combineMetrics mStake Map.empty Map.empty
161160
===
162-
Right (Map.map (, Quantity 0, 0) mStake)
161+
Map.map (, Quantity 0, 0) mStake
163162

164163
-- | it fails if a block-producer or performance is not in the stake distr
165164
prop_combineIsLeftBiased
@@ -168,19 +167,8 @@ prop_combineIsLeftBiased
168167
-> Map (LowEntropy PoolId) Double
169168
-> Property
170169
prop_combineIsLeftBiased mStake_ mProd_ mPerf_ =
171-
let
172-
shouldLeft = or
173-
[ not . Map.null $ Map.difference mProd mStake
174-
, not . Map.null $ Map.difference mPerf mStake
175-
]
176-
in
177-
cover 10 shouldLeft "A pool without stake produced"
178-
$ cover 50 (not shouldLeft) "Successfully combined the maps"
179-
$ case combineMetrics mStake mProd mPerf of
180-
Left _ ->
181-
shouldLeft === True
182-
Right x ->
183-
Map.map (\(a,_,_) -> a) x === mStake
170+
let x = combineMetrics mStake mProd mPerf
171+
in Map.map (\(a,_,_) -> a) x === mStake
184172
where
185173
mStake = Map.mapKeys getLowEntropy mStake_
186174
mProd = Map.mapKeys getLowEntropy mProd_
@@ -267,8 +255,8 @@ prop_trackRegistrations test = monadicIO $ do
267255
$ ErrNetworkInvalid "The test case has finished")
268256
, initCursor =
269257
pure . const (Cursor header0)
270-
, stakeDistribution =
271-
pure (0, mempty)
258+
, stakeDistribution = \_ ->
259+
pure mempty
272260
, currentNodeTip =
273261
pure header0
274262
}

lib/jormungandr/src/Cardano/Wallet/Jormungandr/Api.hs

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -22,6 +22,7 @@ import Prelude
2222
import Cardano.Wallet.Jormungandr.Api.Types
2323
( AccountId
2424
, AccountState
25+
, ApiT
2526
, BlockId
2627
, Hex
2728
, JormungandrBinary
@@ -30,7 +31,7 @@ import Cardano.Wallet.Jormungandr.Api.Types
3031
import Cardano.Wallet.Jormungandr.Binary
3132
( Block )
3233
import Cardano.Wallet.Primitive.Types
33-
( SealedTx (..) )
34+
( EpochNo, SealedTx (..) )
3435
import Data.Proxy
3536
( Proxy (..) )
3637
import Servant.API
@@ -94,4 +95,5 @@ type PostMessage
9495
type GetStakeDistribution
9596
= "api" :> "v0"
9697
:> "stake"
98+
:> Capture "epoch" (ApiT EpochNo)
9799
:> Get '[JSON] StakeApiResponse

0 commit comments

Comments
 (0)