Use the new GetRewardInfoPools

… and drop the other local state queries related to rewards.

This depends on `cardano-node` version 1.33 or later.

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

@@ -76,6 +76,7 @@ module Cardano.Wallet.Api.Types
     , ApiBase64
     , ApiMintBurnData (..)
     , ApiStakePool (..)
+    , invariantApiStakePool
     , ApiStakePoolMetrics (..)
     , ApiStakePoolFlag (..)
     , ApiWallet (..)
@@ -811,14 +812,23 @@ data ApiStakePool = ApiStakePool
     , flags :: ![ApiStakePoolFlag]
     } deriving (Eq, Generic, Show)
 
+-- | The 'ApiStakePool' response contains redundant information
+-- and needs to satisfy this invariant.
+invariantApiStakePool :: ApiStakePool -> Bool
+invariantApiStakePool r = 
+    (OwnerStakeLowerThanPledge `elem` flags r)
+    == (pledge r < ownerStake (metrics r))
+
 data ApiStakePoolFlag
     = Delisted
+    | OwnerStakeLowerThanPledge
     deriving stock (Eq, Generic, Show)
     deriving anyclass NFData
 
 data ApiStakePoolMetrics = ApiStakePoolMetrics
     { nonMyopicMemberRewards :: !(Quantity "lovelace" Natural)
     , relativeStake :: !(Quantity "percent" Percentage)
+    , ownerStake :: !(Quantity "lovelace" Natural)
     , saturation :: !Double
     , producedBlocks :: !(Quantity "block" Natural)
     } deriving (Eq, Generic, Show)

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

@@ -43,6 +43,8 @@ import Cardano.BM.Data.Severity
     ( Severity (..) )
 import Cardano.BM.Data.Tracer
     ( HasPrivacyAnnotation (..), HasSeverityAnnotation (..) )
+import Cardano.Pool.Rank
+    ( StakePoolsSummary )
 import Cardano.Wallet.Primitive.BlockSummary
     ( LightSummary )
 import Cardano.Wallet.Primitive.Slotting
@@ -55,7 +57,6 @@ import Cardano.Wallet.Primitive.Types
     , ProtocolParameters
     , SlotNo (..)
     , SlottingParameters (..)
-    , StakePoolsSummary
     )
 import Cardano.Wallet.Primitive.Types.Coin
     ( Coin )
@@ -160,8 +161,7 @@ data NetworkLayer m block = NetworkLayer
         -- ^ Broadcast a transaction to the chain producer
 
     , stakeDistribution
-        :: Coin -- Stake to consider for rewards
-        -> m StakePoolsSummary
+        :: m (Maybe StakePoolsSummary)
 
     , getCachedRewardAccountBalance
         :: RewardAccount

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

@@ -107,7 +107,6 @@ module Cardano.Wallet.Primitive.Types
     , IsDelegatingTo (..)
 
     -- * Stake Pools
-    , StakePoolsSummary (..)
     , PoolId(..)
     , PoolOwner(..)
     , poolIdBytesLength
@@ -215,8 +214,6 @@ import Data.Kind
     ( Type )
 import Data.List
     ( intercalate )
-import Data.Map.Strict
-    ( Map )
 import Data.Maybe
     ( isJust, isNothing )
 import Data.Proxy
@@ -253,7 +250,6 @@ import Fmt
     , blockListF'
     , indentF
     , listF'
-    , mapF
     , prefixF
     , pretty
     , suffixF
@@ -276,7 +272,6 @@ import Test.QuickCheck
 import qualified Codec.Binary.Bech32 as Bech32
 import qualified Codec.Binary.Bech32.TH as Bech32
 import qualified Data.ByteString as BS
-import qualified Data.Map.Strict as Map
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 
@@ -759,19 +754,6 @@ instance FromJSON PoolOwner where
 instance ToJSON PoolOwner where
     toJSON = toJSON . toText
 
-data StakePoolsSummary = StakePoolsSummary
-    { nOpt :: Int
-    , rewards :: Map PoolId Coin
-    , stake :: Map PoolId Percentage
-    } deriving (Show, Eq)
-
-instance Buildable StakePoolsSummary where
-    build StakePoolsSummary{nOpt,rewards,stake} = listF' id
-        [ "Stake: " <> mapF (Map.toList stake)
-        , "Non-myopic member rewards: " <> mapF (Map.toList rewards)
-        , "Optimum number of pools: " <> pretty nOpt
-        ]
-
 {-------------------------------------------------------------------------------
                                     Block
 -------------------------------------------------------------------------------}

