Merge #3231

3231: Light mode: fetch reward account balances r=Unisay a=Unisay

### Issue Number

ADP-1422, ADP-1506

### Overview

[Light-mode][] (Epic ADP-1422) aims to make synchronisation to the blockchain faster by trusting an off-chain source of aggregated blockchain data. 

  [light-mode]: https://input-output-hk.github.io/cardano-wallet/design/specs/light-mode

In this pull request, I have implemented two functions of the `NetworkLayer` interface:

- getCachedRewardAccountBalance
- fetchRewardAccountBalances


Co-authored-by: Yuriy Lazaryev <yuriy.lazaryev@iohk.io>

lib/shelley/cardano-wallet.cabal

@@ -111,6 +111,7 @@ library
       Cardano.Wallet.Shelley.Compatibility.Ledger
       Cardano.Wallet.Shelley.Network
       Cardano.Wallet.Shelley.Network.Blockfrost
+      Cardano.Wallet.Shelley.Network.Discriminant
       Cardano.Wallet.Shelley.Network.Node
       Cardano.Wallet.Shelley.Transaction
       Cardano.Wallet.Shelley.Launch

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

@@ -1,16 +1,11 @@
-{-# LANGUAGE AllowAmbiguousTypes #-}
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE NamedFieldPuns #-}
 {-# LANGUAGE NumericUnderscores #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies #-}
 
 -- |
 -- Copyright: © 2020 IOHK
@@ -57,7 +52,6 @@ import Cardano.Wallet.Network
 import Cardano.Wallet.Primitive.AddressDerivation
     ( DelegationAddress (..)
     , Depth (..)
-    , NetworkDiscriminant (..)
     , NetworkDiscriminantVal
     , PaymentAddress
     , PersistPrivateKey
@@ -110,11 +104,18 @@ import Cardano.Wallet.Shelley.Api.Server
 import Cardano.Wallet.Shelley.BlockchainSource
     ( BlockchainSource (..) )
 import Cardano.Wallet.Shelley.Compatibility
-    ( CardanoBlock, HasNetworkId (..), StandardCrypto, fromCardanoBlock )
+    ( CardanoBlock
+    , HasNetworkId (..)
+    , NetworkId
+    , StandardCrypto
+    , fromCardanoBlock
+    )
 import Cardano.Wallet.Shelley.Logging as Logging
     ( ApplicationLog (..) )
 import Cardano.Wallet.Shelley.Network
     ( withNetworkLayer )
+import Cardano.Wallet.Shelley.Network.Discriminant
+    ( SomeNetworkDiscriminant (..), networkDiscriminantToId )
 import Cardano.Wallet.Shelley.Pools
     ( StakePoolLayer (..)
     , StakePoolLog (..)
@@ -175,35 +176,12 @@ import UnliftIO.MVar
 import UnliftIO.STM
     ( newTVarIO )
 
-import qualified Cardano.Api.Shelley as Cardano
 import qualified Cardano.Pool.DB as PoolDb
 import qualified Cardano.Pool.DB.Sqlite as Pool
 import qualified Cardano.Wallet.Api.Server as Server
 import qualified Cardano.Wallet.DB.Sqlite as Sqlite
 import qualified Network.Wai.Handler.Warp as Warp
 
--- | Encapsulate a network discriminant and the necessary constraints it should
--- satisfy.
-data SomeNetworkDiscriminant where
-    SomeNetworkDiscriminant
-        :: forall (n :: NetworkDiscriminant).
-            ( NetworkDiscriminantVal n
-            , PaymentAddress n IcarusKey
-            , PaymentAddress n ByronKey
-            , PaymentAddress n ShelleyKey
-            , DelegationAddress n ShelleyKey
-            , HasNetworkId n
-            , DecodeAddress n
-            , EncodeAddress n
-            , DecodeStakeAddress n
-            , EncodeStakeAddress n
-            , Typeable n
-            )
-        => Proxy n
-        -> SomeNetworkDiscriminant
-
-deriving instance Show SomeNetworkDiscriminant
-
 -- | The @cardano-wallet@ main function. It takes the configuration
 -- which was passed from the CLI and environment and starts all components of
 -- the wallet.
@@ -245,7 +223,7 @@ serveWallet
     , genesisParameters
     , slottingParameters
     }
-  (SomeNetworkDiscriminant proxyNetwork)
+  network@(SomeNetworkDiscriminant proxyNetwork)
   Tracers{..}
   sTolerance
   databaseDir
@@ -264,7 +242,7 @@ serveWallet
     netLayer <- withNetworkLayer
         networkTracer
         blockchainSource
-        net
+        network
         netParams
         sTolerance
     stakePoolDbLayer <- withStakePoolDbLayer
@@ -303,20 +281,20 @@ serveWallet
     trace :: ApplicationLog -> IO ()
     trace = traceWith applicationTracer
 
-    net :: Cardano.NetworkId
-    net = networkIdVal proxyNetwork
+    netId :: NetworkId
+    netId = networkDiscriminantToId network
 
     bindSocket :: ContT r IO (Either ListenError (Warp.Port, Socket))
     bindSocket = ContT $ Server.withListeningSocket hostPref listen
 
     withRandomApi netLayer =
-        lift $ apiLayer (newTransactionLayer net) netLayer Server.idleWorker
+        lift $ apiLayer (newTransactionLayer netId) netLayer Server.idleWorker
 
     withIcarusApi netLayer =
-        lift $ apiLayer (newTransactionLayer net) netLayer Server.idleWorker
+        lift $ apiLayer (newTransactionLayer netId) netLayer Server.idleWorker
 
     withShelleyApi netLayer =
-        lift $ apiLayer (newTransactionLayer net) netLayer
+        lift $ apiLayer (newTransactionLayer netId) netLayer
             (Server.manageRewardBalance proxyNetwork)
 
     withMultisigApi netLayer =

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

@@ -1,4 +1,8 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RankNTypes #-}
 
 module Cardano.Wallet.Shelley.Network
     ( -- * Top-Level Interface
@@ -10,7 +14,6 @@ module Cardano.Wallet.Shelley.Network
 
 import Prelude
 
-import qualified Cardano.Api as Cardano
 import qualified Cardano.Wallet.Shelley.Network.Blockfrost as Blockfrost
 import qualified Cardano.Wallet.Shelley.Network.Node as Node
 
@@ -24,6 +27,10 @@ import Cardano.Wallet.Primitive.Types
     ( NetworkParameters )
 import Cardano.Wallet.Shelley.BlockchainSource
     ( BlockchainSource (..) )
+import Cardano.Wallet.Shelley.Compatibility
+    ( CardanoBlock, StandardCrypto )
+import Cardano.Wallet.Shelley.Network.Discriminant
+    ( SomeNetworkDiscriminant, networkDiscriminantToId )
 import Control.Monad.Trans.Cont
     ( ContT (ContT) )
 import Data.Functor.Contravariant
@@ -32,8 +39,6 @@ import Data.Text.Class
     ( ToText (toText) )
 import GHC.Stack
     ( HasCallStack )
-import Ouroboros.Consensus.Cardano.Block
-    ( CardanoBlock, StandardCrypto )
 
 data NetworkLayerLog
     = NodeNetworkLog Node.Log
@@ -55,16 +60,16 @@ withNetworkLayer
     :: HasCallStack
     => Tracer IO NetworkLayerLog
     -> BlockchainSource
-    -> Cardano.NetworkId
+    -> SomeNetworkDiscriminant
     -> NetworkParameters
     -> SyncTolerance
     -> ContT r IO (NetworkLayer IO (CardanoBlock StandardCrypto))
 withNetworkLayer tr blockchainSrc net netParams tol =
     ContT $ case blockchainSrc of
         NodeSource nodeConn ver ->
             let tr' = NodeNetworkLog >$< tr
-            in Node.withNetworkLayer tr' net netParams nodeConn ver tol
+                netId = networkDiscriminantToId net
+            in Node.withNetworkLayer tr' netId netParams nodeConn ver tol
         BlockfrostSource project ->
             let tr' = BlockfrostNetworkLog >$< tr
             in Blockfrost.withNetworkLayer tr' net netParams project
-

lib/shelley/src/Cardano/Wallet/Shelley/Network/Blockfrost.hs

@@ -35,7 +35,9 @@ import Prelude
 
 import qualified Blockfrost.Client as BF
 import qualified Cardano.Api.Shelley as Node
+import qualified Data.Map.Strict as Map
 import qualified Data.Sequence as Seq
+import qualified Data.Set as Set
 import qualified Ouroboros.Consensus.HardFork.History.Qry as HF
 
 import Cardano.Api
@@ -56,6 +58,8 @@ import Cardano.Pool.Rank
     ( RewardParams (..) )
 import Cardano.Pool.Rank.Likelihood
     ( BlockProduction (..), PerformanceEstimate (..), estimatePoolPerformance )
+import Cardano.Wallet.Api.Types
+    ( encodeStakeAddress )
 import Cardano.Wallet.Logging
     ( BracketLog, bracketTracer )
 import Cardano.Wallet.Network
@@ -93,8 +97,12 @@ import Cardano.Wallet.Primitive.Types.Coin
     ( Coin (Coin, unCoin) )
 import Cardano.Wallet.Primitive.Types.Hash
     ( Hash )
+import Cardano.Wallet.Primitive.Types.RewardAccount
+    ( RewardAccount )
 import Cardano.Wallet.Primitive.Types.Tx
     ( TxSize (..) )
+import Cardano.Wallet.Shelley.Network.Discriminant
+    ( SomeNetworkDiscriminant (..), networkDiscriminantToId )
 import Control.Concurrent
     ( threadDelay )
 import Control.Monad
@@ -111,11 +119,19 @@ import Data.Functor.Contravariant
     ( (>$<) )
 import Data.IntCast
     ( intCast, intCastMaybe )
+import Data.Map
+    ( Map )
+import Data.Maybe
+    ( fromMaybe )
+import Data.Proxy
+    ( Proxy (..) )
 import Data.Quantity
     ( MkPercentageError (PercentageOutOfBoundsError)
     , Quantity (..)
     , mkPercentage
     )
+import Data.Set
+    ( Set )
 import Data.Text.Class
     ( FromText (fromText), TextDecodingError (..), ToText (..) )
 import Data.Traversable
@@ -184,30 +200,33 @@ instance HasSeverityAnnotation Log where
 
 withNetworkLayer
     :: Tracer IO Log
-    -> NetworkId
+    -> SomeNetworkDiscriminant
     -> NetworkParameters
     -> BF.Project
     -> (NetworkLayer IO (CardanoBlock StandardCrypto) -> IO a)
     -> IO a
-withNetworkLayer tr net np project k = k NetworkLayer
-    { chainSync = \_tr _chainFollower -> pure ()
-    , lightSync = Nothing
-    , currentNodeTip
-    , currentNodeEra
-    , currentProtocolParameters
-    , currentSlottingParameters = undefined
-    , watchNodeTip
-    , postTx = undefined
-    , stakeDistribution = undefined
-    , getCachedRewardAccountBalance = undefined
-    , fetchRewardAccountBalances = undefined
-    , timeInterpreter = timeInterpreterFromStartTime getGenesisBlockDate
-    , syncProgress = undefined
-    }
+withNetworkLayer tr network np project k =
+    k NetworkLayer
+        { chainSync = \_tr _chainFollower -> pure ()
+        , lightSync = Nothing
+        , currentNodeTip
+        , currentNodeEra
+        , currentProtocolParameters
+        , currentSlottingParameters = undefined
+        , watchNodeTip
+        , postTx = undefined
+        , stakeDistribution = undefined
+        , getCachedRewardAccountBalance
+        , fetchRewardAccountBalances = fetchNetworkRewardAccountBalances network
+        , timeInterpreter = timeInterpreterFromStartTime getGenesisBlockDate
+        , syncProgress = undefined
+        }
   where
     NetworkParameters
         { genesisParameters = GenesisParameters { getGenesisBlockDate } } = np
 
+    networkId = networkDiscriminantToId network
+
     currentNodeTip :: IO BlockHeader
     currentNodeTip = runBlockfrost BF.getLatestBlock
     -- ^ TODO: use cached value while retrying
@@ -228,13 +247,32 @@ withNetworkLayer tr net np project k = k NetworkLayer
     currentNodeEra = handleBlockfrostError $ do
         BF.EpochInfo {_epochInfoEpoch} <- liftBlockfrost BF.getLatestEpoch
         epoch <- fromBlockfrostM _epochInfoEpoch
-        liftEither $ eraByEpoch net epoch
+        liftEither $ eraByEpoch networkId epoch
 
     timeInterpreterFromStartTime ::
         StartTime -> TimeInterpreter (ExceptT PastHorizonException IO)
     timeInterpreterFromStartTime startTime =
         mkTimeInterpreter (MsgTimeInterpreterLog >$< tr) startTime $
-            pure $ HF.mkInterpreter $ networkSummary net
+            pure $ HF.mkInterpreter $ networkSummary networkId
+
+    fetchNetworkRewardAccountBalances  ::
+        SomeNetworkDiscriminant ->
+        Set RewardAccount ->
+        IO (Map RewardAccount Coin)
+    fetchNetworkRewardAccountBalances
+        (SomeNetworkDiscriminant (Proxy :: Proxy nd)) accounts =
+        handleBlockfrostError . fmap Map.fromList $
+            for (Set.toList accounts) $ \rewardAccount -> do
+                BF.AccountInfo {..} <- liftBlockfrost $ BF.getAccount $
+                    BF.mkAddress $ encodeStakeAddress @nd rewardAccount
+                coin <- fromIntegral @_ @Integer _accountInfoRewardsSum <?#>
+                    "AccountInfoRewardsSum"
+                pure (rewardAccount, Coin coin)
+
+    getCachedRewardAccountBalance :: RewardAccount -> IO Coin
+    getCachedRewardAccountBalance account =
+        fromMaybe (Coin 0) . Map.lookup account <$>
+            fetchNetworkRewardAccountBalances network (Set.singleton account)
 
     handleBlockfrostError :: ExceptT BlockfrostError IO a -> IO a
     handleBlockfrostError =
@@ -645,7 +683,7 @@ For the Mainnet:      For the Testnet:
 
 -}
 eraByEpoch :: NetworkId -> EpochNo -> Either BlockfrostError AnyCardanoEra
-eraByEpoch net epoch =
+eraByEpoch networkId epoch =
     case dropWhile ((> epoch) . snd) (reverse eraBoundaries) of
         (era, _) : _ -> Right era
         _ -> Left $ UnknownEraForEpoch epoch
@@ -657,7 +695,7 @@ eraByEpoch net epoch =
         -- When new era is added this function reminds to update itself:
         -- "Pattern match(es) are non-exhaustive"
         epochEraStartsAt :: Node.AnyCardanoEra -> EpochNo
-        epochEraStartsAt era = EpochNo $ case net of
+        epochEraStartsAt era = EpochNo $ case networkId of
             Mainnet ->
                 case era of
                     AnyCardanoEra AlonzoEra  -> 290