Skip to content

Commit

Permalink
Add username support in the schema.
Browse files Browse the repository at this point in the history
Username support allows to use ACL feature of redis 6.

Fixes #199.
  • Loading branch information
qnikst committed Jun 1, 2023
1 parent 9930c10 commit c2d2ed3
Show file tree
Hide file tree
Showing 4 changed files with 30 additions and 5 deletions.
10 changes: 8 additions & 2 deletions src/Database/Redis/Connection.hs
Original file line number Diff line number Diff line change
Expand Up @@ -29,7 +29,9 @@ import qualified Database.Redis.ConnectionContext as CC
import Database.Redis.Commands
( ping
, select
, auth
, authOpts
, defaultAuthOpts
, AuthOpts(..)
, clusterSlots
, command
, ClusterSlotsResponse(..)
Expand Down Expand Up @@ -66,6 +68,8 @@ data ConnectInfo = ConnInfo
-- ^ When the server is protected by a password, set 'connectAuth' to 'Just'
-- the password. Each connection will then authenticate by the 'auth'
-- command.
, connectUsername :: Maybe B.ByteString
-- ^ When ACL is used set 'connectUsername' as the user.
, connectDatabase :: Integer
-- ^ Each connection will 'select' the database with the given index.
, connectMaxConnections :: Int
Expand Down Expand Up @@ -96,6 +100,7 @@ instance Exception ConnectError
-- connectHost = \"localhost\"
-- connectPort = PortNumber 6379 -- Redis default port
-- connectAuth = Nothing -- No password
-- connectUsername = Nothing -- No user
-- connectDatabase = 0 -- SELECT database 0
-- connectMaxConnections = 50 -- Up to 50 connections
-- connectMaxIdleTime = 30 -- Keep open for 30 seconds
Expand All @@ -108,6 +113,7 @@ defaultConnectInfo = ConnInfo
{ connectHost = "localhost"
, connectPort = CC.PortNumber 6379
, connectAuth = Nothing
, connectUsername = Nothing
, connectDatabase = 0
, connectMaxConnections = 50
, connectMaxIdleTime = 30
Expand All @@ -130,7 +136,7 @@ createConnection ConnInfo{..} = do
case connectAuth of
Nothing -> return ()
Just pass -> do
resp <- auth pass
resp <- authOpts pass defaultAuthOpts{ authOptsUsername = connectUsername}
case resp of
Left r -> liftIO $ throwIO $ ConnectAuthError r
_ -> return ()
Expand Down
7 changes: 5 additions & 2 deletions src/Database/Redis/URL.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,6 +15,8 @@ import Database.Redis.Connection (ConnectInfo(..), defaultConnectInfo)
import qualified Database.Redis.ConnectionContext as CC
import Network.HTTP.Base
import Network.URI (parseURI, uriPath, uriScheme)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Text.Read (readMaybe)

import qualified Data.ByteString.Char8 as C8
Expand All @@ -24,7 +26,7 @@ import qualified Data.ByteString.Char8 as C8
-- Username is ignored, path is used to specify the database:
--
-- >>> parseConnectInfo "redis://username:password@host:42/2"
-- Right (ConnInfo {connectHost = "host", connectPort = PortNumber 42, connectAuth = Just "password", connectDatabase = 2, connectMaxConnections = 50, connectMaxIdleTime = 30s, connectTimeout = Nothing, connectTLSParams = Nothing})
-- Right (ConnInfo {connectHost = "host", connectPort = PortNumber 42, connectAuth = Just "password",connectUsername=Just "username", connectDatabase = 2, connectMaxConnections = 50, connectMaxIdleTime = 30s, connectTimeout = Nothing, connectTLSParams = Nothing})
--
-- >>> parseConnectInfo "redis://username:password@host:42/db"
-- Left "Invalid port: db"
Expand All @@ -38,7 +40,7 @@ import qualified Data.ByteString.Char8 as C8
-- @'defaultConnectInfo'@:
--
-- >>> parseConnectInfo "redis://"
-- Right (ConnInfo {connectHost = "localhost", connectPort = PortNumber 6379, connectAuth = Nothing, connectDatabase = 0, connectMaxConnections = 50, connectMaxIdleTime = 30s, connectTimeout = Nothing, connectTLSParams = Nothing})
-- Right (ConnInfo {connectHost = "localhost", connectPort = PortNumber 6379, connectAuth = Nothing, connectUsername=Nothing, connectDatabase = 0, connectMaxConnections = 50, connectMaxIdleTime = 30s, connectTimeout = Nothing, connectTLSParams = Nothing})
--
parseConnectInfo :: String -> Either String ConnectInfo
parseConnectInfo url = do
Expand All @@ -61,5 +63,6 @@ parseConnectInfo url = do
else h
, connectPort = maybe (connectPort defaultConnectInfo) (CC.PortNumber . fromIntegral) (port uriAuth)
, connectAuth = C8.pack <$> password uriAuth
, connectUsername = T.encodeUtf8 . T.pack <$> user uriAuth
, connectDatabase = db
}
2 changes: 1 addition & 1 deletion test/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,7 +31,7 @@ testsServer =
,testSlowlog, testDebugObject]

testsConnection :: [Test]
testsConnection = [ testConnectAuth, testConnectAuthUnexpected, testConnectDb
testsConnection = [ testConnectAuth, testConnectAuthUnexpected, testConnectAuthAcl,testConnectDb
, testConnectDbUnexisting, testEcho, testPing, testSelect ]

testsKeys :: [Test]
Expand Down
16 changes: 16 additions & 0 deletions test/Tests.hs
Original file line number Diff line number Diff line change
Expand Up @@ -573,6 +573,22 @@ testConnectAuthUnexpected = testCase "connect/auth/unexpected" $ do
err = Left $ ConnectAuthError $
Error "ERR AUTH <password> called without any password configured for the default user. Are you sure your configuration is correct?"


testConnectAuthAcl :: Test
testConnectAuthAcl = testCase "connect/auth/acl" $ do
liftIO $ do
c <- checkedConnect defaultConnectInfo
runRedis c $ sendRequest ["ACL", "SETUSER", "test", "on", ">pass", "~*", "&*", "+@all"] >>=? Ok
liftIO $ do
c <- checkedConnect defaultConnectInfo{connectAuth=Just "pass", connectUsername=Just "test"}
runRedis c (ping >>=? Pong)
liftIO $ do
res <- try $ void $ checkedConnect defaultConnectInfo{connectAuth=Just "pass", connectUsername=Just "test1"}
HUnit.assertEqual "" err res
where
err = Left $ ConnectAuthError $
Error "WRONGPASS invalid username-password pair or user is disabled."

testConnectDb :: Test
testConnectDb = testCase "connect/db" $ do
set "connect" "value" >>=? Ok
Expand Down

0 comments on commit c2d2ed3

Please sign in to comment.