hedis 0.9.12 → 0.10.0

raw patch · 9 files changed

+173/−13 lines, 9 filesdep +HTTPdep +doctestdep +errorsdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: HTTP, doctest, errors, network-uri

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG +7/−0
• DocTest.hs +6/−0
• hedis.cabal +14/−3
• src/Database/Redis.hs +4/−3
• src/Database/Redis/Commands.hs +2/−1
• src/Database/Redis/Core.hs +22/−4
• src/Database/Redis/ManualCommands.hs +9/−1
• src/Database/Redis/URL.hs +64/−0
• test/Test.hs +45/−1

@@ -1,5 +1,12 @@ # Changelog for Hedis +## 0.10.0++* PR #102. Return list from srandmemberN+* PR #103. Add spopN+* PR #101. Add parseConnectInfo+* PR #100, Issue #99. Throw error when AUTH or SELECT fails on connect+ ## 0.9.12  * PR #98. Added `connectTimeout` option

@@ -0,0 +1,6 @@+module Main (main) where++import Test.DocTest++main :: IO ()+main = doctest ["-isrc", "src"]

@@ -1,5 +1,5 @@ name:               hedis-version:            0.9.12+version:            0.10.0 synopsis:     Client library for the Redis datastore: supports full command set,     pipelining.@@ -78,7 +78,10 @@                     resource-pool >= 0.2,                     stm,                     time,-                    vector >= 0.9+                    vector >= 0.9,+                    HTTP,+                    errors,+                    network-uri    other-modules:    Database.Redis.Core,                     Database.Redis.ProtocolPipelining,@@ -87,7 +90,8 @@                     Database.Redis.Transactions,                     Database.Redis.Types                     Database.Redis.Commands,-                    Database.Redis.ManualCommands+                    Database.Redis.ManualCommands,+                    Database.Redis.URL  benchmark hedis-benchmark     type: exitcode-stdio-1.0@@ -127,3 +131,10 @@       ghc-options: -Werror     if flag(dev)       ghc-prof-options: -auto-all++test-suite doctest+    type: exitcode-stdio-1.0+    main-is: DocTest.hs+    build-depends:+        base == 4.*,+        doctest

@@ -142,9 +142,9 @@     RedisCtx(..), MonadRedis(..),      -- * Connection-    Connection, connect, checkedConnect,-    ConnectInfo(..),defaultConnectInfo,-    HostName,PortID(..),+    Connection, ConnectError(..), connect, checkedConnect,+    ConnectInfo(..), defaultConnectInfo, parseConnectInfo,+    HostName, PortID(..),          -- * Commands     module Database.Redis.Commands,@@ -178,5 +178,6 @@     (HostName, PortID(..), ConnectionLostException(..)) import Database.Redis.Transactions import Database.Redis.Types+import Database.Redis.URL  import Database.Redis.Commands

