{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-|
Module      : Database.Memcache.Cluster
Description : Cluster Handling
Copyright   : (c) David Terei, 2016
License     : BSD
Maintainer  : code@davidterei.com
Stability   : stable
Portability : GHC

Handles a group of connections to different Memcached servers.

We use consistent hashing to choose which server to route a request to. On an
error, we mark the server as failed and remove it temporarialy from the set of
servers available.
-}
module Database.Memcache.Cluster (
        -- * Cluster
        Cluster, ServerSpec(..), Options(..), newCluster,

        -- * Operations
        Retries, keyedOp, anyOp, allOp, allOp'
    ) where

import Database.Memcache.Errors
import Database.Memcache.Server
import Database.Memcache.Types

import Control.Concurrent (threadDelay)
import Control.Exception (handle, throwIO, SomeException)
import Data.Default.Class
import Data.Fixed (Milli)
import Data.Hashable (hash)
import Data.IORef
import Data.Maybe (fromMaybe)
import Data.List (sort)
import Data.Time.Clock (NominalDiffTime)
import Data.Time.Clock.POSIX (getPOSIXTime)
import qualified Data.Vector as V
import Network.Socket (HostName, ServiceName)
import System.Timeout

-- | Number of times to retry an operation before considering it failed.
type Retries = Int

-- | ServerSpec specifies a server configuration for connection.
data ServerSpec = ServerSpec {
        -- | Hostname of server to connect to.
        ServerSpec -> HostName
ssHost :: HostName,
        -- | Port number server is running on.
        ServerSpec -> HostName
ssPort :: ServiceName,
        -- | Authentication values to use for SASL authentication with this
        -- server.
        ServerSpec -> Authentication
ssAuth :: Authentication
    } deriving (ServerSpec -> ServerSpec -> Bool
(ServerSpec -> ServerSpec -> Bool)
-> (ServerSpec -> ServerSpec -> Bool) -> Eq ServerSpec
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ServerSpec -> ServerSpec -> Bool
$c/= :: ServerSpec -> ServerSpec -> Bool
== :: ServerSpec -> ServerSpec -> Bool
$c== :: ServerSpec -> ServerSpec -> Bool
Eq, Int -> ServerSpec -> ShowS
[ServerSpec] -> ShowS
ServerSpec -> HostName
(Int -> ServerSpec -> ShowS)
-> (ServerSpec -> HostName)
-> ([ServerSpec] -> ShowS)
-> Show ServerSpec
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [ServerSpec] -> ShowS
$cshowList :: [ServerSpec] -> ShowS
show :: ServerSpec -> HostName
$cshow :: ServerSpec -> HostName
showsPrec :: Int -> ServerSpec -> ShowS
$cshowsPrec :: Int -> ServerSpec -> ShowS
Show)

instance Default ServerSpec where
  def :: ServerSpec
def = HostName -> HostName -> Authentication -> ServerSpec
ServerSpec HostName
"127.0.0.1" HostName
"11211" Authentication
NoAuth

-- | Options specifies how a Memcached cluster should be configured.
data Options = Options {
        -- | Number of times to retry an operation on failure. If consecutive
        -- failures exceed this value for a server, we mark it as down and
        -- failover to a different server for the next operation.
        --
        -- Default is 2.
        Options -> Int
optsServerRetries :: Retries,
        -- | After an operation has failed, how long to wait before retrying it
        -- while still within the 'optsServerRetries' count?
        --
        -- Default is 200ms.
        Options -> Milli
optsFailRetryDelay :: Milli,
        -- | How long to wait after a server has been marked down, before
        -- trying to use it again.
        --
        -- Default is 1500ms.
        Options -> Milli
optsDeadRetryDelay :: Milli,
        -- | How long to wait for an operation to complete before considering
        -- it failed.
        --
        -- Default is 750ms.
        Options -> Milli
optsServerTimeout :: Milli
        -- TODO: socket_timeout
        -- TODO: failover
        -- TODO: expires_in
        -- TODO: namespace
        -- TODO: compress
        -- TODO: compress_min_size
        -- TODO: compress_max_size
        -- TODO: value_max_bytes
    } deriving (Options -> Options -> Bool
(Options -> Options -> Bool)
-> (Options -> Options -> Bool) -> Eq Options
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Options -> Options -> Bool
$c/= :: Options -> Options -> Bool
== :: Options -> Options -> Bool
$c== :: Options -> Options -> Bool
Eq, Int -> Options -> ShowS
[Options] -> ShowS
Options -> HostName
(Int -> Options -> ShowS)
-> (Options -> HostName) -> ([Options] -> ShowS) -> Show Options
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Options] -> ShowS
$cshowList :: [Options] -> ShowS
show :: Options -> HostName
$cshow :: Options -> HostName
showsPrec :: Int -> Options -> ShowS
$cshowsPrec :: Int -> Options -> ShowS
Show)

