{- Copyright (c) 2010-2011, Alexander Bogdanov License: MIT -} module Test.GenericCommands where import Test.Setup tests = TList [TLabel "from*" test_unwrap_reply, TLabel "ping and renamed command" test_ping, TLabel "echo" test_echo, TLabel "exists and del" test_exists_del, TLabel "getType" test_get_type, TLabel "keys" test_keys, TLabel "randomKey" test_random_key, TLabel "rename" test_rename, TLabel "renameNx" test_renameNx, TLabel "dbsize" test_dbsize, TLabel "expire" test_expire, TLabel "ttl and persist" test_ttl_persist, TLabel "move" test_move, TLabel "flushDb" test_flushDb, TLabel "flushAll" test_flushAll, TLabel "variadic del" test_variadic_del] test_unwrap_reply = TCase $ const $ let inline = return $ RInline "foo" int = return $ RInt 1 :: IO (Reply String) bulk = return $ RBulk $ Just "foo" mbulk = return $ RMulti $ Just [RBulk (Just "foo"), RBulk Nothing] mbulk' = return $ RMulti Nothing :: IO (Reply String) err = return $ RError "foo" :: IO (Reply String) in do inline >>= fromRInline >>= assertEqual "" "foo" int >>= fromRInt >>= assertEqual "" 1 bulk >>= fromRBulk >>= assertEqual "" (Just "foo") mbulk >>= fromRMulti >>= assertEqual "" (Just [RBulk (Just "foo"), RBulk Nothing]) mbulk' >>= fromRMulti >>= assertEqual "" Nothing mbulk >>= fromRMultiBulk >>= assertEqual "" (Just [Just "foo", Nothing]) mbulk' >>= fromRMultiBulk >>= assertEqual "" Nothing mbulk >>= noError >>= assertEqual "" () assertRaises "" (ErrorCall undefined) (err >>= fromRInline) assertRaises "" (ErrorCall undefined) (inline >>= fromRBulk) test_ping = TCase $ testRedis $ do r <- ask liftIO $ do renameCommand r (toBS "PING") (toBS "P") -- also tests "renamed command" feature repl <- ping r assertEqual "" RPong repl test_echo = TCase $ testRedis $ do r <- ask liftIO $ echo r "foobar" >>= fromRBulk >>= assertEqual "" (Just "foobar") test_exists_del = TCase $ testRedis $ do r <- ask addStr liftIO $ do e <- exists r "foo" >>= fromRInt assertEqual "foo exists" 1 e del r "foo" e <- exists r "foo" >>= fromRInt assertEqual "foo was deleted" 0 e test_get_type = TCase $ testRedis $ do addAll mapM_ (uncurry checkType) [("foo", RTString), ("bar", RTString), ("list", RTList), ("set", RTSet), ("zset", RTZSet), ("hash", RTHash), ("no-such-key", RTNone)] where checkType key t = do r <- ask liftIO $ getType r key >>= assertEqual "" t test_keys = TCase $ testRedis $ do r <- ask addStr addSet addZSet liftIO $ do res <- keys r "nokey" >>= fromRMultiBulk :: IO (Maybe [Maybe String]) assertEqual "There's no key named \"nokey\"" (Just []) res res <- keys r "foo" >>= fromRMultiBulk :: IO (Maybe [Maybe String]) assertEqual "One key named \"foo\"" (Just [Just "foo"]) res res <- keys r "*set" >>= fromRMultiBulk :: IO (Maybe [Maybe String]) assertEqual "set and zset keys selected" (Just [Just "set", Just "zset"]) res -- that seems randomKey always returns the same sequence of keys test_random_key = TCase $ testRedis $ do r <- ask addAll liftIO $ do res <- randomKey r >>= fromRBulk >>= return . fromJust assertOneOf "" ["foo", "bar", "list", "set", "zset", "hash"] res test_rename = TCase $ testRedis $ do r <- ask addStr liftIO $ do exists r "zoo" >>= fromRInt >>= assertEqual "there is no zoo here!" 0 foo <- get r "foo" :: IO (Reply String) rename r "foo" "zoo" >>= fromROk exists r "foo" >>= fromRInt >>= assertEqual "foo was renamed to zoo" 0 exists r "zoo" >>= fromRInt >>= assertEqual "foo was renamed to zoo" 1 get r "zoo" >>= assertEqual "" foo test_renameNx = TCase $ testRedis $ do r <- ask addStr liftIO $ do renameNx r "foo" "bar" >>= fromRInt >>= assertEqual "" 0 exists r "foo" >>= fromRInt >>= assertEqual "" 1 test_dbsize = TCase $ testRedis $ do r <- ask addStr liftIO $ do res <- dbsize r >>= fromRInt real <- (keys r "*" :: IO (Reply String)) >>= fromRMultiBulk >>= return . length . fromJust assertEqual "" real res test_expire = TCase $ testRedis $ do r <- ask addStr liftIO $ do expire r "foo" 0 >>= fromRInt >>= assertEqual "" 1 threadDelay 10 exists r "foo" >>= fromRInt >>= assertEqual "foo has to be expired now" 0 TOD now _ <- getClockTime expireAt r "bar" $ fromIntegral now threadDelay 10 exists r "bar" >>= fromRInt >>= assertEqual "bar has to be expired now" 0 test_ttl_persist = TCase $ testRedis $ do r <- ask addStr liftIO $ do ttl r "foo" >>= fromRInt >>= assertEqual "" (-1) expire r "foo" 30 >>= noError ttl r "foo" >>= fromRInt >>= assertBool "TTL is greater then expiration timeout" . (<= 30) persist r "foo" >>= noError ttl r "foo" >>= fromRInt >>= assertEqual "foo was persisted again" (-1) test_move = TCase $ \opts -> flip testRedis opts $ do r <- ask addStr liftIO $ do exists r "foo" >>= fromRInt >>= assertEqual "foo has to be in first database" 1 move r "foo" $ (optDatabase opts) + 1 exists r "foo" >>= fromRInt >>= assertEqual "now foo is in second database" 0 select r $ (optDatabase opts) + 1 exists r "foo" >>= fromRInt >>= assertEqual "now foo is in second database" 1 move r "foo" $ optDatabase opts select r $ optDatabase opts return () test_flushDb = TCase $ testRedis $ do r <- ask liftIO $ do select r 1 set r "leave_it_alone" "hooray!" select r 0 flushDb r dbsize r >>= fromRInt >>= assertEqual "first database was flushed" 0 select r 1 dbsize r >>= fromRInt >>= assertEqual "but not the second one" 1 test_flushAll = TCase $ testRedis $ do r <- ask liftIO $ do select r 1 set r "baz" "no way" select r 0 flushAll r dbsize r >>= fromRInt >>= assertEqual "first database was flushed" 0 select r 1 dbsize r >>= fromRInt >>= assertEqual "and the second database too" 0 test_variadic_del = TCase $ testRedis $ do r <- ask liftIO $ do mSet r [("a", "a"), ("b", "b"), ("c", "c")] del_ r ["a", "c"] >>= fromRInt >>= assertEqual "" 2 Just k <- keys r "*" >>= fromRMultiBulk assertEqual "" [Just "b"] k