Return descriptive 503 when listing stake pools with uncomplete sync

lib/core/src/Cardano/Wallet.hs

@@ -172,6 +172,9 @@ module Cardano.Wallet
 
     -- * Logging
     , WalletLog (..)
+
+    -- * Stake pool listing
+    , ErrListPools (..)
     ) where
 
 import Prelude hiding
@@ -2354,6 +2357,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
 -------------------------------------------------------------------------------}

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

@@ -109,6 +109,7 @@ import Cardano.Wallet
     , ErrImportAddress (..)
     , ErrImportRandomAddress (..)
     , ErrJoinStakePool (..)
+    , ErrListPools (..)
     , ErrListTransactions (..)
     , ErrListUTxOStatistics (..)
     , ErrMkTx (..)
@@ -314,7 +315,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
@@ -422,6 +423,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
@@ -1587,17 +1589,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)
@@ -2019,6 +2024,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
@@ -2504,6 +2510,11 @@ instance LiftHandler ErrWithdrawalNotWorth where
                 , "request."
                 ]
 
+instance LiftHandler ErrListPools where
+    handler = \case
+        ErrListPoolsNetworkError e -> handler e
+        ErrListPoolsPastHorizonException e -> handler e
+
 instance LiftHandler (Request, ServerError) where
     handler (req, err@(ServerError code _ body headers))
       | not (isJSON body) = case code of

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)