instance Default Options where
  def :: Options
def = Options :: Int -> Milli -> Milli -> Milli -> Options
Options {
            optsServerRetries :: Int
optsServerRetries  = Int
2,
            optsFailRetryDelay :: Milli
optsFailRetryDelay = Milli
200,
            optsDeadRetryDelay :: Milli
optsDeadRetryDelay = Milli
1500,
            optsServerTimeout :: Milli
optsServerTimeout  = Milli
750
        }

-- | Memcached cluster.
data Cluster = Cluster {
        Cluster -> Vector Server
cServers   :: V.Vector Server,

        -- See 'Options' for description of these values.

        Cluster -> Int
cRetries   :: {-# UNPACK #-} !Int,
        Cluster -> Int
cFailDelay :: {-# UNPACK #-} !Int, -- ^ microseconds
        Cluster -> NominalDiffTime
cDeadDelay :: !NominalDiffTime,
        Cluster -> Int
cTimeout   :: {-# UNPACK #-} !Int -- ^ microseconds
    } deriving (Cluster -> Cluster -> Bool
(Cluster -> Cluster -> Bool)
-> (Cluster -> Cluster -> Bool) -> Eq Cluster
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cluster -> Cluster -> Bool
$c/= :: Cluster -> Cluster -> Bool
== :: Cluster -> Cluster -> Bool
$c== :: Cluster -> Cluster -> Bool
Eq, Int -> Cluster -> ShowS
[Cluster] -> ShowS
Cluster -> HostName
(Int -> Cluster -> ShowS)
-> (Cluster -> HostName) -> ([Cluster] -> ShowS) -> Show Cluster
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Cluster] -> ShowS
$cshowList :: [Cluster] -> ShowS
show :: Cluster -> HostName
$cshow :: Cluster -> HostName
showsPrec :: Int -> Cluster -> ShowS
$cshowsPrec :: Int -> Cluster -> ShowS
Show)

-- | Establish a new connection to a group of Memcached servers.
newCluster :: [ServerSpec] -> Options -> IO Cluster
newCluster :: [ServerSpec] -> Options -> IO Cluster
newCluster []    Options
_ = MemcacheError -> IO Cluster
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO Cluster) -> MemcacheError -> IO Cluster
forall a b. (a -> b) -> a -> b
$ ClientError -> MemcacheError
ClientError ClientError
NoServersReady
newCluster [ServerSpec]
hosts Options{Int
Milli
optsServerTimeout :: Milli
optsDeadRetryDelay :: Milli
optsFailRetryDelay :: Milli
optsServerRetries :: Int
optsServerTimeout :: Options -> Milli
optsDeadRetryDelay :: Options -> Milli
optsFailRetryDelay :: Options -> Milli
optsServerRetries :: Options -> Int
..} = do
    [Server]
s <- (ServerSpec -> IO Server) -> [ServerSpec] -> IO [Server]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\ServerSpec{HostName
Authentication
ssAuth :: Authentication
ssPort :: HostName
ssHost :: HostName
ssAuth :: ServerSpec -> Authentication
ssPort :: ServerSpec -> HostName
ssHost :: ServerSpec -> HostName
..} -> HostName -> HostName -> Authentication -> IO Server
newServer HostName
ssHost HostName
ssPort Authentication
ssAuth) [ServerSpec]
hosts
    Cluster -> IO Cluster
forall (m :: * -> *) a. Monad m => a -> m a
return (Cluster -> IO Cluster) -> Cluster -> IO Cluster
forall a b. (a -> b) -> a -> b
$
        Cluster :: Vector Server -> Int -> Int -> NominalDiffTime -> Int -> Cluster
Cluster {
            cServers :: Vector Server
cServers   = ([Server] -> Vector Server
forall a. [a] -> Vector a
V.fromList ([Server] -> Vector Server) -> [Server] -> Vector Server
forall a b. (a -> b) -> a -> b
$ [Server] -> [Server]
forall a. Ord a => [a] -> [a]
sort [Server]
s),
            cRetries :: Int
cRetries   = Int
optsServerRetries ,
            cFailDelay :: Int
cFailDelay = Milli -> Int
forall a. Enum a => a -> Int
fromEnum Milli
optsFailRetryDelay,
            cDeadDelay :: NominalDiffTime
cDeadDelay = Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime) -> Rational -> NominalDiffTime
forall a b. (a -> b) -> a -> b
$ Milli -> Rational
forall a. Real a => a -> Rational
toRational Milli
optsDeadRetryDelay Rational -> Rational -> Rational
forall a. Fractional a => a -> a -> a
/ Rational
1000,
            cTimeout :: Int
