Skip to content

Establish connection on any random IP address if DNS resolves multiple IP address #52

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
Rishabh7896 wants to merge 2 commits into
base: master
Choose a base branch
from
Open

Establish connection on any random IP address if DNS resolves multiple IP address #52

Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
c555a19
fixed connection to redis when clustered
rgtmjp Aug 20, 2024
900b26a
fixed running when i=0
rgtmjp Aug 20, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
23 changes: 16 additions & 7 deletions src/Database/Redis/ConnectionContext.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -22,6 +22,7 @@ import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as LB
import qualified Data.IORef as IOR
import qualified Data.Time as Time
import Data.List (drop, length, take)
import Data.Maybe (fromMaybe)
import Control.Concurrent.MVar(newMVar, readMVar, swapMVar)
import Control.Exception(bracketOnError, Exception, throwIO, try)
Expand All @@ -34,6 +35,7 @@ import System.IO(Handle, hSetBinaryMode, hClose, IOMode(..), hFlush, hIsOpen)
import System.IO.Error(catchIOError)
import Text.Read (readMaybe)
import System.Timeout (timeout)
import System.Random (randomRIO)

data ConnectionContext = NormalHandle Handle | TLSContext TLS.Context

Expand Down Expand Up @@ -109,21 +111,28 @@ errConnectTimeout phase = throwIO $ ConnectTimeout phase

connectSocket :: [NS.AddrInfo] -> IO NS.Socket
connectSocket [] = error "connectSocket: unexpected empty list"
connectSocket (addr:rest) = tryConnect >>= \case
Right sock -> return sock
Left err -> if null rest
then throwIO err
else connectSocket rest
connectSocket addrs = do
(addr, rest) <- pickRandomAddr
sockM <- tryConnect addr
case (sockM, rest) of
(Right sock, _) -> return sock
(Left err, []) -> throwIO err
(Left _err, _) -> connectSocket rest
where
tryConnect :: IO (Either IOError NS.Socket)
tryConnect = bracketOnError createSock NS.close $ \sock ->
tryConnect :: NS.AddrInfo -> IO (Either IOError NS.Socket)
tryConnect addr = bracketOnError createSock NS.close $ \sock ->
try (NS.connect sock $ NS.addrAddress addr) >>= \case
Right () -> return (Right sock)
Left err -> NS.close sock >> return (Left err)
where
createSock = NS.socket (NS.addrFamily addr)
(NS.addrSocketType addr)
(NS.addrProtocol addr)
pickRandomAddr = do
i <- randomRIO (0, length addrs - 1)
let front = take (if i<2 then 0 else i-1) addrs
back = drop (i+1) addrs
pure (addrs !! i, front ++ back)

send :: ConnectionContext -> B.ByteString -> IO ()
send (NormalHandle h) requestData =
Expand Down