From 282e86b0a169dadf79f40a94b01132f301b21946 Mon Sep 17 00:00:00 2001 From: Julian Ospald Date: Mon, 31 Aug 2020 16:06:36 +0200 Subject: [PATCH] Return descriptive 503 when listing stake pools with uncomplete sync Wrt #1971 --- lib/core/src/Cardano/Wallet.hs | 8 ++++ lib/core/src/Cardano/Wallet/Api/Server.hs | 21 +++++++--- .../src/Cardano/Wallet/Shelley/Pools.hs | 38 ++++++++++++++----- 3 files changed, 53 insertions(+), 14 deletions(-) diff --git a/lib/core/src/Cardano/Wallet.hs b/lib/core/src/Cardano/Wallet.hs index a181e6c1b03..441b2d5bce7 100644 --- a/lib/core/src/Cardano/Wallet.hs +++ b/lib/core/src/Cardano/Wallet.hs @@ -173,6 +173,9 @@ module Cardano.Wallet -- * Logging , WalletLog (..) + + -- * Stake pool listing + , ErrListPools (..) ) where import Prelude hiding @@ -2364,6 +2367,11 @@ data ErrWithdrawalNotWorth = ErrWithdrawalNotWorth deriving (Generic, Eq, Show) +-- | Errors that can occur when trying to list stake pool. +data ErrListPools + = ErrListPoolsNetworkError ErrNetworkUnavailable + | ErrListPoolsPastHorizonException PastHorizonException + deriving (Show) {------------------------------------------------------------------------------- Utils -------------------------------------------------------------------------------} diff --git a/lib/core/src/Cardano/Wallet/Api/Server.hs b/lib/core/src/Cardano/Wallet/Api/Server.hs index 39b7d04b0a3..617e1b71928 100644 --- a/lib/core/src/Cardano/Wallet/Api/Server.hs +++ b/lib/core/src/Cardano/Wallet/Api/Server.hs @@ -109,6 +109,7 @@ import Cardano.Wallet , ErrImportAddress (..) , ErrImportRandomAddress (..) , ErrJoinStakePool (..) + , ErrListPools (..) , ErrListTransactions (..) , ErrListUTxOStatistics (..) , ErrMkTx (..) @@ -315,7 +316,7 @@ import Control.Concurrent import Control.Concurrent.Async ( race_ ) import Control.Exception - ( IOException, bracket, throwIO, tryJust ) + ( IOException, bracket, throwIO, try, tryJust ) import Control.Monad ( forM, forever, void, when, (>=>) ) import Control.Monad.Catch @@ -423,6 +424,7 @@ import qualified Cardano.Wallet.Api.Types as Api import qualified Cardano.Wallet.Network as NW import qualified Cardano.Wallet.Primitive.AddressDerivation.Byron as Byron import qualified Cardano.Wallet.Primitive.AddressDerivation.Icarus as Icarus +import qualified Cardano.Wallet.Primitive.Slotting as S import qualified Cardano.Wallet.Primitive.Types as W import qualified Cardano.Wallet.Registry as Registry import qualified Data.Aeson as Aeson @@ -1588,17 +1590,20 @@ assignMigrationAddresses addrs selections = Network -------------------------------------------------------------------------------} -data ErrCurrentEpoch = ErrUnableToDetermineCurrentEpoch +data ErrCurrentEpoch + = ErrUnableToDetermineCurrentEpoch + | ErrCurrentEpochPastHorizonException PastHorizonException getCurrentEpoch :: forall ctx s t k . (ctx ~ ApiLayer s t k) => ctx -> Handler W.EpochNo getCurrentEpoch ctx = do - res <- liftIO $ currentEpoch ti + res <- liftIO $ try $ currentEpoch ti case res of - Nothing -> liftE ErrUnableToDetermineCurrentEpoch - Just x -> pure x + Right Nothing -> liftE ErrUnableToDetermineCurrentEpoch + Right (Just x) -> pure x + Left e@(S.PastHorizon{}) -> liftE (ErrCurrentEpochPastHorizonException e) where ti :: TimeInterpreter IO ti = timeInterpreter (ctx ^. networkLayer @t) @@ -2020,6 +2025,7 @@ instance LiftHandler ErrCurrentEpoch where [ "I'm unable to determine the current epoch. " , "Please wait a while for the node to sync and try again." ] + ErrCurrentEpochPastHorizonException e -> handler e instance LiftHandler ErrUnexpectedPoolIdPlaceholder where handler = \case @@ -2495,6 +2501,11 @@ instance LiftHandler ErrWithdrawalNotWorth where , "request." ] +instance LiftHandler ErrListPools where + handler = \case + ErrListPoolsNetworkError e -> handler e + ErrListPoolsPastHorizonException e -> handler e + instance LiftHandler ErrTxTooLarge where handler = \case ErrTxTooLarge {tooLargeCurrentSize, tooLargeMaximumSize} -> diff --git a/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs b/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs index 8ec5f62642d..d8a82d9f39d 100644 --- a/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs +++ b/lib/shelley/src/Cardano/Wallet/Shelley/Pools.hs @@ -37,6 +37,8 @@ import Cardano.Pool.DB ( DBLayer (..), ErrPointAlreadyExists (..), readPoolLifeCycleStatus ) import Cardano.Pool.Metadata ( StakePoolMetadataFetchLog ) +import Cardano.Wallet + ( ErrListPools (..) ) import Cardano.Wallet.Api.Types ( ApiT (..) ) import Cardano.Wallet.Network @@ -49,7 +51,13 @@ import Cardano.Wallet.Network , follow ) import Cardano.Wallet.Primitive.Slotting - ( TimeInterpreter, epochOf, epochPred, firstSlotInEpoch, startTime ) + ( PastHorizonException (..) + , TimeInterpreter + , epochOf + , epochPred + , firstSlotInEpoch + , startTime + ) import Cardano.Wallet.Primitive.Types ( ActiveSlotCoefficient (..) , BlockHeader @@ -84,16 +92,20 @@ import Cardano.Wallet.Unsafe ( unsafeMkPercentage ) import Control.Concurrent ( threadDelay ) +import Control.Exception + ( try ) import Control.Monad ( forM, forM_, forever, unless, void, when, (<=<) ) import Control.Monad.IO.Class ( liftIO ) import Control.Monad.Trans.Except - ( ExceptT (..), runExceptT, withExceptT ) + ( ExceptT (..), mapExceptT, runExceptT, throwE, withExceptT ) import Control.Monad.Trans.State ( State, evalState, state ) import Control.Tracer ( Tracer, contramap, traceWith ) +import Data.Bifunctor + ( first ) import Data.Function ( (&) ) import Data.Generics.Internal.VL.Lens @@ -157,7 +169,7 @@ data StakePoolLayer = StakePoolLayer :: EpochNo -- Exclude all pools that retired in or before this epoch. -> Coin - -> ExceptT ErrNetworkUnavailable IO [Api.ApiStakePool] + -> ExceptT ErrListPools IO [Api.ApiStakePool] } newStakePoolLayer @@ -186,17 +198,18 @@ newStakePoolLayer nl db@DBLayer {..} = :: EpochNo -- Exclude all pools that retired in or before this epoch. -> Coin - -> ExceptT ErrNetworkUnavailable IO [Api.ApiStakePool] + -> ExceptT ErrListPools IO [Api.ApiStakePool] _listPools currentEpoch userStake = do tip <- withExceptT fromErrCurrentNodeTip $ currentNodeTip nl - rawLsqData <- stakeDistribution nl tip userStake + rawLsqData <- mapExceptT (fmap (first ErrListPoolsNetworkError)) + $ stakeDistribution nl tip userStake let lsqData = combineLsqData rawLsqData dbData <- liftIO $ readPoolDbData db seed <- liftIO $ atomically readSystemSeed -- TODO: -- Use a more efficient way of filtering out retired pools. -- See: https://jira.iohk.io/projects/ADP/issues/ADP-383 - liftIO $ + r <- liftIO $ try $ sortByReward seed . filter (not . poolIsRetired) . map snd @@ -206,11 +219,18 @@ newStakePoolLayer nl db@DBLayer {..} = (nOpt rawLsqData) lsqData dbData + case r of + Left e@(PastHorizon{}) -> throwE (ErrListPoolsPastHorizonException e) + Right r' -> pure r' + where - fromErrCurrentNodeTip :: ErrCurrentNodeTip -> ErrNetworkUnavailable + + fromErrCurrentNodeTip :: ErrCurrentNodeTip -> ErrListPools fromErrCurrentNodeTip = \case - ErrCurrentNodeTipNetworkUnreachable e -> e - ErrCurrentNodeTipNotFound -> ErrNetworkUnreachable "tip not found" + ErrCurrentNodeTipNetworkUnreachable e -> + ErrListPoolsNetworkError e + ErrCurrentNodeTipNotFound -> + ErrListPoolsNetworkError $ ErrNetworkUnreachable "tip not found" epochIsInFuture :: EpochNo -> Bool epochIsInFuture = (> currentEpoch)