cTimeout   = Milli -> Int
forall a. Enum a => a -> Int
fromEnum Milli
optsServerTimeout 
        }

-- | Check if server is alive.
serverAlive :: NominalDiffTime -> Server -> IO Bool
{-# INLINE serverAlive #-}
serverAlive :: NominalDiffTime -> Server -> IO Bool
serverAlive NominalDiffTime
deadDelay Server
s = do
    NominalDiffTime
t <- IORef NominalDiffTime -> IO NominalDiffTime
forall a. IORef a -> IO a
readIORef (Server -> IORef NominalDiffTime
failed Server
s)
    if NominalDiffTime
t NominalDiffTime -> NominalDiffTime -> Bool
forall a. Eq a => a -> a -> Bool
== NominalDiffTime
0
        then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        else do
            NominalDiffTime
t' <- IO NominalDiffTime
getPOSIXTime
            if (NominalDiffTime
t' NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
- NominalDiffTime
t) NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
deadDelay
                then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                else do
                    IORef NominalDiffTime -> NominalDiffTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server -> IORef NominalDiffTime
failed Server
s) NominalDiffTime
0
                    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True

-- | Figure out which server to talk to for this key. I.e., the distribution
-- method. We use consistent hashing based on the CHORD approach.
getServerForKey :: Cluster -> Key -> IO (Maybe Server)
{-# INLINE getServerForKey #-}
getServerForKey :: Cluster -> Key -> IO (Maybe Server)
getServerForKey Cluster
c Key
k = do
    let hashedKey :: Int
hashedKey = Key -> Int
forall a. Hashable a => a -> Int
hash Key
k
        searchF :: Server -> Bool
searchF Server
s = Server -> Int
sid Server
s Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
hashedKey
    Vector Server
servers' <- (Server -> IO Bool) -> Vector Server -> IO (Vector Server)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM (NominalDiffTime -> Server -> IO Bool
serverAlive (NominalDiffTime -> Server -> IO Bool)
-> NominalDiffTime -> Server -> IO Bool
forall a b. (a -> b) -> a -> b
$ Cluster -> NominalDiffTime
cDeadDelay Cluster
c) (Vector Server -> IO (Vector Server))
-> Vector Server -> IO (Vector Server)
forall a b. (a -> b) -> a -> b
$ Cluster -> Vector Server
cServers Cluster
c
    Maybe Server -> IO (Maybe Server)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Server -> IO (Maybe Server))
-> Maybe Server -> IO (Maybe Server)
forall a b. (a -> b) -> a -> b
$ if Vector Server -> Bool
forall a. Vector a -> Bool
V.null Vector Server
servers'
        then Maybe Server
forall a. Maybe a
Nothing
        else Server -> Maybe Server