lib/core/test/unit/Cardano/Wallet/Api/TypesSpec.hs

@@ -194,6 +194,7 @@ import Cardano.Wallet.Api.Types
     , WalletPostData (..)
     , WalletPutData (..)
     , WalletPutPassphraseData (..)
+    , invariantApiStakePool
     , toApiAsset
     )
 import Cardano.Wallet.Gen
@@ -418,6 +419,7 @@ import Test.QuickCheck
     , scale
     , shrinkIntegral
     , sized
+    , suchThat
     , vector
     , vectorOf
     , (.&&.)
@@ -1749,20 +1751,20 @@ instance Arbitrary PoolId where
         return $ PoolId $ BS.pack $ take 28 bytes
 
 instance Arbitrary ApiStakePool where
-    arbitrary = ApiStakePool
+    arbitrary = (ApiStakePool
         <$> arbitrary
         <*> arbitrary
         <*> arbitrary
         <*> arbitrary
         <*> arbitrary
         <*> arbitrary
-        <*> arbitrary
-        <*> arbitrary
+        <*> arbitrary) `suchThat` invariantApiStakePool
 
 instance Arbitrary ApiStakePoolMetrics where
     arbitrary = ApiStakePoolMetrics
         <$> (Quantity . fromIntegral <$> choose (1::Integer, 1_000_000_000_000))
         <*> arbitrary
+        <*> arbitrary
         <*> (choose (0.0, 5.0))
         <*> (Quantity . fromIntegral <$> choose (1::Integer, 22_600_000))
 

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -74,7 +74,6 @@ module Cardano.Wallet.Shelley.Compatibility
     , toStakePoolDlgCert
     , toStakeCredential
     , fromStakeCredential
-    , toShelleyCoin
     , fromShelleyCoin
     , toHDPayloadAddress
     , toCardanoStakeCredential
@@ -103,9 +102,8 @@ module Cardano.Wallet.Shelley.Compatibility
 
       -- ** Stake pools
     , fromPoolId
-    , fromPoolDistr
-    , fromNonMyopicMemberRewards
-    , optimumNumberOfPools
+    , mkStakePoolsSummary
+    , StakePoolsData (..)
     , getProducer
 
     , HasNetworkId (..)
@@ -189,6 +187,8 @@ import Cardano.Ledger.Era
     ( Era (..) )
 import Cardano.Ledger.Serialization
     ( ToCBORGroup )
+import Cardano.Pool.Rank
+    ( RewardInfoPool (..), RewardParams (..) )
 import Cardano.Slotting.Slot
     ( EpochNo (..), EpochSize (..) )
 import Cardano.Slotting.Time
@@ -361,6 +361,7 @@ import qualified Cardano.Ledger.ShelleyMA as MA
 import qualified Cardano.Ledger.ShelleyMA.AuxiliaryData as MA
 import qualified Cardano.Ledger.ShelleyMA.TxBody as MA
 import qualified Cardano.Ledger.TxIn as TxIn
+import qualified Cardano.Pool.Rank as W
 import qualified Cardano.Wallet.Primitive.Types as W
 import qualified Cardano.Wallet.Primitive.Types.Address as W
 import qualified Cardano.Wallet.Primitive.Types.Coin as Coin
@@ -386,7 +387,6 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Map.Strict.NonEmptyMap as NonEmptyMap
 import qualified Data.Set as Set
 import qualified Data.Text.Encoding as T
-import qualified Ouroboros.Consensus.Shelley.Ledger as O
 import qualified Ouroboros.Network.Block as O
 import qualified Ouroboros.Network.Point as Point
 
@@ -424,7 +424,7 @@ emptyGenesis gp = W.Block
 
 -- | The protocol client version. Distinct from the codecs version.
 nodeToClientVersions :: [NodeToClientVersion]
-nodeToClientVersions = [NodeToClientV_8, NodeToClientV_9]
+nodeToClientVersions = [NodeToClientV_8, NodeToClientV_9, NodeToClientV_11]
 
 --------------------------------------------------------------------------------
 --