@@ -144,7 +144,8 @@ sismember, -- |Determine if a given value is a member of a set (<http://redis.io/commands/sismember>). Since Redis 1.0.0 smembers, -- |Get all the members in a set (<http://redis.io/commands/smembers>). Since Redis 1.0.0 smove, -- |Move a member from one set to another (<http://redis.io/commands/smove>). Since Redis 1.0.0-spop, -- |Remove and return one or multiple random members from a set (<http://redis.io/commands/spop>). Since Redis 1.0.0+spop, -- |Remove and return one or multiple random members from a set (<http://redis.io/commands/spop>). The Redis command @SPOP@ is split up into 'spop', 'spopN'. Since Redis 1.0.0+spopN, -- |Remove and return one or multiple random members from a set (<http://redis.io/commands/spop>). The Redis command @SPOP@ is split up into 'spop', 'spopN'. Since Redis 1.0.0 srandmember, -- |Get one or multiple random members from a set (<http://redis.io/commands/srandmember>). The Redis command @SRANDMEMBER@ is split up into 'srandmember', 'srandmemberN'. Since Redis 1.0.0 srandmemberN, -- |Get one or multiple random members from a set (<http://redis.io/commands/srandmember>). The Redis command @SRANDMEMBER@ is split up into 'srandmember', 'srandmemberN'. Since Redis 1.0.0 srem, -- |Remove one or more members from a set (<http://redis.io/commands/srem>). Since Redis 1.0.0

@@ -1,8 +1,9 @@ {-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, RecordWildCards,-    MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP #-}+    MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP,+    DeriveDataTypeable #-}  module Database.Redis.Core (-    Connection(..), connect, checkedConnect,+    Connection(..), ConnectError(..), connect, checkedConnect,     ConnectInfo(..), defaultConnectInfo,     Redis(), runRedis, unRedis, reRedis,     RedisCtx(..), MonadRedis(..),@@ -14,11 +15,13 @@ #if __GLASGOW_HASKELL__ < 710 import Control.Applicative #endif+import Control.Exception import Control.Monad.Reader import qualified Data.ByteString as B import Data.IORef import Data.Pool import Data.Time+import Data.Typeable import Network  import Database.Redis.Protocol@@ -172,6 +175,12 @@     --   get connected in this interval of time.     } deriving Show +data ConnectError = ConnectAuthError Reply+                  | ConnectSelectError Reply+    deriving (Eq, Show, Typeable)++instance Exception ConnectError+ -- |Default information for connecting: -- -- @@@ -181,6 +190,7 @@ --  connectDatabase       = 0               -- SELECT database 0 --  connectMaxConnections = 50              -- Up to 50 connections --  connectMaxIdleTime    = 30              -- Keep open for 30 seconds+--  connectTimeout        = Nothing         -- Don't add timeout logic -- @ -- defaultConnectInfo :: ConnectInfo@@ -209,9 +219,17 @@             -- AUTH             case connectAuth of                 Nothing   -> return ()-                Just pass -> void $ auth pass+                Just pass -> do+                  resp <- auth pass+                  case resp of+                    Left r -> liftIO $ throwIO $ ConnectAuthError r+                    _      -> return ()             -- SELECT-            when (connectDatabase /= 0) (void $ select connectDatabase)+            when (connectDatabase /= 0) $ do+              resp <- select connectDatabase+              case resp of+                  Left r -> liftIO $ throwIO $ ConnectSelectError r+                  _      -> return ()         return conn      destroy = PP.disconnect

@@ -609,7 +609,7 @@     :: (RedisCtx m f)     => ByteString -- ^ key     -> Integer -- ^ count-    -> m (f (Maybe ByteString))+    -> m (f [ByteString]) srandmemberN key count = sendRequest ["SRANDMEMBER", key, encode count]  @@ -618,6 +618,14 @@     => ByteString -- ^ key     -> m (f (Maybe ByteString)) spop key = sendRequest ["SPOP", key]+++spopN+    :: (RedisCtx m f)+    => ByteString -- ^ key+    -> Integer -- ^ count+    -> m (f [ByteString])+spopN key count = sendRequest ["SPOP", key, encode count]   info

@@ -0,0 +1,64 @@+{-# LANGUAGE CPP #-}+module Database.Redis.URL+    ( parseConnectInfo+    ) where++#if __GLASGOW_HASKELL__ < 710+import Control.Applicative ((<$>))+#endif+import Control.Error.Util (note)+import Control.Monad (guard)+import Data.Monoid ((<>))+import Database.Redis.Core (ConnectInfo(..), defaultConnectInfo)+import Database.Redis.ProtocolPipelining (PortID(..))+import Network.HTTP.Base+import Network.URI (parseURI, uriPath, uriScheme)+import Text.Read (readMaybe)++import qualified Data.ByteString.Char8 as C8++-- | Parse a @'ConnectInfo'@ from a URL+--+-- 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})+--+-- >>> parseConnectInfo "redis://username:password@host:42/db"+-- Left "Invalid port: db"+--+-- The scheme is validated, to prevent mixing up configurations:+--+-- >>> parseConnectInfo "postgres://"+-- Left "Wrong scheme"+--+-- Beyond that, all values are optional. Omitted values are taken from+-- @'defaultConnectInfo'@:+--+-- >>> parseConnectInfo "redis://"+-- Right (ConnInfo {connectHost = "localhost", connectPort = PortNumber 6379, connectAuth = Nothing, connectDatabase = 0, connectMaxConnections = 50, connectMaxIdleTime = 30s, connectTimeout = Nothing})+--+parseConnectInfo :: String -> Either String ConnectInfo+parseConnectInfo url = do+    uri <- note "Invalid URI" $ parseURI url+    note "Wrong scheme" $ guard $ uriScheme uri == "redis:"+    uriAuth <- note "Missing or invalid Authority"+        $ parseURIAuthority+        $ uriToAuthorityString uri++    let h = host uriAuth+        dbNumPart = dropWhile (== '/') (uriPath uri)++    db <- if null dbNumPart+      then return $ connectDatabase defaultConnectInfo+      else note ("Invalid port: " <> dbNumPart) $ readMaybe dbNumPart++    return defaultConnectInfo+        { connectHost = if null h+            then connectHost defaultConnectInfo+            else h+        , connectPort = maybe (connectPort defaultConnectInfo)+            (PortNumber . fromIntegral) $ port uriAuth+        , connectAuth = C8.pack <$> password uriAuth+        , connectDatabase = db+        }

@@ -5,9 +5,11 @@ import Control.Applicative import Data.Monoid (mappend) #endif+import Control.Exception (try) import Control.Concurrent import Control.Monad import Control.Monad.Trans+import qualified Data.List as L import Data.Time import Data.Time.Clock.POSIX import SlaveThread (fork)@@ -303,6 +305,10 @@     spop "set"                  >>=? Just "member"     srem "set" ["member"]       >>=? 0     smove "set" "set'" "member" >>=? False+    _ <- sadd "set" ["member1", "member2"]+    (fmap L.sort <$> spopN "set" 2) >>=? ["member1", "member2"]+    _ <- sadd "set" ["member1", "member2"]+    (fmap L.sort <$> srandmemberN "set" 2) >>=? ["member1", "member2"]  testSetAlgebra :: Test testSetAlgebra = testCase "set algebra" $ do@@ -456,7 +462,45 @@ -- Connection -- testsConnection :: [Test]-testsConnection = [ testEcho, testPing, testSelect ]+testsConnection = [ testConnectAuth, testConnectAuthUnexpected, testConnectDb+                  , testConnectDbUnexisting, testEcho, testPing, testSelect ]++testConnectAuth :: Test+testConnectAuth = testCase "connect/auth" $ do+    configSet "requirepass" "pass" >>=? Ok+    liftIO $ do+        c <- checkedConnect defaultConnectInfo { connectAuth = Just "pass" }+        runRedis c (ping >>=? Pong)+    auth "pass"                    >>=? Ok+    configSet "requirepass" ""     >>=? Ok++testConnectAuthUnexpected :: Test+testConnectAuthUnexpected = testCase "connect/auth/unexpected" $ do+    liftIO $ do+        res <- try $ void $ checkedConnect connInfo+        HUnit.assertEqual "" err res++    where connInfo = defaultConnectInfo { connectAuth = Just "pass" }+          err = Left $ ConnectAuthError $+                  Error "ERR Client sent AUTH, but no password is set"++testConnectDb :: Test+testConnectDb = testCase "connect/db" $ do+    set "connect" "value" >>=? Ok+    liftIO $ void $ do+        c <- checkedConnect defaultConnectInfo { connectDatabase = 1 }+        runRedis c (get "connect" >>=? Nothing)++testConnectDbUnexisting :: Test+testConnectDbUnexisting = testCase "connect/db/unexisting" $ do+    liftIO $ do+        res <- try $ void $ checkedConnect connInfo+        case res of+          Left (ConnectSelectError _) -> return ()+          _ -> HUnit.assertFailure $+                  "Expected ConnectSelectError, got " ++ show res++    where connInfo = defaultConnectInfo { connectDatabase = 100 }  testEcho :: Test testEcho = testCase "echo" $