forall a. a -> Maybe a
Just (Server -> Maybe Server) -> Server -> Maybe Server
forall a b. (a -> b) -> a -> b
$ Server -> Maybe Server -> Server
forall a. a -> Maybe a -> a
fromMaybe (Vector Server -> Server
forall a. Vector a -> a
V.last Vector Server
servers') ((Server -> Bool) -> Vector Server -> Maybe Server
forall a. (a -> Bool) -> Vector a -> Maybe a
V.find Server -> Bool
searchF Vector Server
servers')

-- | Run a Memcached operation against a particular server, handling any
-- failures that occur, retrying the specified number of times.
serverOp :: Cluster -> Server -> Request -> IO Response
{-# INLINE serverOp #-}
serverOp :: Cluster -> Server -> Request -> IO Response
serverOp Cluster
c Server
s Request
req = Cluster -> Server -> IO Response -> IO Response
forall a. Cluster -> Server -> IO a -> IO a
retryOp Cluster
c Server
s (IO Response -> IO Response) -> IO Response -> IO Response
forall a b. (a -> b) -> a -> b
$ Server -> Request -> IO Response
sendRecv Server
s Request
req

-- | Run a Memcached operation against a particular server, handling any
-- failures that occur, retrying the specified number of times.
keyedOp :: Cluster -> Key -> Request -> IO Response
{-# INLINE keyedOp #-}
keyedOp :: Cluster -> Key -> Request -> IO Response
keyedOp Cluster
c Key
k Request
req = do
    Maybe Server
s' <- Cluster -> Key -> IO (Maybe Server)
getServerForKey Cluster
c Key
k
    case Maybe Server
s' of
        Just Server
s  -> Cluster -> Server -> Request -> IO Response
serverOp Cluster
c Server
s Request
req
        Maybe Server
Nothing -> MemcacheError -> IO Response
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO Response) -> MemcacheError -> IO Response
forall a b. (a -> b) -> a -> b
$ ClientError -> MemcacheError
ClientError ClientError
NoServersReady

-- | Run a Memcached operation against any single server in the cluster,
-- handling any failures that occur, retrying the specified number of times.
anyOp :: Cluster -> Request -> IO Response
{-# INLINE anyOp #-}
anyOp :: Cluster -> Request -> IO Response
anyOp Cluster
c Request
req = do
    Vector Server
servers' <- (Server -> IO Bool) -> Vector Server -> IO (Vector Server)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM (NominalDiffTime -> Server -> IO Bool
serverAlive (NominalDiffTime -> Server -> IO Bool)
-> NominalDiffTime -> Server -> IO Bool
forall a b. (a -> b) -> a -> b
$ Cluster -> NominalDiffTime
cDeadDelay Cluster
c) (Vector Server -> IO (Vector Server))
-> Vector Server -> IO (Vector Server)
forall a b. (a -> b) -> a -> b
$ Cluster -> Vector Server
cServers Cluster
c
    if Vector Server -> Bool
forall a. Vector a -> Bool
V.null Vector Server
servers'
        then MemcacheError -> IO Response
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO Response) -> MemcacheError -> IO Response
forall a b. (a -> b) -> a -> b
$ ClientError -> MemcacheError
ClientError ClientError
NoServersReady
        else Cluster -> Server -> Request -> IO Response
serverOp Cluster
c (Vector Server -> Server
forall a. Vector a -> a
V.head Vector Server
servers') Request
req

-- | Run a Memcached operation against all servers in the cluster, handling any
-- failures that occur, retrying the specified number of times.
allOp :: Cluster -> Request -> IO [(Server, Response)]
{-# INLINE allOp #-}
allOp :: Cluster -> Request -> IO [(Server, Response)]
allOp Cluster
c Request
req = do
    Vector Server
servers' <- (Server -> IO Bool) -> Vector Server -> IO (Vector Server)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM (NominalDiffTime -> Server -> IO Bool
serverAlive (NominalDiffTime -> Server -> IO Bool)
-> NominalDiffTime -> Server -> IO Bool
forall a b. (a -> b) -> a -> b
$ Cluster -> NominalDiffTime
cDeadDelay Cluster
c) (Vector Server -> IO (Vector Server))
-> Vector Server -> IO (Vector Server)
forall a b. (a -> b) -> a -> b
$ Cluster -> Vector Server
cServers Cluster
c
    if Vector Server -> Bool
forall a. Vector a -> Bool
V.null Vector Server
servers'
        then MemcacheError -> IO [(Server, Response)]
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO [(Server, Response)])
-> MemcacheError -> IO [(Server, Response)]
forall a b. (a -> b) -> a -> b
$ ClientError -> MemcacheError
ClientError ClientError
NoServersReady
        else do
            Vector Response
res <- Vector Server -> (Server -> IO Response) -> IO (Vector Response)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector Server
servers' ((Server -> IO Response) -> IO (Vector Response))
-> (Server -> IO Response) -> IO (Vector Response)
forall a b. (a -> b) -> a -> b
$ \Server
s -> Cluster -> Server -> Request -> IO Response
serverOp Cluster
c Server
s Request
req
            [(Server, Response)] -> IO [(Server, Response)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Server, Response)] -> IO [(Server, Response)])
-> [(Server, Response)] -> IO [(Server, Response)]
forall a b. (a -> b) -> a -> b
$ Vector (Server, Response) -> [(Server, Response)]
forall a. Vector a -> [a]
V.toList (Vector (Server, Response) -> [(Server, Response)])
-> Vector (Server, Response) -> [(Server, Response)]
forall a b. (a -> b) -> a -> b
$ Vector Server -> Vector Response -> Vector (Server, Response)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector Server
servers' Vector Response
res

