Gundeck: Log when connection with redis breaks

services/gundeck/src/Gundeck/Monad.hs

@@ -45,7 +45,6 @@ where
 import Bilge hiding (Request, header, options, statusCode)
 import Bilge.RPC
 import Cassandra
-import Control.Concurrent.Async (async)
 import Control.Error hiding (err)
 import Control.Lens hiding ((.=))
 import Control.Monad.Catch hiding (tryJust)
@@ -61,6 +60,7 @@ import Network.Wai
 import Network.Wai.Utilities
 import qualified System.Logger as Logger
 import System.Logger.Class hiding (Error, info)
+import UnliftIO (async)
 
 -- | TODO: 'Client' already has an 'Env'.  Why do we need two?  How does this even work?  We should
 -- probably explain this here.
@@ -96,13 +96,14 @@ newtype WithDefaultRedis a = WithDefaultRedis {runWithDefaultRedis :: Gundeck a}
       MonadMask,
       MonadReader Env,
       MonadClient,
-      MonadUnliftIO
+      MonadUnliftIO,
+      MonadLogger
     )
 
 instance Redis.MonadRedis WithDefaultRedis where
   liftRedis action = do
     defaultConn <- view rstate
-    liftIO $ Redis.runRobust defaultConn action
+    Redis.runRobust defaultConn action
 
 instance Redis.RedisCtx WithDefaultRedis (Either Redis.Reply) where
   returnDecode :: Redis.RedisResult a => Redis.Reply -> WithDefaultRedis (Either Redis.Reply a)
@@ -131,10 +132,10 @@ newtype WithAdditionalRedis a = WithAdditionalRedis {runWithAdditionalRedis :: G
 instance Redis.MonadRedis WithAdditionalRedis where
   liftRedis action = do
     defaultConn <- view rstate
-    ret <- liftIO $ Redis.runRobust defaultConn action
+    ret <- Redis.runRobust defaultConn action
 
     mAdditionalRedisConn <- view rstateAdditionalWrite
-    liftIO . for_ mAdditionalRedisConn $ \additionalRedisConn ->
+    for_ mAdditionalRedisConn $ \additionalRedisConn ->
       -- We just fire and forget this call, as there is not much we can do if
       -- this fails.
       async $ Redis.runRobust additionalRedisConn action

services/gundeck/src/Gundeck/Redis.hs

@@ -37,6 +37,8 @@ import Control.Retry
 import Database.Redis
 import Imports
 import qualified System.Logger as Log
+import System.Logger.Class (MonadLogger)
+import qualified System.Logger.Class as LogClass
 import System.Logger.Extended
 import UnliftIO.Exception
 
@@ -102,25 +104,30 @@ connectRobust l retryStrategy connectLowLevel = do
       unlessM (tryPutMVar robustConnection newReConnection) $
         void $ swapMVar robustConnection newReConnection
 
+    logEx :: Show e => ((Msg -> Msg) -> IO ()) -> e -> ByteString -> IO ()
+    logEx lLevel e description = lLevel $ Log.msg (Log.val description) . Log.field "error" (show e)
+
 -- | Run a 'Redis' action through a 'RobustConnection'.
 --
 -- Blocks on connection errors as long as the connection is not reestablished.
 -- Without externally enforcing timeouts, this may lead to leaking threads.
-runRobust :: RobustConnection -> Redis a -> IO a
+runRobust :: (MonadIO m, MonadUnliftIO m, MonadLogger m) => RobustConnection -> Redis a -> m a
 runRobust mvar action = do
   robustConnection <- readMVar mvar
   catches
-    (runRedis (_rrConnection robustConnection) action)
-    [ Handler (\(_ :: ConnectionLostException) -> reconnectRetry robustConnection), -- Redis connection lost during request
-      Handler (\(_ :: IOException) -> reconnectRetry robustConnection) -- Redis unreachable
+    (liftIO $ runRedis (_rrConnection robustConnection) action)
+    [ logAndHandle $ Handler (\(_ :: ConnectionLostException) -> reconnectRetry robustConnection), -- Redis connection lost during request
+      logAndHandle $ Handler (\(_ :: IOException) -> reconnectRetry robustConnection) -- Redis unreachable
     ]
   where
     reconnectRetry robustConnection = do
-      _rrReconnect robustConnection
+      liftIO $ _rrReconnect robustConnection
       runRobust mvar action
 
-logEx :: Show e => ((Msg -> Msg) -> IO ()) -> e -> ByteString -> IO ()
-logEx lLevel e description = lLevel $ Log.msg $ Log.val $ description <> ": " <> fromString (show e)
+    logAndHandle (Handler handler) =
+      Handler $ \e -> do
+        LogClass.err $ Log.msg (Log.val "Redis connection failed") . Log.field "error" (show e)
+        handler e
 
 data PingException = PingException Reply deriving (Show)