-------------------------------------------------------------------------------
-- network-wait
-- Copyright 2022 Michael B. Gale (github@michael-gale.co.uk)
-------------------------------------------------------------------------------

{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | This module exports variants of the functions from "Network.Wait"
-- specialised for Redis servers. In addition to checking whether a
-- connection can be established, the functions in this module also check
-- whether the Redis server is ready to accept commands using
-- `checkedConnect`. Unlike `checkedConnect`, we don't give up if the
-- connection fails, but instead use the specified retry policy to try again.
-- All functions in this module return the established connection if
-- successful.
module Network.Wait.Redis (
    waitRedis,
    waitRedisVerbose,
    waitRedisVerboseFormat,
    waitRedisWith
) where

-------------------------------------------------------------------------------

import Control.Monad.Catch
import Control.Monad.IO.Class
import Control.Retry

import Database.Redis

import Network.Wait

-------------------------------------------------------------------------------


-- | `waitRedis` @retryPolicy connectInfo@ is a variant of
-- `waitRedisWith` which does not install any additional handlers.
waitRedis
    :: (MonadIO m, MonadMask m)
    => RetryPolicyM m -> ConnectInfo -> m Connection
waitRedis :: RetryPolicyM m -> ConnectInfo -> m Connection
waitRedis = [RetryStatus -> Handler m Bool]
-> RetryPolicyM m -> ConnectInfo -> m Connection
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
[RetryStatus -> Handler m Bool]
-> RetryPolicyM m -> ConnectInfo -> m Connection
waitRedisWith []

-- | `waitRedisVerbose` @outputHandler retryPolicy connectInfo@ is a variant
-- of `waitRedisVerboseFormat` which catches all exceptions derived from
-- `SomeException` and formats retry attempt information using `defaultLogMsg`
-- before passing the resulting `String` to @out@.
waitRedisVerbose
    :: (MonadIO m, MonadMask m)
    => (String -> m ()) -> RetryPolicyM m -> ConnectInfo -> m Connection
waitRedisVerbose :: (String -> m ()) -> RetryPolicyM m -> ConnectInfo -> m Connection
waitRedisVerbose String -> m ()
out =
    forall e (m :: * -> *).
(MonadIO m, MonadMask m, Exception e) =>
(Bool -> e -> RetryStatus -> m ())
-> RetryPolicyM m -> ConnectInfo -> m Connection
forall (m :: * -> *).
(MonadIO m, MonadMask m, Exception SomeException) =>
(Bool -> SomeException -> RetryStatus -> m ())
-> RetryPolicyM m -> ConnectInfo -> m Connection
waitRedisVerboseFormat @SomeException ((Bool -> SomeException -> RetryStatus -> m ())
 -> RetryPolicyM m -> ConnectInfo -> m Connection)
-> (Bool -> SomeException -> RetryStatus -> m ())
-> RetryPolicyM m
-> ConnectInfo
-> m Connection
forall a b. (a -> b) -> a -> b
$
    \Bool
b SomeException
ex RetryStatus
st -> String -> m ()
out (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> SomeException -> RetryStatus -> String
forall e. Exception e => Bool -> e -> RetryStatus -> String
defaultLogMsg Bool
b SomeException
ex RetryStatus
st

-- | `waitRedisVerboseFormat` @outputHandler retryPolicy connectInfo@ is a
-- variant of `waitRedisWith` which installs an extra handler based on
-- `logRetries` which passes status information for each retry attempt
-- to @outputHandler@.
waitRedisVerboseFormat
    :: forall e m . (MonadIO m, MonadMask m, Exception e)
    => (Bool -> e -> RetryStatus -> m ())
    -> RetryPolicyM m
    -> ConnectInfo
    -> m Connection
waitRedisVerboseFormat :: (Bool -> e -> RetryStatus -> m ())
-> RetryPolicyM m -> ConnectInfo -> m Connection
waitRedisVerboseFormat Bool -> e -> RetryStatus -> m ()
out = [RetryStatus -> Handler m Bool]
-> RetryPolicyM m -> ConnectInfo -> m Connection
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
[RetryStatus -> Handler m Bool]
-> RetryPolicyM m -> ConnectInfo -> m Connection
waitRedisWith [RetryStatus -> Handler m Bool
h]
    where h :: RetryStatus -> Handler m Bool
h = (e -> m Bool)
-> (Bool -> e -> RetryStatus -> m ())
-> RetryStatus
-> Handler m Bool
forall (m :: * -> *) e.
(Monad m, Exception e) =>
(e -> m Bool)
-> (Bool -> e -> RetryStatus -> m ())
-> RetryStatus
-> Handler m Bool
logRetries (m Bool -> e -> m Bool
forall a b. a -> b -> a
const (m Bool -> e -> m Bool) -> m Bool -> e -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) Bool -> e -> RetryStatus -> m ()
out

-- | `waitRedisWith` @extraHandlers retryPolicy connectInfo@ will attempt
-- to connect to the Redis server using @connectInfo@ and check that the
-- server is ready to accept commands. If this check fails, @retryPolicy@ is
-- used to determine whether (and how often) this function should attempt to
-- retry establishing the connection. By default, this function will retry
-- after all exceptions (except for those given by `skipAsyncExceptions`).
-- This behaviour may be customised with @extraHandlers@ which are installed
-- after `skipAsyncExceptions`, but before the default exception handler. The
--  @extraHandlers@ may also be used to report retry attempts to e.g. the
-- standard output or a logger.
waitRedisWith
    :: (MonadIO m, MonadMask m)
    => [RetryStatus -> Handler m Bool] -> RetryPolicyM m -> ConnectInfo
    -> m Connection
waitRedisWith :: [RetryStatus -> Handler m Bool]
-> RetryPolicyM m -> ConnectInfo -> m Connection
waitRedisWith [RetryStatus -> Handler m Bool]
hs RetryPolicyM m
policy = [RetryStatus -> Handler m Bool]
-> RetryPolicyM m -> m Connection -> m Connection
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
[RetryStatus -> Handler m Bool] -> RetryPolicyM m -> m a -> m a
recoveringWith [RetryStatus -> Handler m Bool]
hs RetryPolicyM m
policy (m Connection -> m Connection)
-> (ConnectInfo -> m Connection) -> ConnectInfo -> m Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO Connection -> m Connection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection)
-> (ConnectInfo -> IO Connection) -> ConnectInfo -> m Connection
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConnectInfo -> IO Connection
checkedConnect

-------------------------------------------------------------------------------