-- | Run a Memcached operation against all servers in the cluster, handling any
-- failures that occur, retrying the specified number of times. Similar to
-- 'anyOp' but allows more flexible interaction with the 'Server' than a single
-- request and response.
allOp' :: Cluster -> (Server -> IO a) -> IO [(Server, a)]
{-# INLINE allOp' #-}
allOp' :: Cluster -> (Server -> IO a) -> IO [(Server, a)]
allOp' Cluster
c Server -> IO a
op = do
    Vector Server
servers' <- (Server -> IO Bool) -> Vector Server -> IO (Vector Server)
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> Vector a -> m (Vector a)
V.filterM (NominalDiffTime -> Server -> IO Bool
serverAlive (NominalDiffTime -> Server -> IO Bool)
-> NominalDiffTime -> Server -> IO Bool
forall a b. (a -> b) -> a -> b
$ Cluster -> NominalDiffTime
cDeadDelay Cluster
c) (Vector Server -> IO (Vector Server))
-> Vector Server -> IO (Vector Server)
forall a b. (a -> b) -> a -> b
$ Cluster -> Vector Server
cServers Cluster
c
    if Vector Server -> Bool
forall a. Vector a -> Bool
V.null Vector Server
servers'
        then MemcacheError -> IO [(Server, a)]
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO [(Server, a)])
-> MemcacheError -> IO [(Server, a)]
forall a b. (a -> b) -> a -> b
$ ClientError -> MemcacheError
ClientError ClientError
NoServersReady
        else do
            Vector a
res <- Vector Server -> (Server -> IO a) -> IO (Vector a)
forall (m :: * -> *) a b.
Monad m =>
Vector a -> (a -> m b) -> m (Vector b)
V.forM Vector Server
servers' ((Server -> IO a) -> IO (Vector a))
-> (Server -> IO a) -> IO (Vector a)
forall a b. (a -> b) -> a -> b
$ \Server
s -> Cluster -> Server -> IO a -> IO a
forall a. Cluster -> Server -> IO a -> IO a
retryOp Cluster
c Server
s (Server -> IO a
op Server
s)
            [(Server, a)] -> IO [(Server, a)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Server, a)] -> IO [(Server, a)])
-> [(Server, a)] -> IO [(Server, a)]
forall a b. (a -> b) -> a -> b
$ Vector (Server, a) -> [(Server, a)]
forall a. Vector a -> [a]
V.toList (Vector (Server, a) -> [(Server, a)])
-> Vector (Server, a) -> [(Server, a)]
forall a b. (a -> b) -> a -> b
$ Vector Server -> Vector a -> Vector (Server, a)
forall a b. Vector a -> Vector b -> Vector (a, b)
V.zip Vector Server
servers' Vector a
res

-- | Run an IO operation multiple times if an exception is thrown, marking the
-- server as dead if it fails more than the allowed number of retries.
retryOp :: forall a. Cluster -> Server -> IO a -> IO a
{-# INLINE retryOp #-}
retryOp :: Cluster -> Server -> IO a -> IO a
retryOp Cluster{Int
NominalDiffTime
Vector Server
cTimeout :: Int
cDeadDelay :: NominalDiffTime
cFailDelay :: Int
cRetries :: Int
cServers :: Vector Server
cTimeout :: Cluster -> Int
cDeadDelay :: Cluster -> NominalDiffTime
cFailDelay :: Cluster -> Int
cRetries :: Cluster -> Int
cServers :: Cluster -> Vector Server
..} Server
s IO a
op = Int -> IO a
go Int
cRetries
  where
    go :: Int -> IO a
    {-# INLINE go #-}
    go :: Int -> IO a
go !Int
n = (SomeException -> IO a) -> IO a -> IO a
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (Int -> SomeException -> IO a
handleErrs (Int -> SomeException -> IO a) -> Int -> SomeException -> IO a
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
        Maybe a
mr <- Int -> IO a -> IO (Maybe a)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
cTimeout IO a
op
        case Maybe a
mr of
            Just a
r  -> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r
            Maybe a
Nothing -> Server -> IO ()
close Server
s IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MemcacheError -> IO a
forall e a. Exception e => e -> IO a
throwIO (ClientError -> MemcacheError
ClientError ClientError
Timeout)

    handleErrs :: Int -> SomeException -> IO a
    {-# INLINE handleErrs #-}
    handleErrs :: Int -> SomeException -> IO a
handleErrs Int
0 SomeException
err = do NominalDiffTime
t <- IO NominalDiffTime
getPOSIXTime
                          IORef NominalDiffTime -> NominalDiffTime -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef (Server -> IORef NominalDiffTime
failed Server
s) NominalDiffTime
t
                          SomeException -> IO a
forall e a. Exception e => e -> IO a
throwIO SomeException
err
    handleErrs Int
n SomeException
_ = do
        Int -> IO ()
threadDelay Int
cFailDelay
        Int -> IO a
go Int
n