Skip to content

TLS with each node in cluster mode #226

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
wants to merge 1 commit into
base: master
Choose a base branch
from
Open

TLS with each node in cluster mode #226

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
18 changes: 15 additions & 3 deletions src/Database/Redis/Cluster.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -36,6 +36,7 @@ import System.IO.Unsafe(unsafeInterleaveIO)

import Database.Redis.Protocol(Reply(Error), renderRequest, reply)
import qualified Database.Redis.Cluster.Command as CMD
import Network.TLS (ClientParams (..))

-- This module implements a clustered connection whilst maintaining
-- compatibility with the original Hedis codebase. In particular it still
Expand Down Expand Up @@ -100,8 +101,8 @@ instance Exception UnsupportedClusterCommandException
newtype CrossSlotException = CrossSlotException [[B.ByteString]] deriving (Show, Typeable)
instance Exception CrossSlotException

connect :: [CMD.CommandInfo] -> MVar ShardMap -> Maybe Int -> IO Connection
connect commandInfos shardMapVar timeoutOpt = do
connect :: Maybe ClientParams -> [CMD.CommandInfo] -> MVar ShardMap -> Maybe Int -> IO Connection
connect mTlsParams commandInfos shardMapVar timeoutOpt = do
shardMap <- readMVar shardMapVar
stateVar <- newMVar $ Pending []
pipelineVar <- newMVar $ Pipeline stateVar
Expand All @@ -111,7 +112,18 @@ connect commandInfos shardMapVar timeoutOpt = do
nodeConnections shardMap = HM.fromList <$> mapM connectNode (nub $ nodes shardMap)
connectNode :: Node -> IO (NodeID, NodeConnection)
connectNode (Node n _ host port) = do
ctx <- CC.connect host (CC.PortNumber $ toEnum port) timeoutOpt
ctx0 <- CC.connect host (CC.PortNumber $ toEnum port) timeoutOpt
ctx <- case mTlsParams of
Nothing -> pure ctx0
Just defaultTlsParams -> do
-- The defaultTlsParams are used to connect to the first
-- host in the cluster, other hosts have different
-- hostnames and so require a different server
-- identification params
let tlsParams = defaultTlsParams {
clientServerIdentification = (host, Char8.pack $ show port)
}
CC.enableTLS tlsParams ctx0
ref <- IOR.newIORef Nothing
return (n, NodeConnection ctx ref n)

Expand Down
4 changes: 2 additions & 2 deletions src/Database/Redis/Connection.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -231,9 +231,9 @@ connectCluster bootstrapConnInfo = do
Left e -> throwIO $ ClusterConnectError e
Right infos -> do
#if MIN_VERSION_resource_pool(0,3,0)
pool <- newPool (defaultPoolConfig (Cluster.connect infos shardMapVar Nothing) Cluster.disconnect (realToFrac $ connectMaxIdleTime bootstrapConnInfo) (connectMaxConnections bootstrapConnInfo))
pool <- newPool (defaultPoolConfig (Cluster.connect (connectTLSParams bootstrapConnInfo) infos shardMapVar Nothing) Cluster.disconnect (realToFrac $ connectMaxIdleTime bootstrapConnInfo) (connectMaxConnections bootstrapConnInfo))
#else
pool <- createPool (Cluster.connect infos shardMapVar Nothing) Cluster.disconnect 1 (connectMaxIdleTime bootstrapConnInfo) (connectMaxConnections bootstrapConnInfo)
pool <- createPool (Cluster.connect (connectTLSParams bootstrapConnInfo) infos shardMapVar Nothing) Cluster.disconnect 1 (connectMaxIdleTime bootstrapConnInfo) (connectMaxConnections bootstrapConnInfo)
#endif
return $ ClusteredConnection shardMapVar pool

Expand Down