@@ -1220,34 +1220,53 @@ fromGenesisData g initialFunds =
 fromPoolId :: forall crypto. SL.KeyHash 'SL.StakePool crypto -> W.PoolId
 fromPoolId (SL.KeyHash x) = W.PoolId $ hashToBytes x
 
-fromPoolDistr
-    :: forall crypto. ()
-    => SL.PoolDistr crypto
-    -> Map W.PoolId Percentage
-fromPoolDistr =
-    Map.map (unsafeMkPercentage . SL.individualPoolStake)
-    . Map.mapKeys fromPoolId
-    . SL.unPoolDistr
-
--- NOTE: This function disregards results that are using staking keys
-fromNonMyopicMemberRewards
-    :: forall era. ()
-    => O.NonMyopicMemberRewards era
-    -> Map (Either W.Coin W.RewardAccount) (Map W.PoolId W.Coin)
-fromNonMyopicMemberRewards =
-    Map.map (Map.map toWalletCoin . Map.mapKeys fromPoolId)
-    . Map.mapKeys (bimap fromShelleyCoin fromStakeCredential)
-    . O.unNonMyopicMemberRewards
-
-optimumNumberOfPools
-    :: HasField "_nOpt" pparams Natural
-    => pparams
-    -> Int
-optimumNumberOfPools = unsafeConvert . getField @"_nOpt"
+-- | Stake distribution that we retrieve using a local state query
+data StakePoolsData = StakePoolsData
+    { _rewardParams
+        :: SLAPI.RewardParams
+    , _rewardInfoPools
+        :: Map
+            (SL.KeyHash 'SL.StakePool StandardCrypto)
+            SLAPI.RewardInfoPool
+    } deriving (Eq, Show)
+
+mkStakePoolsSummary :: StakePoolsData -> W.StakePoolsSummary
+mkStakePoolsSummary StakePoolsData{..} = W.StakePoolsSummary
+    { rewardParams = rewardParams
+    , pools
+        = Map.mapKeys fromPoolId
+        $ Map.map (toRewardInfoPool $ toWalletCoin totalStake) _rewardInfoPools
+    }
+  where
+    SLAPI.RewardParams{a0,nOpt,rPot,totalStake} = _rewardParams
+    rewardParams = W.RewardParams 
+        { nOpt = fromIntegral nOpt
+        , a0   = SL.unboundRational a0
+        , r    = toWalletCoin rPot
+        , totalStake = toWalletCoin totalStake
+        }
+
+toRewardInfoPool
+    :: W.Coin
+    -> SLAPI.RewardInfoPool
+    -> W.RewardInfoPool
+toRewardInfoPool totalStake SLAPI.RewardInfoPool{..} = W.RewardInfoPool
+    { stakeRelative = clipToPercentage
+        $ fromIntegral (SL.unCoin stake)
+          `proportionTo` fromIntegral (W.unCoin totalStake)
+    , ownerStake = toWalletCoin ownerStake
+    , ownerStakeRelative = clipToPercentage
+        $ fromIntegral (SL.unCoin ownerStake)
+          `proportionTo` fromIntegral (W.unCoin totalStake)
+    , ownerPledge = toWalletCoin ownerPledge
+    , cost = toWalletCoin cost
+    , margin = fromUnitInterval margin
+    , performanceEstimate = performanceEstimate
+    }
   where
-    -- A value of ~100 can be expected, so should be fine.
-    unsafeConvert :: Natural -> Int
-    unsafeConvert = fromIntegral
+    clipToPercentage = unsafeMkPercentage . min 1 . max 0
+    proportionTo _ 0 = 0
+    proportionTo x y = x / y
 
 --
 -- Txs
@@ -1328,8 +1347,6 @@ fromShelleyAddress = W.Address
 fromShelleyCoin :: SL.Coin -> W.Coin
 fromShelleyCoin (SL.Coin c) = Coin.unsafeFromIntegral c
 
-toShelleyCoin :: W.Coin -> SL.Coin
-toShelleyCoin (W.Coin c) = SL.Coin $ intCast c
 
 fromCardanoTx
     :: Cardano.Tx era