Fix listWallets race condition

lib/core/cardano-wallet-core.cabal

@@ -81,6 +81,7 @@ library
     , random-shuffle
     , retry
     , safe
+    , safe-exceptions
     , scientific
     , scrypt
     , servant

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

@@ -332,21 +332,25 @@ import Control.Arrow
 import Control.Concurrent
     ( threadDelay )
 import Control.Concurrent.Async
-    ( race_ )
+    ( race_, withAsync )
+import Control.DeepSeq
+    ( NFData, deepseq, ($!!) )
 import Control.Exception
-    ( IOException, bracket, throwIO, try, tryJust )
+    ( IOException, SomeException, bracket, evaluate, throwIO, tryJust )
+import Control.Exception.Safe
+    ( tryAnyDeep )
 import Control.Monad
-    ( forM, forever, void, when, (>=>) )
+    ( forM, forever, join, void, when, (>=>) )
 import Control.Monad.Catch
-    ( handle )
+    ( MonadCatch, catch, handle, try )
 import Control.Monad.IO.Class
     ( MonadIO, liftIO )
 import Control.Monad.Trans.Class
     ( lift )
 import Control.Monad.Trans.Except
     ( ExceptT (..), runExceptT, throwE, withExceptT )
 import Control.Monad.Trans.Maybe
-    ( MaybeT (..) )
+    ( MaybeT (..), exceptToMaybeT )
 import Control.Tracer
     ( Tracer )
 import Data.Aeson
@@ -357,6 +361,8 @@ import Data.ByteString
     ( ByteString )
 import Data.Coerce
     ( coerce )
+import Data.Either.Extra
+    ( eitherToMaybe )
 import Data.Function
     ( (&) )
 import Data.Functor
@@ -372,7 +378,7 @@ import Data.List.NonEmpty
 import Data.Map.Strict
     ( Map )
 import Data.Maybe
-    ( fromMaybe, isJust )
+    ( catMaybes, fromMaybe, isJust )
 import Data.Proxy
     ( Proxy (..) )
 import Data.Quantity
@@ -1046,16 +1052,27 @@ getWallet ctx mkApiWallet (ApiT wid) = do
 listWallets
     :: forall ctx s t k apiWallet.
         ( ctx ~ ApiLayer s t k
+        , NFData apiWallet
+        , Show apiWallet
         )
     => ctx
     -> MkApiWallet ctx s apiWallet
     -> Handler [(apiWallet, UTCTime)]
 listWallets ctx mkApiWallet = do
     wids <- liftIO $ listDatabases df
-    sortOn snd <$> mapM (getWallet ctx mkApiWallet) (ApiT <$> wids)
+    liftIO $ sortOn snd . catMaybes <$> mapM maybeGetWallet (ApiT <$> wids)
   where
     df = ctx ^. dbFactory @s @k
 
+    -- Under extreme circumstances (like integration tests running in parallel)
+    -- there may be race conditions where the wallet is deleted just before we
+    -- try to read it.
+    --
+    -- ... or not?
+    maybeGetWallet :: ApiT WalletId -> IO (Maybe (apiWallet, UTCTime))
+    maybeGetWallet =
+        fmap (join . eitherToMaybe) . tryAnyDeep . fmap eitherToMaybe . runHandler . getWallet ctx mkApiWallet
+
 putWallet
     :: forall ctx s t k apiWallet.
         ( ctx ~ ApiLayer s t k