{-# LANGUAGE CPP, OverloadedStrings, RecordWildCards, LambdaCase, OverloadedLists, TypeApplications #-}
module Tests where


#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
import Data.Monoid (mappend)
#endif
import qualified Control.Concurrent.Async as Async
import Control.Exception (try)
import Control.Concurrent
import Control.Monad
import Control.Monad.Trans
import Control.Monad.Trans.Except
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as Char8
import Data.Either (isRight)
import qualified Data.List as L
import qualified Data.List.NonEmpty as NE
import Data.Time
import Data.Time.Clock.POSIX
import qualified Test.Framework as Test (Test)
import qualified Test.Framework.Providers.HUnit as Test (testCase)
import qualified Test.HUnit as HUnit
import qualified Test.HUnit.Lang as HUnit.Lang
import Network.Socket (PortNumber)

import Database.Redis
import Data.Either (fromRight)

------------------------------------------------------------------------------
-- helpers
--
type Test = Connection -> Test.Test

testCase :: String -> Redis () -> Test
testCase name r conn = Test.testCase name $ do
    withTimeLimit 0.5 $ runRedis conn $ flushdb >>=? Ok >> r
  where
    withTimeLimit limit act = do
        start <- getCurrentTime
        _ <- act
        deltaT <-fmap (`diffUTCTime` start) getCurrentTime
        when (deltaT > limit) $
            putStrLn $ name ++ ": " ++ show deltaT

(>>=?) :: (Eq a, Show a) => Redis (Either Reply a) -> a -> Redis ()
redis >>=? expected = redis >>@? (expected HUnit.@=?)

(>>@?) :: (Eq a, Show a) => Redis (Either Reply a) -> (a -> HUnit.Assertion) -> Redis ()
redis >>@? predicate = do
    a <- redis
    liftIO $ case a of
        Left reply -> HUnit.assertFailure $ "Redis error: " ++ show reply
        Right actual -> predicate actual

(<|?>) :: HUnit.Assertion -> HUnit.Assertion -> HUnit.Assertion
a <|?> b = do
    resultA <- HUnit.Lang.performTestCase a
    case resultA of
        HUnit.Lang.Success        -> a
        HUnit.Lang.Failure _ errA -> tryB errA
        HUnit.Lang.Error   _ errA -> tryB errA
        where tryB errA = do
                        resultB <- HUnit.Lang.performTestCase b
                        case resultB of
                            HUnit.Lang.Success        -> b
                            HUnit.Lang.Failure _ errB -> concatErrors errA errB
                            HUnit.Lang.Error   _ errB -> concatErrors errA errB
              concatErrors errA errB = HUnit.Lang.assertFailure ("{" ++ errA ++ "\nOR\n" ++ errB ++ "\n}: Failed")


assert :: Bool -> Redis ()
assert = liftIO . HUnit.assert

isUnknownCommandReply :: Reply -> Bool
isUnknownCommandReply (Error message) = "unknown command" `BS.isInfixOf` message
isUnknownCommandReply _ = False

isHotkeysInactiveReply :: Reply -> Bool
isHotkeysInactiveReply (Error message) =
    "not currently active" `BS.isInfixOf` message || "tracking is not active" `BS.isInfixOf` message
isHotkeysInactiveReply (Bulk Nothing) = True
isHotkeysInactiveReply _ = False

------------------------------------------------------------------------------
-- Miscellaneous
--
testsMisc :: [Test]
testsMisc =
    [ testConstantSpacePipelining, testForceErrorReply, testPipelining
    , testEvalReplies, testGeo, testWaitCommands
    ]

testConstantSpacePipelining :: Test
testConstantSpacePipelining = testCase "constant-space pipelining" $ do
    -- This testcase should not exceed the maximum heap size, as set in
    -- the run-test.sh script.
    replicateM_ 100000 ping
    -- If the program didn't crash, pipelining takes constant memory.
    assert True

testForceErrorReply :: Test
testForceErrorReply = testCase "force error reply" $ do
    set "key" "value" >>= \case
      Left _ -> error "impossible"
      _ -> return ()
    -- key is not a hash -> wrong kind of value
    reply <- hkeys "key"
    assert $ case reply of
        Left (Error _) -> True
        _              -> False

testPipelining :: Test
testPipelining = testCase "pipelining" $ do
    let n = 100
    tPipe <- deltaT $ do
        pongs <- replicateM n ping
        assert $ pongs == replicate n (Right Pong)

    tNoPipe <- deltaT $ replicateM_ n (ping >>=? Pong)
    -- pipelining should at least be twice as fast.
    assert $ tNoPipe / tPipe > 2
  where
    deltaT redis = do
        start <- liftIO $ getCurrentTime
        _ <- redis
        liftIO $ fmap (`diffUTCTime` start) getCurrentTime

testEvalReplies :: Test
testEvalReplies conn = testCase "eval unused replies" go conn
  where
    go = do
      _ <- liftIO $ runRedis conn $ set "key-12" "value"
      result <- liftIO $ do
         threadDelay $ 10 ^ (5 :: Int)
         mvar <- newEmptyMVar
         _ <-
           (Async.wait =<< Async.async (runRedis conn (get "key-12"))) >>= putMVar mvar
         takeMVar mvar
      pure result >>=? Just "value"

testGeo :: Test
testGeo = testCase "geo" $ do
    geoadd "{geo}cities" [(13.361389, 38.115556, "Palermo"), (15.087269, 37.502669, "Catania")] >>=? 2
    geoaddOpts "{geo}cities"
        [(13.361389, 38.115556, "Palermo"), (12.496366, 41.902782, "Rome")]
        defaultGeoAddOpts { geoAddCondition = Just Nx, geoAddChange = True } >>=? 1
    geodist "{geo}cities" "Palermo" "Rome" (Just GeoKilometers) >>@? \actual ->
        case actual of
            Just dist -> HUnit.assertBool "Rome should have been inserted by GEOADD NX" (dist > 400)
            Nothing -> HUnit.assertFailure "GEODIST Palermo Rome returned Nothing"
    geoaddOpts "{geo}cities"
        [(9.1900, 45.4642, "Milan")]
        defaultGeoAddOpts { geoAddCondition = Just Xx } >>=? 0

    geodist "{geo}cities" "Palermo" "Catania" Nothing >>@? \actual ->
        case actual of
            Just dist -> HUnit.assertBool "unexpected GEODIST distance in meters" (abs (dist - 166274.1516) < 1000)
            Nothing -> HUnit.assertFailure "GEODIST returned Nothing"

    geopos "{geo}cities" ["Palermo", "Catania"] >>@? \positions ->
        case positions of
            [Just palermo, Just catania] -> do
                assertApprox "Palermo longitude" 13.361389 (geoLongitude palermo)
                assertApprox "Palermo latitude" 38.115556 (geoLatitude palermo)
                assertApprox "Catania longitude" 15.087269 (geoLongitude catania)
                assertApprox "Catania latitude" 37.502669 (geoLatitude catania)
            _ -> HUnit.assertFailure $ "Unexpected GEOPOS response: " ++ show positions

    let searchOpts = defaultGeoSearchOpts
            { geoSearchWithDist = True
            , geoSearchOrder = Just GeoAsc
            }

    geoSearch "{geo}cities" (GeoSearchFromMember "Palermo") (GeoSearchByRadius 200 GeoKilometers) searchOpts >>@? \locations ->
        case locations of
            [palermo, catania] -> do
                HUnit.assertEqual "GEOSEARCH center member" "Palermo" (geoLocationMember palermo)
                HUnit.assertBool "GEOSEARCH distance should be zero for center member" (maybe False (< 0.001) (geoLocationDist palermo))
                HUnit.assertEqual "GEOSEARCH second member" "Catania" (geoLocationMember catania)
            _ -> HUnit.assertFailure $ "Unexpected GEOSEARCH response: " ++ show locations

    geoSearchStore "{geo}near" "{geo}cities" (GeoSearchFromLonLat 15 37) (GeoSearchByRadius 200 GeoKilometers)
        (defaultGeoSearchStoreOpts { geoSearchStoreStoredist = True }) >>=? 2

    zrangeWithscores "{geo}near" 0 (-1) >>@? \members ->
        case members of
            [(firstCity, firstDistance), (secondCity, secondDistance)] -> do
                HUnit.assertEqual "closest stored city" "Catania" firstCity
                HUnit.assertEqual "second stored city" "Palermo" secondCity
                HUnit.assertBool "stored distances should be increasing" (firstDistance < secondDistance)
            _ -> HUnit.assertFailure $ "Unexpected GEOSEARCHSTORE response: " ++ show members
  where
    assertApprox label expected actual =
        HUnit.assertBool label (abs (expected - actual) < 0.0001)

testWaitCommands :: Test
testWaitCommands = testCase "wait commands" $ do
    set "wait:key" "value" >>=? Ok
    wait 0 0 >>=? 0

    waitaofResult <- waitaof 0 0 0
    liftIO $ case waitaofResult of
        Right result -> WaitAofResult 0 0 HUnit.@=? result
        Left reply | isUnknownCommandReply reply -> pure ()
        Left reply -> HUnit.assertFailure $ "Unexpected WAITAOF reply: " ++ show reply

------------------------------------------------------------------------------
-- Keys
--
testKeys :: Test
testKeys = testCase "keys" $ do
    set "{same}key" "value"     >>=? Ok
    get "{same}key"             >>=? Just "value"
    exists "{same}key"          >>=? True
    expire "{same}key" 1        >>=? True
    pexpire "{same}key" 1000    >>=? True
    ttl "{same}key" >>= \case
      Left _ -> error "error"
      Right t -> do
        assert $ elem @[] t [0..1]
        pttl "{same}key" >>= \case
          Left _ -> error "error"
          Right pt -> do
            assert $ elem @[] pt [990..1000]
            persist "{same}key"         >>=? True
            dump "{same}key" >>= \case
              Left _ -> error "impossible"
              Right s -> do
                restore "{same}key'" 0 s          >>=? Ok
                rename "{same}key" "{same}key'"   >>=? Ok
                renamenx "{same}key'" "{same}key" >>=? True
                del (NE.fromList ["{same}key"])   >>=? 1

testCopy :: Test
testCopy = testCase "copy" $ do
    set "dolly" "sheep" >>=? Ok
    copy "dolly" "clone" >>=? True
    get "clone" >>=? Just "sheep"
    copy "dolly" "clone" >>=? False
    copyOpts "dolly" "clone" defaultCopyOpts { copyReplace = True } >>=? True

testKeysNoncluster :: Test
testKeysNoncluster = testCase "keysNoncluster" $ do
    set "key" "value"     >>=? Ok
    keys "*"              >>=? ["key"]
    randomkey             >>=? Just "key"
    move "key" 13         >>=? True
    select 13             >>=? Ok
    get "key"             >>=? Just "value"
    select 0              >>=? Ok

testExpireAt :: Test
testExpireAt = testCase "expireat" $ do
    set "key" "value"             >>=? Ok
    t <- ceiling . utcTimeToPOSIXSeconds <$> liftIO getCurrentTime
    let expiry = t+1
    expireat "key" expiry         >>=? True
    pexpireat "key" (expiry*1000) >>=? True

testSort :: Test
testSort = testCase "sort" $ do
    lpush "ids"     ["1","2","3"]                >>=? 3
    sort "ids" defaultSortOpts                   >>=? ["1","2","3"]
    sortStore "ids" "anotherKey" defaultSortOpts >>=? 3
    mset
         [("weight_1","1")
         ,("weight_2","2")
         ,("weight_3","3")
         ,("object_1","foo")
         ,("object_2","bar")
         ,("object_3","baz")
         ] >>= \case
      Left _ -> error "error"
      _ -> return ()
    let opts = defaultSortOpts { sortOrder = Desc, sortAlpha = True
                               , sortLimit = (1,2)
                               , sortBy    = Just "weight_*"
                               , sortGet   = ["#", "object_*"] }
    sort "ids" opts >>=? ["2", "bar", "1", "foo"]


testGetType :: Test
testGetType = testCase "getType" $ do
    getType "key"     >>=? None
    forM_ @[] ts $ \(setKey, typ) -> do
        setKey
        getType "key" >>=? typ
        del (NE.fromList ["key"])   >>=? 1
  where
    ts = [ (set "key" "value"                         >>=? Ok,   String)
         , (hset "key" [("field"::ByteString, "value"::ByteString)] >>=? 1,    Hash)
         , (lpush "key" ["value"]                     >>=? 1,    List)
         , (sadd "key" ["member"]                     >>=? 1,    Set)
         , (zadd "key" [(42,"member"),(12.3,"value")] >>=? 2,    ZSet)
         ]

testObject :: Test
testObject = testCase "object" $ do
    set "key" "value"    >>=? Ok
    objectRefcount "key" >>=? 1
    objectEncoding "key" >>= \case
       Left _ -> error "error"
       _ -> return ()
    objectIdletime "key" >>=? 0
    return ()

------------------------------------------------------------------------------
-- Strings
--
testsStrings :: [Test]
testsStrings = [testStrings, testStringCommands6, testBitops]

testStrings :: Test
testStrings = testCase "strings" $ do
    setnx "key" "value"                           >>=? True
    getset "key" "hello"                          >>=? Just "value"
    append "key" "world"                          >>=? 10
    strlen "key"                                  >>=? 10
    setrange "key" 0 "hello"                      >>=? 10
    getrange "key" 0 4                            >>=? "hello"
    substr "key" 0 4                              >>=? "hello"
    mset [("{same}k1","v1"), ("{same}k2","v2")]   >>=? Ok
    msetnx [("{same}k1","v1"), ("{same}k2","v2")] >>=? False
    mget ["key"]                                  >>=? [Just "helloworld"]
    setex "key" 1 "42"                            >>=? Ok
    psetex "key" 1000 "42"                        >>=? Ok
    decr "key"                                    >>=? 41
    decrby "key" 1                                >>=? 40
    incr "key"                                    >>=? 41
    incrby "key" 1                                >>=? 42
    incrbyfloat "key" 1                           >>=? 43
    del (NE.fromList ["key"])                     >>=? 1
    setbit "key" 42 "1"                           >>=? 0
    getbit "key" 42                               >>=? 1
    bitcount "key"                                >>=? 1
    bitcountRange "key" 0 (-1)                    >>=? 1

testStringCommands6 :: Test
testStringCommands6 = testCase "strings redis 6" $ do
    set "mykey" "Hello" >>=? Ok
    getdel "mykey" >>=? Just "Hello"
    get "mykey" >>=? Nothing
    set "mykey" "Hello" >>=? Ok
    getexOpts "mykey" defaultGetExOpts { getExSeconds = Just 10 } >>=? Just "Hello"
    ttl "mykey" >>@? \value ->
        HUnit.assertBool "GETEX should set ttl" (value >= 0 && value <= 10)

testStringCommands84 :: Test
testStringCommands84 = testCase "strings redis 8.4" $ do
    set "digest-key" "Hello world" >>=? Ok
    digest "digest-key" >>=? Just "b6acb9d84a38ff74"
    delexWhen "digest-key" (DelexIfEq "Goodbye") >>=? False
    get "digest-key" >>=? Just "Hello world"
    digest "digest-key" >>= \case
        Left reply -> liftIO $ HUnit.assertFailure $ "Redis error: " ++ show reply
        Right (Just digestValue) -> do
            delexWhen "digest-key" (DelexIfDigestEq digestValue) >>=? True
            get "digest-key" >>=? Nothing
        Right Nothing -> liftIO $ HUnit.assertFailure "DIGEST should return a digest for an existing string key"

    msetexOpts (("k1", "v1") NE.:| [("k2", "v2")]) defaultSetOpts { setSeconds = Just 60 } >>=? True
    mget ["k1", "k2"] >>=? [Just "v1", Just "v2"]
    ttl "k1" >>@? \value ->
        HUnit.assertBool "MSETEX should set ttl" (value >= 0 && value <= 60)

    msetexOpts (("k1", "new-v1") NE.:| [("k3", "v3")]) defaultSetOpts { setCondition = Just Nx } >>=? False
    get "k1" >>=? Just "v1"
    get "k3" >>=? Nothing

    msetexOpts (("k1", "new-v1") NE.:| [("k2", "new-v2")]) defaultSetOpts { setCondition = Just Xx } >>=? True
    mget ["k1", "k2"] >>=? [Just "new-v1", Just "new-v2"]

testBitops :: Test
testBitops = testCase "bitops" $ do
    set "{same}k1" "a"                           >>=? Ok
    set "{same}k2" "b"                           >>=? Ok
    bitopAnd "{same}k3" ["{same}k1", "{same}k2"] >>=? 1
    bitopOr "{same}k3" ["{same}k1", "{same}k2"]  >>=? 1
    bitopXor "{same}k3" ["{same}k1", "{same}k2"] >>=? 1
    bitopNot "{same}k3" "{same}k1"               >>=? 1

------------------------------------------------------------------------------
-- Hashes
--
testHashes :: Test
testHashes = testCase "hashes" $ do
    hset "key" [("field"::ByteString, "another"::ByteString)] >>=? 1
    hset "key" [("field"::ByteString, "another"::ByteString)] >>=? 0
    hset "key" [("field"::ByteString, "value"::ByteString)]   >>=? 0
    hsetnx "key" "field" "value" >>=? False
    hexists "key" "field"        >>=? True
    hlen "key"                   >>=? 1
    hget "key" "field"           >>=? Just "value"
    hmget "key" ["field", "-"]   >>=? [Just "value", Nothing]
    hgetall "key"                >>=? [("field","value")]
    hkeys "key"                  >>=? ["field"]
    hvals "key"                  >>=? ["value"]
    hdel "key" ["field"]         >>=? 1
    hmset "key" [("field","40")] >>=? Ok
    hincrby "key" "field" 2      >>=? 42
    hincrbyfloat "key" "field" 2 >>=? 44
    hset "coin" [("heads","obverse"),("tails","reverse"),("edge","null")] >>=? 3
    hrandfield "coin" >>@? \field ->
        HUnit.assertBool "HRANDFIELD should return an existing field" (field `elem` ([Just "heads", Just "tails", Just "edge"] :: [Maybe ByteString]))
    hrandfieldCount "coin" 2 >>@? \fields -> do
        HUnit.assertEqual "HRANDFIELD count" 2 (length fields)
        HUnit.assertBool "HRANDFIELD count should return distinct fields" (fields == L.nub fields)
        HUnit.assertBool "HRANDFIELD count should return existing fields" (all (`elem` (["heads", "tails", "edge"] :: [ByteString])) fields)
    hrandfieldCountWithValues "coin" 2 >>@? \fields -> do
        HUnit.assertEqual "HRANDFIELD WITHVALUES count" 2 (length fields)
        HUnit.assertBool "HRANDFIELD WITHVALUES should return existing field/value pairs" $
            all (`elem` ([("heads", "obverse"), ("tails", "reverse"), ("edge", "null")] :: [(ByteString, ByteString)])) fields

testHashes8 :: Test
testHashes8 = testCase "hashes redis 8" $ do
    hsetexOpts "myhash" (("field1", "Hello") NE.:| [("field2", "World")])
        defaultHSetExOpts { hSetExSeconds = Just 60 }
        >>=? True
    httl "myhash" ["field1"] >>@? \case
        (HashFieldExpirationInfo value:_) ->
           HUnit.assertBool ("HSETEX should set ttl: " <> show value) (value >= 0 && value <= 60)
        x -> HUnit.assertFailure $ "HTTL should return field expiration info for field1" <> show x

    hgetexOpts "myhash" ("field1" NE.:| ["field2", "missing"])
        defaultHGetExOpts { hGetExPersist = True }
        >>=? [Just "Hello", Just "World", Nothing]
    ttl "myhash" >>=? (-1)

    hgetdel "myhash" ("field1" NE.:| ["field2", "missing"])
        >>=? [Just "Hello", Just "World", Nothing]
    hgetall "myhash" >>=? []

    hsetexOpts "myhash" (("field1", "Hello") NE.:| [])
        defaultHSetExOpts { hSetExCondition = Just HSetExFnx }
        >>=? True
    hsetexOpts "myhash" (("field1", "World") NE.:| [])
        defaultHSetExOpts { hSetExCondition = Just HSetExFnx }
        >>=? False
    hsetexOpts "myhash" (("field1", "World") NE.:| [])
        defaultHSetExOpts { hSetExCondition = Just HSetExFxx }
        >>=? True
    hget "myhash" "field1" >>=? Just "World"

------------------------------------------------------------------------------
-- Lists
--
testsLists :: [Test]
testsLists =
    [testLists, testListCommands6, testBpop]

testLists :: Test
testLists = testCase "lists" $ do
    lpushx "notAKey" ["-" :: ByteString] >>=? 0
    rpushx "notAKey" ["-" :: ByteString] >>=? 0
    lpush "key" ["value"]         >>=? 1
    lpop "key"                    >>=? Just "value"
    rpush "key" ["value"]         >>=? 1
    rpop "key"                    >>=? Just "value"
    rpush "key" ["v2"]            >>=? 1
    linsertBefore "key" "v2" "v1" >>=? 2
    linsertAfter "key" "v2" "v3"  >>=? 3
    lindex "key" 0                >>=? Just "v1"
    lrange "key" 0 (-1)           >>=? ["v1", "v2", "v3"]
    lset "key" 1 "v2"             >>=? Ok
    lrem "key" 0 "v2"             >>=? 1
    llen "key"                    >>=? 2
    ltrim "key" 0 1               >>=? Ok
    del ("key" NE.:| [])
    -- keys are pushed sequentially so this will result in a list with value1, value2, value3
    lpush "key" ["value3", "value2", "value1"] >>=? 3
    lpopCount "key" 2 >>=? ["value1", "value2"]
    lpush "key" ["value2", "value1"] >>=? 3
    rpopCount "key" 2 >>=? ["value3", "value2"]
    del ("key" NE.:| [])
    lpush "key" ["value3", "value2", "value1"] >>=? 3
    lpopCount "key" 4 >>=? ["value1", "value2", "value3"]
    del ("key" NE.:| [])
    return ()

testListCommands6 :: Test
testListCommands6 = testCase "lists redis 6" $ do
    rpush "mylist" ["a", "b", "c", "d", "1", "2", "3", "4", "3", "3", "3"] >>=? 11
    lpos "mylist" "3" >>=? Just 6
    lposCount "mylist" "3" 0 >>=? [6, 8, 9, 10]
    lposOpts "mylist" "3" defaultLPosOpts { lposRank = Just 2 } >>=? Just 8

    rpush "{same}src" ["one", "two", "three"] >>=? 3
    lmove "{same}src" "{same}dst" ListLeft ListRight >>=? Just "one"
    lrange "{same}src" 0 (-1) >>=? ["two", "three"]
    lrange "{same}dst" 0 (-1) >>=? ["one"]

    rpush "{same}src2" ["one", "two", "three"] >>=? 3
    blmove "{same}src2" "{same}dst2" ListRight ListLeft 1 >>=? Just "three"
    lrange "{same}src2" 0 (-1) >>=? ["one", "two"]
    lrange "{same}dst2" 0 (-1) >>=? ["three"]

testBpop :: Test
testBpop = testCase "blocking push/pop" $ do
    lpush "{same}key" ["v3","v2","v1"] >>=? 3
    blpop ["{same}key"] 1              >>=? Just ("{same}key","v1")
    brpop ["{same}key"] 1              >>=? Just ("{same}key","v3")
    rpush "{same}k1" ["v1","v2"]       >>=? 2
    brpoplpush "{same}k1" "{same}k2" 1 >>=? Just "v2"
    rpoplpush "{same}k1" "{same}k2"    >>=? Just "v1"

------------------------------------------------------------------------------
-- Sets
--
testsSets :: [Test]
testsSets = [testSets, testSMIsMember, testSetAlgebra]

testSets :: Test
testSets = testCase "sets" $ do
    sadd "set" (NE.fromList  ["member"]) >>=? 1
    sismember "set" "member"    >>=? True
    scard "set"                 >>=? 1
    smembers "set"              >>=? ["member"]
    srandmember "set"           >>=? Just "member"
    spop "set"                  >>=? Just "member"
    srem "set" (NE.fromList ["member"]) >>=? 0
    smove "{same}set" "{same}set'" "member" >>=? False
    _ <- sadd "set" (NE.fromList ["member1", "member2"])
    (fmap L.sort <$> spopN "set" 2) >>=? ["member1", "member2"]
    _ <- sadd "set" (NE.fromList ["member1", "member2"])
    (fmap L.sort <$> srandmemberN "set" 2) >>=? ["member1", "member2"]

testSMIsMember :: Test
testSMIsMember = testCase "smismember" $ do
    sadd "myset" (NE.fromList ["one"]) >>=? 1
    smismember "myset" ("one" NE.:| ["notamember"]) >>=? [True, False]

testSetAlgebra :: Test
testSetAlgebra = testCase "set algebra" $ do
    sadd "{same}s1" (NE.fromList ["member"])        >>=? 1
    sdiff ["{same}s1", "{same}s2"]                  >>=? ["member"]
    sunion ["{same}s1", "{same}s2"]                 >>=? ["member"]
    sinter ["{same}s1", "{same}s2"]                 >>=? []
    sdiffstore "{same}s3" ["{same}s1", "{same}s2"]  >>=? 1
    sunionstore "{same}s3" ["{same}s1", "{same}s2"] >>=? 1
    sinterstore "{same}s3" ["{same}s1", "{same}s2"] >>=? 0

------------------------------------------------------------------------------
-- Sorted Sets
--
testsZSets :: [Test]
testsZSets = [testZSets, testSortedSetCommands6, testZStore]

testZSets :: Test
testZSets = testCase "sorted sets" $ do
    zadd "key" [(1,"v1"),(2,"v2"),(40,"v3")]          >>=? 3
    zcard "key"                                       >>=? 3
    zscore "key" "v3"                                 >>=? Just 40
    zincrby "key" 2 "v3"                              >>=? 42

    zrank "key" "v1"                                  >>=? Just 0
    zrevrank "key" "v1"                               >>=? Just 2
    zcount "key" 10 100                               >>=? 1

    zrange "key" 0 1                                  >>=? ["v1","v2"]
    zrevrange "key" 0 1                               >>=? ["v3","v2"]
    zrangeWithscores "key" 0 1                        >>=? [("v1",1),("v2",2)]
    zrevrangeWithscores "key" 0 1                     >>=? [("v3",42),("v2",2)]
    zrangebyscore "key" 0.5 1.5                       >>=? ["v1"]
    zrangebyscoreWithscores "key" 0.5 1.5             >>=? [("v1",1)]
    zrangebyscoreWithscores "key" (-inf) inf          >>=? [("v1",1.0),("v2",2.0),("v3",42.0)]
    zrangebyscoreLimit "key" 0.5 2.5 0 1              >>=? ["v1"]
    zrangebyscoreWithscoresLimit "key" 0.5 2.5 0 1    >>=? [("v1",1)]
    zrevrangebyscore "key" 1.5 0.5                    >>=? ["v1"]
    zrevrangebyscoreWithscores "key" 1.5 0.5          >>=? [("v1",1)]
    zrevrangebyscoreLimit "key" 2.5 0.5 0 1           >>=? ["v2"]
    zrevrangebyscoreWithscoresLimit "key" 2.5 0.5 0 1 >>=? [("v2",2)]

    zrem "key" (NE.fromList ["v2"])                   >>=? 1
    zremrangebyscore "key" 10 100                     >>=? 1
    zremrangebyrank "key" 0 0                         >>=? 1

testSortedSetCommands6 :: Test
testSortedSetCommands6 = testCase "sorted sets redis 6" $ do
    zadd "{same}zset1" [(1, "one"), (2, "two"), (3, "three")] >>=? 3
    zadd "{same}zset2" [(1, "one"), (2, "two")] >>=? 2

    zdiff ("{same}zset1" NE.:| ["{same}zset2"]) >>=? ["three"]
    zdiffWithscores ("{same}zset1" NE.:| ["{same}zset2"]) >>=? [("three", 3)]
    zdiffstore "{same}out" ("{same}zset1" NE.:| ["{same}zset2"]) >>=? 1
    zrangeWithscores "{same}out" 0 (-1) >>=? [("three", 3)]

    zinter ("{same}zset1" NE.:| ["{same}zset2"]) >>=? ["one", "two"]
    zinterWithscores ("{same}zset1" NE.:| ["{same}zset2"]) >>=? [("one", 2), ("two", 4)]
    zinterWithscoresOpts ("{same}zset1" NE.:| ["{same}zset2"])
        defaultZAggregateOpts { zAggregateWeights = [2, 3], zAggregateAggregate = Max }
        >>=? [("one", 3), ("two", 6)]

    zunion ("{same}zset1" NE.:| ["{same}zset2"]) >>=? ["one", "three", "two"]
    zunionWithscores ("{same}zset1" NE.:| ["{same}zset2"]) >>=? [("one", 2), ("three", 3), ("two", 4)]
    zmscore "{same}zset1" ("one" NE.:| ["notamember"]) >>=? [Just 1, Nothing]

    zrandmember "{same}zset1" >>@? \member ->
        HUnit.assertBool "ZRANDMEMBER should return an existing member" (member `elem` ([Just "one", Just "two", Just "three"] :: [Maybe ByteString]))
    zrandmemberN "{same}zset1" 2 >>@? \members -> do
        HUnit.assertEqual "ZRANDMEMBER count" 2 (length members)
        HUnit.assertBool "ZRANDMEMBER count should return existing members" (all (`elem` (["one", "two", "three"] :: [ByteString])) members)
    zrandmemberWithscores "{same}zset1" 2 >>@? \members -> do
        HUnit.assertEqual "ZRANDMEMBER WITHSCORES count" 2 (length members)
        HUnit.assertBool "ZRANDMEMBER WITHSCORES should return valid pairs" $
            all (`elem` ([("one", 1), ("two", 2), ("three", 3)] :: [(ByteString, Double)])) members

    zrangestore "{same}newzset" "{same}zset1" 2 (-1) >>=? 1
    zrange "{same}newzset" 0 (-1) >>=? ["three"]

--  testZSets7 :: Test
--  testZSets7 = testCase "sorted sets: redis 7" $ do
--      zadd "key" [(2,"v1"),(0,"v2"),(40,"v3")]          >>=? 3
--      zrankWithScore "key" "v1"                         >>=? Just  (1, 2)

testZStore :: Test
testZStore = testCase "zunionstore/zinterstore" $ do
    zadd "{same}k1" [(1, "v1"), (2, "v2")] >>= \case
      Left _ -> error "error"
      _ -> return ()
    zadd "{same}k2" [(2, "v2"), (3, "v3")] >>= \case
      Left _ -> error "error"
      _ -> return ()
    zinterstore "{same}newkey" ["{same}k1","{same}k2"] Sum                >>=? 1
    zinterstoreWeights "{same}newkey" [("{same}k1",1),("{same}k2",2)] Max >>=? 1
    zunionstore "{same}newkey" ["{same}k1","{same}k2"] Sum                >>=? 3
    zunionstoreWeights "{same}newkey" [("{same}k1",1),("{same}k2",2)] Min >>=? 3

------------------------------------------------------------------------------
-- HyperLogLog
--

testHyperLogLog :: Test
testHyperLogLog = testCase "hyperloglog" $ do
  -- test creation
  pfadd "hll1" ["a"] >>= \case
      Left _ -> error "error"
      _ -> return ()
  pfcount ["hll1"] >>=? 1
  -- test cardinality
  pfadd "hll1" ["a"] >>= \case
      Left _ -> error "error"
      _ -> return ()
  pfcount ["hll1"] >>=? 1
  pfadd "hll1" ["b", "c", "foo", "bar"] >>= \case
      Left _ -> error "error"
      _ -> return ()
  pfcount ["hll1"] >>=? 5
  -- test merge
  pfadd "{same}hll2" ["1", "2", "3"] >>= \case
      Left _ -> error "error"
      _ -> return ()
  pfadd "{same}hll3" ["4", "5", "6"] >>= \case
      Left _ -> error "error"
      _ -> return ()
  pfmerge "{same}hll4" ["{same}hll2", "{same}hll3"] >>= \case
      Left _ -> error "error"
      _ -> return ()
  pfcount ["{same}hll4"] >>=? 6
  -- test union cardinality
  pfcount ["{same}hll2", "{same}hll3"] >>=? 6

------------------------------------------------------------------------------
-- Bloom Filters
--
testBloomFilter :: Test
testBloomFilter = testCase "bloom filter" $ do
    liftIO $ putStrLn "Testing bloom filter with default parameters..."
    bfadd "bf1" "observation1" >>=? True
    liftIO $ putStrLn "Testing bloom filter info commands..."
    bfinfoSize "bf1" >>=? [240]
    liftIO $ putStrLn "Testing bloom filter info commands with error handling..."
    Right [infoSize] <- bfinfoSize "bf1"
    liftIO $ putStrLn $ "Bloom filter info: " ++ show infoSize
    bfinfo "bf1" >>=? BFInfo
        { bfInfoCapacity = 100
        , bfInfoSize = infoSize
        , bfInfoFilters = 1
        , bfInfoItems = 1
        , bfInfoExpansion = 2
        }
    bfinfoCapacity "bf1" >>=? [100]
    bfinfoFilters "bf1" >>=? [1]
    bfinfoItems "bf1" >>=? [1]
    bfinfoExpansion "bf1" >>=? [Just 2]
    bfcard "bf1" >>=? 1
    bfcard "bf_new" >>=? 0


    liftIO $ putStrLn "Testing bloom filter with custom parameters..."

    bfreserve "bf" 0.01 1000 >>=? Ok
    bfadd "bf" "item1" >>=? True
    bfexists "bf" "item1" >>=? True
    bfexists "bf" "item2" >>=? False

    liftIO $ putStrLn "Testing bloom filter multi-item commands..."

    bfmadd "bfm" ("item1" NE.:| ["item2", "item2"]) >>=? [True, True, False]
    bfmexists "bfm" ("item1" NE.:| ["item2", "item3"]) >>=? [True, True, False]

    liftIO $ putStrLn "Testing bloom filter insert commands with custom parameters..."

    bfinsert "bfi" ("item1" NE.:| ["item2"]) >>=? [True, True]
    bfinsertOpts "bf_insert" ("item1" NE.:| ["item2"]) defaultBFInsertOpts
        { bfInsertCapacity = Just 1000
        , bfInsertError = Just 0.01
        , bfInsertExpansion = Just 3
        , bfInsertNonScaling = True
        } >>=? [True, True]


    bfinfoCapacity "bf_insert" >>=? [1000]
    bfinfoExpansion "bf_insert" >>=? [Nothing]

    bfinsertOpts "bf_insert1" ("item1" NE.:| ["item2"]) defaultBFInsertOpts
        { bfInsertCapacity = Just 1000
        , bfInsertError = Just 0.01
        , bfInsertExpansion = Just 4
        , bfInsertNonScaling = False
        } >>=? [True, True]
    bfinfoExpansion "bf_insert1" >>=? [Just 4]


    bfreserveOpts "bf_exp" 0.01 1000 defaultBFReserveOpts
        { bfReserveExpansion = Just 2
        } >>=? Ok
    bfinfoExpansion "bf_exp" >>=? [Just 2]


    bfreserve "bfdump" 0.1 10 >>=? Ok
    bfadd "bfdump" "item1" >>=? True

-- Count-Min Sketches
--
testCountMinSketch :: Test
testCountMinSketch = testCase "count-min sketch" $ do
    cmsinitbydim "cms1" 20 5 >>=? Ok
    cmsinfo "cms1" >>=? CMSInfo
        { cmsInfoWidth = 20
        , cmsInfoDepth = 5
        , cmsInfoCount = 0
        }

    cmsincrby "cms1" (("foo", 2) NE.:| [("bar", 3), ("foo", 4)]) >>=? [2, 3, 6]
    cmsquery "cms1" ("foo" NE.:| ["bar", "baz"]) >>=? [6, 3, 0]
    cmsinfo "cms1" >>=? CMSInfo
        { cmsInfoWidth = 20
        , cmsInfoDepth = 5
        , cmsInfoCount = 9
        }

    cmsinitbyprob "cms2" 0.001 0.99 >>=? Ok
    cmsquery "cms2" ("foo" NE.:| ["bar"]) >>=? [0, 0]
    cmsincrby "cms2" (("foo", 7) NE.:| [("bar", 1)]) >>=? [7, 1]
    cmsinfo "cms2" >>@? \CMSInfo{..} -> do
        HUnit.assertBool "cms2 width should be positive" (cmsInfoWidth > 0)
        HUnit.assertBool "cms2 depth should be positive" (cmsInfoDepth > 0)
        8 HUnit.@=? cmsInfoCount

    cmsinitbydim "cms3" 20 5 >>=? Ok
    cmsincrby "cms3" (("foo", 7) NE.:| [("bar", 1)]) >>=? [7, 1]

    cmsinitbydim "cms_merged" 20 5 >>=? Ok
    cmsmerge "cms_merged" ("cms1" NE.:| ["cms3"]) >>=? Ok
    cmsquery "cms_merged" ("foo" NE.:| ["bar", "baz"]) >>=? [13, 4, 0]

    cmsinitbydim "cms_weighted" 20 5 >>=? Ok
    cmsmergeWeighted "cms_weighted" (("cms1", 1) NE.:| [("cms3", 2)]) >>=? Ok
    cmsquery "cms_weighted" ("foo" NE.:| ["bar", "baz"]) >>=? [20, 5, 0]

-- Top-K
--
testTopk :: Test
testTopk = testCase "topk" $ do
    topkReserve "topk1" 3 50 5 0.9 >>=? Ok
    topkInfo "topk1" >>=? TopkInfo
        { topkInfoK = 3
        , topkInfoWidth = 50
        , topkInfoDepth = 5
        , topkInfoDecay = 0.9
        }

    topkAdd "topk1" ("foo" NE.:| ["bar", "baz"]) >>=? [Nothing, Nothing, Nothing]
    topkQuery "topk1" ("foo" NE.:| ["bar", "missing"]) >>=? [True, True, False]
    topkCount "topk1" ("foo" NE.:| ["bar", "missing"]) >>@? \counts ->
        case counts of
            [fooCount, barCount, 0] -> do
                HUnit.assertBool "TOPK.COUNT foo should be positive" (fooCount > 0)
                HUnit.assertBool "TOPK.COUNT bar should be positive" (barCount > 0)
            _ -> HUnit.assertFailure $ "Unexpected TOPK.COUNT response: " ++ show counts

    topkIncrby "topk1" (("foo", 10) NE.:| [("baz", 3), ("qux", 1)]) >>@? \results ->
        HUnit.assertEqual "TOPK.INCRBY result length" 3 (length results)

    topkList "topk1" >>@? \items -> do
        HUnit.assertEqual "TOPK.LIST length" 3 (length items)
        HUnit.assertBool "TOPK.LIST should include foo" ("foo" `elem` items)

    topkListWithCount "topk1" >>@? \itemsWithCount -> do
        HUnit.assertEqual "TOPK.LIST WITHCOUNT length" 3 (length itemsWithCount)
        let itemKeys = map fst itemsWithCount
        HUnit.assertBool "TOPK.LIST WITHCOUNT should include foo" ("foo" `elem` itemKeys)
        HUnit.assertBool "TOPK.LIST WITHCOUNT counts should be positive" (all ((> 0) . snd) itemsWithCount)

-- T-Digest
--
testTdigest :: Test
testTdigest = testCase "tdigest" $ do
    tdigestCreate "td1" >>=? Ok
    tdigestAdd "td1" (1 NE.:| [2, 3, 4, 5]) >>=? Ok

    tdigestMin "td1" >>=? 1
    tdigestMax "td1" >>=? 5
    tdigestByrank "td1" (0 NE.:| [2, 4]) >>@? \values ->
        case values of
            [v0, v2, v4] -> do
                HUnit.assertEqual "TDIGEST.BYRANK 0" 1 v0
                HUnit.assertBool "TDIGEST.BYRANK 2 should be within range" (v2 >= 2 && v2 <= 4)
                HUnit.assertEqual "TDIGEST.BYRANK 4" 5 v4
            _ -> HUnit.assertFailure $ "Unexpected TDIGEST.BYRANK response: " ++ show values
    tdigestByrevrank "td1" (0 NE.:| [2, 4]) >>@? \values ->
        case values of
            [v0, v2, v4] -> do
                HUnit.assertEqual "TDIGEST.BYREVRANK 0" 5 v0
                HUnit.assertBool "TDIGEST.BYREVRANK 2 should be within range" (v2 >= 2 && v2 <= 4)
                HUnit.assertEqual "TDIGEST.BYREVRANK 4" 1 v4
            _ -> HUnit.assertFailure $ "Unexpected TDIGEST.BYREVRANK response: " ++ show values
    tdigestQuantile "td1" (0.0 NE.:| [0.5, 1.0]) >>@? \values ->
        case values of
            [q0, q50, q100] -> do
                HUnit.assertEqual "TDIGEST.QUANTILE 0" 1 q0
                HUnit.assertBool "TDIGEST.QUANTILE 0.5 should be within range" (q50 >= 2 && q50 <= 4)
                HUnit.assertEqual "TDIGEST.QUANTILE 1" 5 q100
            _ -> HUnit.assertFailure $ "Unexpected TDIGEST.QUANTILE response: " ++ show values

    tdigestCdf "td1" (1 NE.:| [3, 5]) >>@? \values ->
        case values of
            [cdf1, cdf3, cdf5] -> do
                HUnit.assertBool "TDIGEST.CDF should be monotonic" (cdf1 <= cdf3 && cdf3 <= cdf5)
                HUnit.assertBool "TDIGEST.CDF last value should be close to 1" (cdf5 >= 0.8)
            _ -> HUnit.assertFailure $ "Unexpected TDIGEST.CDF response: " ++ show values

    tdigestRank "td1" (1 NE.:| [3, 5]) >>@? \values ->
        case values of
            [r1, r3, r5] -> HUnit.assertBool "TDIGEST.RANK should be monotonic" (r1 <= r3 && r3 <= r5)
            _ -> HUnit.assertFailure $ "Unexpected TDIGEST.RANK response: " ++ show values

    tdigestRevrank "td1" (1 NE.:| [3, 5]) >>@? \values ->
        case values of
            [r1, r3, r5] -> HUnit.assertBool "TDIGEST.REVRANK should be monotonic descending" (r1 >= r3 && r3 >= r5)
            _ -> HUnit.assertFailure $ "Unexpected TDIGEST.REVRANK response: " ++ show values

    tdigestTrimmedMean "td1" 0.2 0.8 >>@? \value ->
        HUnit.assertBool "TDIGEST.TRIMMED_MEAN should be within observed range" (value >= 1 && value <= 5)

    tdigestInfo "td1" >>@? \TDigestInfo{..} -> do
        HUnit.assertBool "TDIGEST.INFO compression should be positive" (tdigestInfoCompression > 0)
        HUnit.assertBool "TDIGEST.INFO observations should reflect inserts" (tdigestInfoObservations >= 5)
        HUnit.assertBool "TDIGEST.INFO memory usage should be positive" (tdigestInfoMemoryUsage > 0)

    tdigestCreateOpts "td2" defaultTDigestCreateOpts
        { tdigestCreateCompression = Just 200
        } >>=? Ok
    tdigestAdd "td2" (10 NE.:| [20, 30]) >>=? Ok

    tdigestMerge "td_merged" ("td1" NE.:| ["td2"]) >>@? \status ->
        HUnit.assertEqual "TDIGEST.MERGE status" Ok status
    tdigestInfo "td_merged" >>@? \digestInfo ->
        HUnit.assertBool "TDIGEST.MERGE should populate destination" (tdigestInfoObservations digestInfo >= 8)

    tdigestCreate "td_override" >>=? Ok
    tdigestMergeOpts "td_override" ("td1" NE.:| ["td2"]) defaultTDigestMergeOpts
        { tdigestMergeCompression = Just 150
        , tdigestMergeOverride = True
        } >>=? Ok
    tdigestInfo "td_override" >>@? \digestInfo -> do
        150 HUnit.@=? tdigestInfoCompression digestInfo
        HUnit.assertBool "TDIGEST.MERGE override should populate destination" (tdigestInfoObservations digestInfo >= 8)

    tdigestReset "td1" >>=? Ok
    tdigestInfo "td1" >>@? \digestInfo ->
        HUnit.assertEqual "TDIGEST.RESET observations" 0 (tdigestInfoObservations digestInfo)

-- TimeSeries
--
testTs :: Test
testTs = testCase "timeseries" $ do
    tsCreateOpts "ts:series" defaultTsCreateOpts
        { tsCreateRetention = Just 100000
        , tsCreateEncoding = Just TsCompressed
        , tsCreateChunkSize = Just 128
        , tsCreateDuplicatePolicy = Just TsDuplicateLast
        , tsCreateLabels = [("metric", "temperature"), ("sensor", "alpha")]
        } >>=? Ok

    tsAdd "ts:series" "1000" 1.5 >>=? 1000
    tsAddOpts "ts:series" "2000" 2.5 defaultTsAddOpts
        { tsAddOnDuplicate = Just TsDuplicateLast
        } >>=? 2000
    tsGet "ts:series" >>=? Just (TsSample 2000 2.5)
    tsGetOpts "ts:series" defaultTsGetOpts
        { tsGetLatest = True
        } >>=? Just (TsSample 2000 2.5)

    tsRange "ts:series" "-" "+" >>=? [TsSample 1000 1.5, TsSample 2000 2.5]
    tsRangeOpts "ts:series" "-" "+" defaultTsRangeOpts
        { tsRangeCount = Just 1
        } >>=? [TsSample 1000 1.5]
    tsRevrange "ts:series" "-" "+" >>=? [TsSample 2000 2.5, TsSample 1000 1.5]

    tsAlter "ts:series" defaultTsAlterOpts
        { tsAlterRetention = Just 200000
        , tsAlterChunkSize = Just 256
        , tsAlterDuplicatePolicy = Just TsDuplicateMax
        , tsAlterLabels = [("metric", "temperature"), ("sensor", "beta")]
        } >>=? Ok

    tsIncrbyOpts "ts:counter" 5 defaultTsIncrByOpts
        { tsIncrByTimestamp = Just "1000"
        , tsIncrByLabels = [("metric", "counter"), ("sensor", "alpha")]
        } >>=? 1000
    tsDecrbyOpts "ts:counter" 2 defaultTsIncrByOpts
        { tsIncrByTimestamp = Just "2000"
        } >>=? 2000
    tsGet "ts:counter" >>=? Just (TsSample 2000 3.0)

    tsMadd
        ( ("ts:series", "3000", 3.5) NE.:|
          [ ("ts:counter", "3000", 4.0)
          ]
        ) >>=? [3000, 3000]

    tsQueryindex ("metric=temperature" NE.:| []) >>@? \seriesKeys ->
        HUnit.assertBool "TS.QUERYINDEX should return the labeled series" ("ts:series" `elem` seriesKeys)

    tsMget ("sensor=alpha" NE.:| []) >>@? \reply ->
        HUnit.assertBool "TS.MGET should return payload" (replyHasPayload reply)
    tsMgetOpts ("sensor=alpha" NE.:| []) defaultTsMGetOpts
        { tsMGetLatest = True
        , tsMGetLabels = Just TsWithLabels
        } >>@? \reply ->
            HUnit.assertBool "TS.MGET WITHLABELS should return payload" (replyHasPayload reply)

    tsMrange "-" "+" ("sensor=alpha" NE.:| []) >>@? \reply ->
        HUnit.assertBool "TS.MRANGE should return payload" (replyHasPayload reply)
    tsMrangeOpts "-" "+" ("sensor=alpha" NE.:| []) defaultTsMRangeOpts
        { tsMRangeLabels = Just (TsSelectedLabels ("metric" NE.:| ["sensor"]))
        , tsMRangeAggregation = Just TsAggregationOpts
            { tsAggregationAlign = Nothing
            , tsAggregationType = TsAggregators (TsAggAvg NE.:| [])
            , tsAggregationBucketDuration = 1000
            , tsAggregationBucketTimestamp = Just TsBucketStart
            , tsAggregationEmpty = False
            }
        } >>@? \reply ->
            HUnit.assertBool "TS.MRANGE aggregation should return payload" (replyHasPayload reply)
    tsMrevrange "-" "+" ("sensor=alpha" NE.:| []) >>@? \reply ->
        HUnit.assertBool "TS.MREVRANGE should return payload" (replyHasPayload reply)

    tsCreate "ts:source" >>=? Ok
    tsCreate "ts:dest" >>=? Ok
    tsCreaterule "ts:source" "ts:dest" TsAggAvg 1000 >>=? Ok
    tsAdd "ts:source" "1000" 1 >>=? 1000
    tsAdd "ts:source" "2000" 3 >>=? 2000
    tsAdd "ts:source" "3000" 5 >>=? 3000
    delRuleResult <- tsDelrule "ts:source" "ts:dest"
    liftIO $ case delRuleResult of
        Right Ok -> pure ()
        Left reply | isUnknownCommandReply reply -> pure ()
        Left reply -> HUnit.assertFailure $ "Unexpected TS.DELRULE reply: " ++ show reply
        Right status -> HUnit.assertFailure $ "Unexpected TS.DELRULE status: " ++ show status

    tsInfo "ts:series" >>@? \reply ->
        HUnit.assertBool "TS.INFO should return payload" (replyHasPayload reply)
    tsInfoOpts "ts:series" TsInfoDebug >>@? \reply ->
        HUnit.assertBool "TS.INFO DEBUG should return payload" (replyHasPayload reply)

    tsDel "ts:series" 3000 3000 >>=? 1
    tsRange "ts:series" "-" "+" >>=? [TsSample 1000 1.5, TsSample 2000 2.5]
  where
    replyHasPayload = \case
        Bulk (Just value) -> not (BS.null value)
        MultiBulk (Just replies) -> not (null replies)
        Integer _ -> True
        SingleLine value -> not (BS.null value)
        Error _ -> False
        Bulk Nothing -> False
        MultiBulk Nothing -> False

-- RedisJSON
--
testJSON :: Test
testJSON = testCase "json" $ do
    jsonSet "json:doc" "$"
        "{\"name\":\"base\",\"numbers\":[1,2],\"enabled\":true,\"nested\":{\"inner\":5},\"remove\":\"gone\"}" >>=? Just Ok

    jsonGet "json:doc" >>@? \actual ->
        case actual of
            Just payload -> HUnit.assertBool "JSON.GET should return the object" ("\"name\":\"base\"" `BS.isInfixOf` payload)
            Nothing -> HUnit.assertFailure "JSON.GET returned Nothing"

    jsonGetOpts "json:doc" defaultJSONGetOpts
        { jsonGetIndent = Just "  "
        , jsonGetNewline = Just "\n"
        , jsonGetSpace = Just " "
        , jsonGetPaths = ["$"]
        } >>@? \actual ->
            case actual of
                Just payload -> HUnit.assertBool "JSON.GET opts should format output" ("\n" `BS.isInfixOf` payload)
                Nothing -> HUnit.assertFailure "JSON.GET opts returned Nothing"

    jsonSetOpts "json:nx" "$" "{\"value\":1}" defaultJSONSetOpts
        { jsonSetCondition = Just JSONSetIfNotExists
        } >>=? Just Ok
    jsonSetOpts "json:nx" "$" "{\"value\":2}" defaultJSONSetOpts
        { jsonSetCondition = Just JSONSetIfNotExists
        } >>=? Nothing
    jsonSetOpts "json:nx" "$" "{\"value\":3}" defaultJSONSetOpts
        { jsonSetCondition = Just JSONSetIfExists
        } >>=? Just Ok

    jsonMset
        ( ("json:m1", "$", "{\"name\":\"one\"}") NE.:|
          [ ("json:m2", "$", "{\"name\":\"two\"}")
          ]
        ) >>=? Ok
    jsonMget ("json:m1" NE.:| ["json:m2"]) "$" >>@? \results ->
        HUnit.assertBool "JSON.MGET should return both values" (length results == 2 && all isJust results)

    jsonArrappend "json:doc" "$.numbers" ("3" NE.:| ["4"]) >>@? \reply ->
        HUnit.assertEqual "JSON.ARRAPPEND result" [4] (replyIntegers reply)
    jsonArrlenAt "json:doc" "$.numbers" >>@? \reply ->
        HUnit.assertEqual "JSON.ARRLEN result" [4] (replyIntegers reply)
    jsonArrindexOpts "json:doc" "$.numbers" "2" (JSONArrIndexFromTo 0 3) >>@? \reply ->
        HUnit.assertEqual "JSON.ARRINDEX result" [1] (replyIntegers reply)
    jsonArrinsert "json:doc" "$.numbers" 1 ("9" NE.:| []) >>@? \reply ->
        HUnit.assertEqual "JSON.ARRINSERT result" [5] (replyIntegers reply)
    jsonArrpopAtIndex "json:doc" "$.numbers" 1 >>@? \reply ->
        HUnit.assertBool "JSON.ARRPOP should return popped value" (replyContains "9" reply)
    jsonArrtrim "json:doc" "$.numbers" 1 2 >>@? \reply ->
        HUnit.assertEqual "JSON.ARRTRIM result" [2] (replyIntegers reply)

    jsonNumincrby "json:doc" "$.nested.inner" 5 >>@? \reply ->
        HUnit.assertBool "JSON.NUMINCRBY should update value" (replyContains "10" reply)
    jsonNummultby "json:doc" "$.nested.inner" 2 >>@? \reply ->
        HUnit.assertBool "JSON.NUMMULTBY should update value" (replyContains "20" reply)
    jsonClearAt "json:doc" "$.nested.inner" >>=? 1
    jsonGetOpts "json:doc" defaultJSONGetOpts { jsonGetPaths = ["$.nested.inner"] } >>@? \actual ->
        case actual of
            Just payload -> HUnit.assertBool "JSON.CLEAR should zero numeric value" ("0" `BS.isInfixOf` payload)
            Nothing -> HUnit.assertFailure "JSON.GET nested inner returned Nothing"

    jsonStrappendAt "json:doc" "$.name" "\"!\"" >>@? \reply ->
        HUnit.assertEqual "JSON.STRAPPEND result" [5] (replyIntegers reply)
    jsonToggle "json:doc" "$.enabled" >>@? \reply ->
        HUnit.assertEqual "JSON.TOGGLE result" [False] (replyBools reply)

    jsonObjkeysAt "json:doc" "$" >>@? \reply ->
        HUnit.assertBool "JSON.OBJKEYS should include name" (replyContains "name" reply)
    jsonObjlenAt "json:doc" "$" >>@? \reply ->
        HUnit.assertEqual "JSON.OBJLEN result" [5] (replyIntegers reply)
    jsonTypeAt "json:doc" "$.numbers" >>@? \reply ->
        HUnit.assertBool "JSON.TYPE should report array" (replyContains "array" reply)
    jsonRespAt "json:doc" "$.name" >>@? \reply ->
        HUnit.assertBool "JSON.RESP should return payload" (replyHasPayload reply)
    jsonDebugMemoryAt "json:doc" "$.numbers" >>@? \reply ->
        HUnit.assertBool "JSON.DEBUG MEMORY should return payload" (replyHasPayload reply)

    jsonMerge "json:doc" "$" "{\"merged\":true,\"name\":\"base!\"}" >>=? Ok
    jsonGet "json:doc" >>@? \actual ->
        case actual of
            Just payload -> do
                HUnit.assertBool "JSON.MERGE should add merged field" ("\"merged\":true" `BS.isInfixOf` payload)
                HUnit.assertBool "JSON.MERGE should update name" ("\"name\":\"base!\"" `BS.isInfixOf` payload)
            Nothing -> HUnit.assertFailure "JSON.GET after merge returned Nothing"

    jsonDelAt "json:doc" "$.remove" >>=? 1
    jsonForgetAt "json:doc" "$.merged" >>=? 1
    jsonGet "json:doc" >>@? \actual ->
        case actual of
            Just payload -> do
                HUnit.assertBool "JSON.DEL should remove field" (not ("\"remove\"" `BS.isInfixOf` payload))
                HUnit.assertBool "JSON.FORGET should remove field" (not ("\"merged\"" `BS.isInfixOf` payload))
            Nothing -> HUnit.assertFailure "JSON.GET after delete/forget returned Nothing"

    jsonSet "json:rootArray" "$" "[1,2,3]" >>=? Just Ok
    jsonArrlen "json:rootArray" >>@? \reply ->
        HUnit.assertBool "JSON.ARRLEN root should return payload" (replyHasPayload reply)
    jsonArrpop "json:rootArray" >>@? \reply ->
        HUnit.assertBool "JSON.ARRPOP root should return payload" (replyContains "3" reply)

    jsonSet "json:rootString" "$" "\"abc\"" >>=? Just Ok
    jsonStrappend "json:rootString" "\"d\"" >>@? \reply ->
        HUnit.assertBool "JSON.STRAPPEND root should return payload" (replyHasPayload reply)

    jsonSet "json:clearRoot" "$" "{\"a\":1}" >>=? Just Ok
    jsonClear "json:clearRoot" >>=? 1

    jsonSet "json:deleteRoot" "$" "{\"a\":1}" >>=? Just Ok
    jsonForget "json:deleteRoot" >>=? 1

    jsonSet "json:typeRoot" "$" "{\"a\":1}" >>=? Just Ok
    jsonType "json:typeRoot" >>@? \reply ->
        HUnit.assertBool "JSON.TYPE root should return payload" (replyHasPayload reply)
    jsonObjkeys "json:typeRoot" >>@? \reply ->
        HUnit.assertBool "JSON.OBJKEYS root should return payload" (replyContains "a" reply)
    jsonObjlen "json:typeRoot" >>@? \reply ->
        HUnit.assertBool "JSON.OBJLEN root should return payload" (replyHasPayload reply)
    jsonResp "json:typeRoot" >>@? \reply ->
        HUnit.assertBool "JSON.RESP root should return payload" (replyHasPayload reply)
    jsonDebugMemory "json:typeRoot" >>@? \reply ->
        HUnit.assertBool "JSON.DEBUG MEMORY root should return payload" (replyHasPayload reply)
    jsonDel "json:typeRoot" >>=? 1
  where
    isJust (Just _) = True
    isJust Nothing = False

    replyContains needle = \case
        SingleLine value -> needle `BS.isInfixOf` value
        Error value -> needle `BS.isInfixOf` value
        Integer value -> needle `BS.isInfixOf` Char8.pack (show value)
        Bulk (Just value) -> needle `BS.isInfixOf` value
        Bulk Nothing -> False
        MultiBulk (Just replies) -> any (replyContains needle) replies
        MultiBulk Nothing -> False

    replyHasPayload = \case
        Bulk (Just value) -> not (BS.null value)
        MultiBulk (Just replies) -> not (null replies)
        Integer _ -> True
        SingleLine value -> not (BS.null value)
        Error _ -> False
        Bulk Nothing -> False
        MultiBulk Nothing -> False

    replyIntegers = \case
        Integer value -> [value]
        MultiBulk (Just replies) -> [value | reply <- replies, Right value <- [decode reply :: Either Reply Integer]]
        reply -> case decode reply :: Either Reply Integer of
            Right value -> [value]
            Left _ -> []

    replyBools = \case
        Integer 1 -> [True]
        Integer 0 -> [False]
        MultiBulk (Just replies) -> [value | reply <- replies, Right value <- [decode reply :: Either Reply Bool]]
        reply -> case decode reply :: Either Reply Bool of
            Right value -> [value]
            Left _ -> []

------------------------------------------------------------------------------
-- Cuckoo Filters
--
testCuckooFilter :: Test
testCuckooFilter = testCase "cuckoo filter" $ do
    cfreserveOpts "cf" 1000 defaultCFReserveOpts
        { cfReserveBucketSize = Just 4
        , cfReserveMaxIterations = Just 50
        , cfReserveExpansion = Just 2
        } >>=? Ok

    cfinfo "cf" >>@? \CFInfo{..} -> do
        HUnit.assertBool "cfInfoSize should be positive" (cfInfoSize > 0)
        HUnit.assertBool "cfInfoBuckets should be positive" (cfInfoBuckets > 0)
        1 HUnit.@=? cfInfoFilters
        0 HUnit.@=? cfInfoItemsInserted
        0 HUnit.@=? cfInfoItemsDeleted
        4 HUnit.@=? cfInfoBucketSize
        2 HUnit.@=? cfInfoExpansion
        50 HUnit.@=? cfInfoMaxIterations

    cfadd "cf" "item1" >>=? True
    cfadd "cf" "item1" >>=? True
    cfcount "cf" "item1" >>=? 2
    cfexists "cf" "item1" >>=? True
    cfaddnx "cf" "item1" >>=? False
    cfcount "cf" "item1" >>=? 2

    cfinsert "cf" ("item2" NE.:| ["item3"]) >>=? [CFInsertAdded, CFInsertAdded]
    cfinsertnx "cf" ("item1" NE.:| ["item4"]) >>=? [CFInsertAlreadyExists, CFInsertAdded]
    cfmexists "cf" ("item1" NE.:| ["item2", "item3", "item4", "missing"]) >>=? [True, True, True, True, False]

    cfdel "cf" "item2" >>=? True
    cfcount "cf" "item2" >>=? 0
    cfdel "cf" "item2" >>=? False

------------------------------------------------------------------------------
-- Pub/Sub
--
testPubSub :: Test
testPubSub conn = testCase "pubSub" go conn
  where
    go = do
        -- producer
        asyncProducer <- liftIO $ Async.async $ do
            runRedis conn $ do
                let t = 10^(5 :: Int)
                liftIO $ threadDelay t
                publish "chan1" "hello" >>=? 1
                liftIO $ threadDelay t
                publish "chan2" "world" >>=? 1
            return ()

        -- consumer
        pubSub (subscribe ["chan1"]) $ \msg -> do
            -- ready for a message
            case msg of
                Message{..} -> return
                    (unsubscribe [msgChannel] `mappend` psubscribe ["chan*"])
                PMessage{..} -> return (punsubscribe [msgPattern])

        pubSub (subscribe [] `mappend` psubscribe []) $ \_ -> do
            liftIO $ HUnit.assertFailure "no subs: should return immediately"
            undefined
        liftIO $ Async.wait asyncProducer


------------------------------------------------------------------------------
-- Transaction
--
testTransaction :: Test
testTransaction = testCase "transaction" $ do
    watch ["{same}k1", "{same}k2"] >>=? Ok
    unwatch            >>=? Ok
    set "{same}foo" "foo" >>= \case
      Left _ -> error "error"
      _ -> return ()
    set "{same}bar" "bar" >>= \case
      Left _ -> error "error"
      _ -> return ()
    foobar <- multiExec $ do
        foo <- get "{same}foo"
        bar <- get "{same}bar"
        return $ (,) <$> foo <*> bar
    assert $ foobar == TxSuccess (Just "foo", Just "bar")

testSet7 :: Test
testSet7 = testCase "Set" $ do
    set "hello" "hi" >>=? Ok
    setOpts "hello" "hi" SetOpts{
        setSeconds           = Nothing,
        setMilliseconds      = Nothing,
        setUnixSeconds       = Just 2000,
        setUnixMilliseconds  = Nothing,
        setCondition         = Nothing,
        setKeepTTL           = False
    } >>=? Ok
    setOpts "hello" "hi" SetOpts{
        setSeconds           = Nothing,
        setMilliseconds      = Nothing,
        setUnixSeconds       = Nothing,
        setUnixMilliseconds  = Just 20000,
        setCondition         = Nothing,
        setKeepTTL           = False
    } >>=? Ok
    setOpts "hello" "hi" SetOpts{
        setSeconds           = Nothing,
        setMilliseconds      = Nothing,
        setUnixSeconds       = Nothing,
        setUnixMilliseconds  = Nothing,
        setCondition         = Nothing,
        setKeepTTL           = True
    } >>=? Ok
    setGet "hello" "henlo" >>=? "hi"
    setGetOpts "hello" "henlo2" SetOpts{
        setSeconds           = Nothing,
        setMilliseconds      = Nothing,
        setUnixSeconds       = Nothing,
        setUnixMilliseconds  = Nothing,
        setCondition         = Just Nx,
        setKeepTTL           = False
    } >>=? "henlo"
    return ()

testZAdd7 :: Test
testZAdd7 = testCase "ZADD" $ do
    zadd "set" [(42, "2")] >>=? 1
    zaddOpts "set" [(44, "6")] (defaultZaddOpts {zaddSizeCondition = Just CGT}) >>=? 1
    zaddOpts "set" [(46, "7")] (defaultZaddOpts {zaddSizeCondition = Just CLT}) >>=? 1
    return ()

testExpireTime7 :: Test
testExpireTime7 = testCase "expiretime" $ do
    set "mykey" "Hello" >>=? Ok
    expireat "mykey" 33177117420 >>=? True
    expiretime "mykey" >>=? 33177117420
    pexpireat "mykey" 33177117420000 >>=? True
    pexpiretime "mykey" >>=? 33177117420000

testHashExpire7 :: Test
testHashExpire7 = testCase "hash expire" $ do
    hset "mykey" [("field1", "hello"), ("field2", "world")] >>=? 2

    hexpire "mykey" 60 ("field1" NE.:| ["field2", "missing"]) >>=?
        [ HashFieldExpirationSet
        , HashFieldExpirationSet
        , HashFieldExpirationNoSuchField
        ]

    httl "mykey" ("field1" NE.:| ["field2", "missing"]) >>@? \values ->
        case values of
            [HashFieldExpirationInfo ttl1, HashFieldExpirationInfo ttl2, HashFieldExpirationInfoNoSuchField] -> do
                HUnit.assertBool "HTTL field1 should be positive" (ttl1 > 0 && ttl1 <= 60)
                HUnit.assertBool "HTTL field2 should be positive" (ttl2 > 0 && ttl2 <= 60)
            _ -> HUnit.assertFailure $ "Unexpected HTTL reply: " ++ show values

    hpexpire "mykey" 2000 ("field1" NE.:| ["field2"]) >>=?
        [ HashFieldExpirationSet
        , HashFieldExpirationSet
        ]

    hpttl "mykey" ("field1" NE.:| ["field2"]) >>@? \values ->
        case values of
            [HashFieldExpirationInfo ttl1, HashFieldExpirationInfo ttl2] -> do
                HUnit.assertBool "HPTTL field1 should be positive" (ttl1 > 0 && ttl1 <= 2000)
                HUnit.assertBool "HPTTL field2 should be positive" (ttl2 > 0 && ttl2 <= 2000)
            _ -> HUnit.assertFailure $ "Unexpected HPTTL reply: " ++ show values

    now <- round <$> liftIO getPOSIXTime
    hexpireat "mykey" (now + 60) ("field1" NE.:| ["field2"]) >>=?
        [ HashFieldExpirationSet
        , HashFieldExpirationSet
        ]

    hexpiretime "mykey" ("field1" NE.:| ["field2"]) >>@? \values ->
        case values of
            [HashFieldExpirationInfo ts1, HashFieldExpirationInfo ts2] -> do
                HUnit.assertBool "HEXPIRETIME field1 should be near target" (ts1 >= now && ts1 <= now + 60)
                HUnit.assertBool "HEXPIRETIME field2 should be near target" (ts2 >= now && ts2 <= now + 60)
            _ -> HUnit.assertFailure $ "Unexpected HEXPIRETIME reply: " ++ show values

    nowMs <- round . (* 1000) <$> liftIO getPOSIXTime
    hpexpireat "mykey" (nowMs + 2000) ("field1" NE.:| ["field2"]) >>=?
        [ HashFieldExpirationSet
        , HashFieldExpirationSet
        ]

    hpexpiretime "mykey" ("field1" NE.:| ["field2"]) >>@? \values ->
        case values of
            [HashFieldExpirationInfo ts1, HashFieldExpirationInfo ts2] -> do
                HUnit.assertBool "HPEXPIRETIME field1 should be near target" (ts1 >= nowMs && ts1 <= nowMs + 2000)
                HUnit.assertBool "HPEXPIRETIME field2 should be near target" (ts2 >= nowMs && ts2 <= nowMs + 2000)
            _ -> HUnit.assertFailure $ "Unexpected HPEXPIRETIME reply: " ++ show values

    hexpireOpts "mykey" 10 ("field1" NE.:| [])
        (ExpireOptsTime Nx)
        >>=? [HashFieldExpirationConditionNotMet]

testSintercard7 :: Test
testSintercard7 = testCase "sintercard" $ do
    sadd "{same}bikes:racing:france" ("bike:1" NE.:| ["bike:2", "bike:3"]) >>=? 3
    sadd "{same}bikes:racing:usa" ("bike:1" NE.:| ["bike:4"]) >>=? 2
    sadd "{same}bikes:racing:japan" ("bike:1" NE.:| ["bike:3"]) >>=? 2
    sintercard ("{same}bikes:racing:france" NE.:| ["{same}bikes:racing:usa", "{same}bikes:racing:japan"]) >>=? 1
    sintercardOpts ("{same}bikes:racing:france" NE.:| ["{same}bikes:racing:usa", "{same}bikes:racing:japan"])
        defaultSintercardOpts { sintercardLimit = Just 1 } >>=? 1

testLMPop7 :: Test
testLMPop7 = testCase "lmpop" $ do
    lmpop ("non1" NE.:| ["non2"]) ListLeft >>=? Nothing
    lpush "mylist" ["one", "two", "three", "four", "five"] >>=? 5
    lmpop ("mylist" NE.:| []) ListLeft >>=? Just ("mylist", ["five"])
    lrange "mylist" 0 (-1) >>=? ["four", "three", "two", "one"]

    lpush "mylist2" ["a", "b", "c", "d", "e"] >>=? 5
    lpush "mylist3" ["one", "two", "three", "four", "five"] >>=? 5
    lmpopCount ("mylist" NE.:| ["mylist2"]) ListRight 3 >>=? Just ("mylist", ["one", "two", "three"])
    blmpopCount 1 ("mylist3" NE.:| ["mylist2"]) ListRight 5 >>=? Just ("mylist3", ["one", "two", "three", "four", "five"])
    blmpopCount 1 ("mylist3" NE.:| ["mylist2"]) ListRight 10 >>=? Just ("mylist2", ["a", "b", "c", "d", "e"])

testZMPop7 :: Test
testZMPop7 = testCase "zmpop" $ do
    zadd "{same}zset1" [(1, "one"), (2, "two"), (3, "three")] >>=? 3
    zadd "{same}zset2" [(10, "ten")] >>=? 1
    zmpop ("{same}zset1" NE.:| ["{same}zset2"]) ZPopMax >>=? Just ZPopResponse
        { zPopResponseKey = Just "{same}zset1"
        , zPopResponseValues = [("three", 3)]
        }
    zmpopCount ("{same}zset1" NE.:| ["{same}zset2"]) ZPopMin 2 >>=? Just ZPopResponse
        { zPopResponseKey = Just "{same}zset1"
        , zPopResponseValues = [("one", 1), ("two", 2)]
        }
    bzmpopCount 1 ("{same}zset1" NE.:| ["{same}zset2"]) ZPopMax 2 >>=? Just ZPopResponse
        { zPopResponseKey = Just "{same}zset2"
        , zPopResponseValues = [("ten", 10)]
        }

testFunction7 :: Test
testFunction7 = testCase "function" $ do
    functionFlushOpts FlushOptsSync >>=? Ok

    let libraryCode = "#!lua name=mylib\nredis.register_function('myfunc', function(keys, args) return args[1] end)\nredis.register_function{function_name='myro', callback=function(keys, args) return redis.call('GET', keys[1]) end, flags={ 'no-writes' }}"

    functionLoad libraryCode >>=? "mylib"
    fcall "myfunc" [] ["hello"] >>=? ("hello" :: ByteString)
    set "mykey" "value" >>=? Ok
    fcallReadonly "myro" ["mykey"] [] >>=? ("value" :: ByteString)
    functionList >>@? \reply ->
        case reply of
            MultiBulk (Just _) -> pure ()
            _ -> HUnit.assertFailure $ "Unexpected FUNCTION LIST reply: " ++ show reply
    functionListOpts defaultFunctionListOpts { functionListLibraryName = Just "mylib", functionListWithCode = True } >>@? \reply ->
        case reply of
            MultiBulk (Just _) -> pure ()
            _ -> HUnit.assertFailure $ "Unexpected FUNCTION LIST WITHCODE reply: " ++ show reply
    functionStats >>@? \reply ->
        case reply of
            MultiBulk (Just _) -> pure ()
            _ -> HUnit.assertFailure $ "Unexpected FUNCTION STATS reply: " ++ show reply
    payload <- functionDump
    case payload of
        Left reply -> liftIO $ HUnit.assertFailure $ "Unexpected FUNCTION DUMP reply: " ++ show reply
        Right dumped -> do
            functionDelete "mylib" >>=? Ok
            functionRestore dumped >>=? Ok
            fcall "myfunc" [] ["restored"] >>=? ("restored" :: ByteString)
            functionDelete "mylib" >>=? Ok
            functionRestoreOpts dumped (FunctionRestoreWithPolicy FunctionRestoreAppend) >>=? Ok
            fcall "myfunc" [] ["restored-again"] >>=? ("restored-again" :: ByteString)
    killResult <- functionKill
    liftIO $ case killResult of
        Left (Error _) -> pure ()
        Left reply -> HUnit.assertFailure $ "Unexpected FUNCTION KILL reply: " ++ show reply
        Right status -> HUnit.assertFailure $ "Unexpected FUNCTION KILL status: " ++ show status
    functionFlushOpts FlushOptsSync >>=? Ok

testCommandList7 :: Test
testCommandList7 = testCase "command list" $ do
    commandList >>@? \commands ->
        HUnit.assertBool "COMMAND LIST should contain GET" ("get" `elem` commands)
    commandListOpts (Just $ CommandListFilterByPattern "x*") >>@? \commands -> do
        HUnit.assertBool "pattern-filtered command list should contain xadd" ("xadd" `elem` commands)
        HUnit.assertBool "pattern-filtered command list should exclude get" ("get" `notElem` commands)
    commandListOpts (Just $ CommandListFilterByAclCat "connection") >>@? \commands ->
        HUnit.assertBool "ACLCAT-filtered command list should contain ping" ("ping" `elem` commands)

------------------------------------------------------------------------------
-- Scripting
--
testScripting :: Test
testScripting conn = testCase "scripting" go conn
  where
    go = do
        let script    = "return {false, 42}"
            scriptRes = (False, 42 :: Integer)
        scriptLoad script >>= \case
          Left _ -> error "error"
          Right scriptHash -> do
            eval script [] []                       >>=? scriptRes
            evalsha scriptHash [] []                >>=? scriptRes
            scriptExists [scriptHash, "notAScript"] >>=? [True, False]
            scriptFlush                             >>=? Ok
            -- start long running script from another client
            configSet "lua-time-limit" "100"        >>=? Ok
            evalFinished <- liftIO newEmptyMVar
            asyncScripting <- liftIO $ Async.async $ runRedis conn $ do
                -- we must pattern match to block the thread
                (eval "while true do end" [] []
                    :: Redis (Either Reply Integer)) >>= \case
                    Left _ -> return ()
                    _ -> error "impossible"
                liftIO (putMVar evalFinished ())
                return ()
            liftIO (threadDelay 500000) -- 0.5s
            scriptKill                              >>=? Ok
            () <- liftIO (takeMVar evalFinished)
            liftIO $ Async.wait asyncScripting
            return ()

------------------------------------------------------------------------------
-- Connection
--
testConnectAuth :: String -> PortNumber -> Test
testConnectAuth host port = testCase "connect/auth" $ do
    configSet "requirepass" "pass" >>=? Ok
    liftIO $ do
        c <- checkedConnect defaultConnectInfo { connectAuth = Just "pass", connectAddr = ConnectAddrHostPort host port }
        runRedis c (ping >>=? Pong)
    auth "pass"                    >>=? Ok
    configSet "requirepass" ""     >>=? Ok

testConnectAuthUnexpected :: String -> PortNumber -> Test
testConnectAuthUnexpected host port = testCase "connect/auth/unexpected" $ do
    liftIO $ do
        res <- try $ void $ checkedConnect connInfo
        HUnit.assertEqual "" err res

    where connInfo = defaultConnectInfo { connectAuth = Just "pass", connectAddr = ConnectAddrHostPort host port }
          err = Left $ ConnectAuthError $
                  Error "ERR AUTH <password> called without any password configured for the default user. Are you sure your configuration is correct?"


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

testConnectDb :: String -> PortNumber -> Test
testConnectDb host port = testCase "connect/db" $ do
    set "connect" "value" >>=? Ok
    liftIO $ void $ do
        c <- checkedConnect defaultConnectInfo { connectDatabase = 1, connectAddr = ConnectAddrHostPort host port }
        runRedis c (get "connect" >>=? Nothing)

testConnectDbUnexisting :: String -> PortNumber -> Test
testConnectDbUnexisting host port = 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, connectAddr = ConnectAddrHostPort host port }

testClientUnpause :: Test
testClientUnpause = testCase "client/unpause" $
    clientUnpause >>=? Ok

testEcho :: Test
testEcho = testCase "echo" $
    echo ("value" ) >>=? "value"

testPing :: Test
testPing = testCase "ping" $ ping >>=? Pong

testQuit :: Test
testQuit = testCase "quit" $ quit >>=? Ok

testSelect :: Test
testSelect = testCase "select" $ do
    select 13 >>=? Ok
    select 0 >>=? Ok


------------------------------------------------------------------------------
-- Client
--
testClientId :: Test
testClientId = testCase "client id" $ do
    clientId >>= assert . isRight

testClientName :: Test
testClientName = testCase "client {get,set}name" $ do
    clientGetname >>=? Nothing
    clientSetname "FooBar" >>=? Ok
    clientGetname >>=? Just "FooBar"


------------------------------------------------------------------------------
-- Server
--
testServer :: Test
testServer = testCase "server" $ do
    time >>= \case
      Right (_,_) -> return ()
      Left _ -> error "error"
    slaveof "no" "one" >>=? Ok
    return ()

testBgrewriteaof :: Test
testBgrewriteaof = testCase "bgrewriteaof/bgsave/save" $ do
    save >>=? Ok
    bgsave >>= \case
      Right (Status _) -> return ()
      _ -> error "error"
    -- Redis needs time to finish the bgsave
    liftIO $ threadDelay (10^(5 :: Int))
    bgrewriteaof >>= \case
      Right (Status _) -> return ()
      _ -> error "error"
    return ()

testConfig :: Test
testConfig = testCase "config/auth" $ do
    configGet ["requirepass"]      >>=? [("requirepass", "")]
    configSet "requirepass" "pass" >>=? Ok
    auth "pass"                    >>=? Ok
    configSet "requirepass" ""     >>=? Ok

testFlushall :: Test
testFlushall = testCase "flushall/flushdb" $ do
    flushall >>=? Ok
    flushdb  >>=? Ok

testInfo :: Test
testInfo = testCase "info/lastsave/dbsize" $ do
    info >>= \case
      Left _ -> error "error"
      _ -> return ()
    lastsave >>= \case
      Left _ -> error "error"
      _ -> return ()
    dbsize          >>=? 0
    configResetstat >>=? Ok

testSlowlog :: Test
testSlowlog = testCase "slowlog" $ do
    slowlogReset >>=? Ok
    slowlogGet 5 >>=? []
    slowlogLen   >>=? 0

-- |Starting with Redis 7.0.0, the DEBUG command is disabled by default and must be enabled manually in the Redis Config file
testDebugObject :: Test
testDebugObject = testCase "debugObject/debugSegfault" $ do
    return ()
    -- set "key" "value" >>=? Ok
    -- debugObject "key" >>= \case
      -- Left _ -> error "error"
      -- _ -> return ()
    -- return ()

testScans :: Test
testScans = testCase "scans" $ do
    set "key" "value"       >>=? Ok
    scan cursor0            >>=? (cursor0, ["key"])
    scanOpts cursor0 sOpts1 Nothing >>=? (cursor0, ["key"])
    scanOpts cursor0 sOpts2 Nothing >>=? (cursor0, [])
    where sOpts1 = defaultScanOpts { scanMatch = Just "k*" }
          sOpts2 = defaultScanOpts { scanMatch = Just "not*"}

testSScan :: Test
testSScan = testCase "sscan" $ do
    sadd "set" (NE.fromList ["1"]) >>=? 1
    sscan "set" cursor0     >>=? (cursor0, ["1"])

testHScan :: Test
testHScan = testCase "hscan" $ do
    hset "hash" [("k"::ByteString, "v"::ByteString)] >>=? 1
    hscan "hash" cursor0     >>=? (cursor0, [("k", "v")])

testZScan :: Test
testZScan = testCase "zscan" $ do
    zadd "zset" [(42, "2")] >>=? 1
    zscan "zset" cursor0    >>=? (cursor0, [("2", 42)])

testZrangelex ::Test
testZrangelex = testCase "zrangebylex" $ do
    let testSet = [(10, "aaa"), (10, "abb"), (10, "ccc"), (10, "ddd")]
    zadd "zrangebylex" testSet                          >>=? 4
    zrangebylex "zrangebylex" (Incl "aaa") (Incl "bbb") >>=? ["aaa","abb"]
    zrangebylex "zrangebylex" (Excl "aaa") (Excl "ddd") >>=? ["abb","ccc"]
    zrangebylex "zrangebylex" Minr Maxr                 >>=? ["aaa","abb","ccc","ddd"]
    zrangebylexLimit "zrangebylex" Minr Maxr 2 1        >>=? ["ccc"]

testXAddRead ::Test
testXAddRead = testCase "xadd/xread" $ do
    xadd "{same}somestream8" "123" [("key", "value"), ("key2", "value2")]
    xadd "{same}otherstream" "456" [("key1", "value1")]
    xaddOpts "{same}thirdstream" "*" [("k", "v")]
        $ xaddTrimOpt (Just $ trimOpts (TrimMaxlen 1) TrimExact)
    xaddOpts "{same}thirdstream" "*" [("k", "v")]
        $ xaddTrimOpt (Just $ trimOpts (TrimMaxlen 1) (TrimApprox Nothing))
    xread [("{same}somestream8", "0"), ("{same}otherstream", "0")] >>=? Just [
        XReadResponse {
            stream = "{same}somestream8",
            records = [StreamsRecord{recordId = "123-0", keyValues = [("key", "value"), ("key2", "value2")]}]
        },
        XReadResponse {
            stream = "{same}otherstream",
            records = [StreamsRecord{recordId = "456-0", keyValues = [("key1", "value1")]}]
        }]
    xlen "{same}somestream8" >>=? 1
    where xaddTrimOpt a = XAddOpts{
        xAddTrimOpts = a,
        xAddnoMkStream = False}

testXReadGroup ::Test
testXReadGroup = testCase "XGROUP */xreadgroup/xack" $ void $ runExceptT $ do
    ExceptT $ xadd "somestream8" "123" [("key", "value")]
    ExceptT $ xgroupCreate "somestream8" "somegroup" "0"
    readResult <- ExceptT $ xreadGroup "somegroup" "consumer1" [("somestream8", ">")]
    liftIO $ readResult HUnit.@=? Just [
        XReadResponse {
            stream = "somestream8",
            records = [StreamsRecord{recordId = "123-0", keyValues = [("key", "value")]}]
        }]
    noAcked <- ExceptT $ xack "somestream8" "somegroup" ["123-0"]
    liftIO $ noAcked HUnit.@=? 1
    groupMessages <- ExceptT $ xreadGroup "somegroup" "consumer1" [("somestream8", ">")]
    liftIO $ groupMessages HUnit.@=? Nothing
    setIdOk <- ExceptT $ xgroupSetId "somestream8" "somegroup" "0"
    liftIO $ setIdOk HUnit.@=? Ok
    itemsLeft <- ExceptT $ xgroupDelConsumer "somestream8" "somegroup" "consumer1"
    liftIO $ itemsLeft HUnit.@=? 0
    groupDestroyed <- ExceptT (xgroupDestroy "somestream8" "somegroup")
    liftIO $ groupDestroyed HUnit.@=? True

testXCreateGroup7 ::Test
testXCreateGroup7 = testCase "XGROUP CREATE" $ do
    xgroupCreateOpts "somestream8" "somegroup" "0" XGroupCreateOpts {xGroupCreateMkStream    = True,
                                                                    xGroupCreateEntriesRead = Just "1234"} >>=? Ok
    return ()

testXRange ::Test
testXRange = testCase "xrange/xrevrange" $ do
    xadd "somestream8" "121" [("key1", "value1")]
    xadd "somestream8" "122" [("key2", "value2")]
    xadd "somestream8" "123" [("key3", "value3")]
    xadd "somestream8" "124" [("key4", "value4")]
    xrange "somestream8" "122" "123" Nothing >>=? [
        StreamsRecord{recordId = "122-0", keyValues = [("key2", "value2")]},
        StreamsRecord{recordId = "123-0", keyValues = [("key3", "value3")]}
        ]
    xrevRange "somestream8" "123" "122" Nothing >>=? [
        StreamsRecord{recordId = "123-0", keyValues = [("key3", "value3")]},
        StreamsRecord{recordId = "122-0", keyValues = [("key2", "value2")]}
        ]

testXpending ::Test
testXpending = testCase "xpending" $ do
    xadd "somestream8" "121" [("key1", "value1")]
    xadd "somestream8" "122" [("key2", "value2")]
    xadd "somestream8" "123" [("key3", "value3")]
    xadd "somestream8" "124" [("key4", "value4")]
    xgroupCreate "somestream8" "somegroup" "0"
    xreadGroup "somegroup" "consumer1" [("somestream8", ">")]
    xpendingSummary "somestream8" "somegroup" >>=? XPendingSummaryResponse {
        numPendingMessages = 4,
        smallestPendingMessageId = "121-0",
        largestPendingMessageId = "124-0",
        numPendingMessagesByconsumer = [("consumer1", 4)]
    }
    xpendingDetail "somestream8" "somegroup" "121" "121" 10 defaultXPendingDetailOpts >>@? (\case
            [XPendingDetailRecord{..}] -> do
                messageId HUnit.@=? "121-0"
            bad -> HUnit.assertFailure $ "Unexpectedly got " ++ show bad
            )

testXpending7 ::Test
testXpending7 = testCase "xpending7" $ void $ runExceptT $ do
    ExceptT $ xadd "somestream8" "121" [("key1", "value1")]
    ExceptT $ xadd "somestream8" "122" [("key2", "value2")]
    ExceptT $ xadd "somestream8" "123" [("key3", "value3")]
    ExceptT $ xadd "somestream8" "124" [("key4", "value4")]
    ExceptT $ xgroupCreate "somestream8" "somegroup" "0"
    ExceptT $ xgroupCreate "somestream8" "somegroup2" "0"
    ExceptT $ xreadGroup "somegroup" "consumer1" [("somestream8", ">")]
    ExceptT $ xreadGroup "somegroup2" "consumer2" [("somestream8", ">")]
    ackedCount <- ExceptT $ xack "somestream8" "somegroup" ["121", "122", "123"]
    liftIO $ ackedCount HUnit.@=? 3
    pendingDetails <- ExceptT $ xpendingDetail "somestream8" "somegroup2" "123" "123" 10 XPendingDetailOpts
                    {xPendingDetailIdle     = Just 0,
                     xPendingDetailConsumer = Just "consumer2" }

    liftIO $ case pendingDetails of
        [XPendingDetailRecord{..}] -> do
            messageId HUnit.@=? "123-0"
        bad -> HUnit.assertFailure $ "Unexpectedly got " ++ show bad

testXClaim ::Test
testXClaim =
  testCase "xclaim" $ void $ runExceptT $ do
    storedKey1 <- ExceptT $ xadd "somestream8" "121" [("key1", "value1")]
    liftIO $ storedKey1 HUnit.@=? "121-0"
    storedKey2 <- ExceptT $ xadd "somestream8" "122" [("key2", "value2")]
    liftIO $ storedKey2 HUnit.@=? "122-0"
    groupCreated <- ExceptT $ xgroupCreate "somestream8" "somegroup" "0"
    liftIO $ groupCreated HUnit.@=? Ok
    readResult <- ExceptT $ xreadGroupOpts
      "somegroup"
      "consumer1"
      [("somestream8", ">")]
      (defaultXReadGroupOpts {xReadGroupCount = Just 2})
    liftIO $ readResult HUnit.@=? Just
        [ XReadResponse
            { stream = "somestream8"
            , records =
                [ StreamsRecord
                    {recordId = "121-0", keyValues = [("key1", "value1")]}
                , StreamsRecord
                    {recordId = "122-0", keyValues = [("key2", "value2")]}
                ]
            }
        ]
    claimed <- ExceptT $ xclaim "somestream8" "somegroup" "consumer2" 0 defaultXClaimOpts ["121-0"]
    liftIO $ claimed HUnit.@=? [StreamsRecord {recordId = "121-0", keyValues = [("key1", "value1")]}]
    claimedJustIds <- ExceptT $ xclaimJustIds
      "somestream8"
      "somegroup"
      "consumer2"
      0
      defaultXClaimOpts
      ["122-0"]
    liftIO $ claimedJustIds HUnit.@=? ["122-0"]

testXAutoClaim7 ::Test
testXAutoClaim7 =
  testCase "xautoclaim" $ do
    xadd "somestream8" "121" [("key1", "value1")] >>=? "121-0"
    xadd "somestream8" "122" [("key2", "value2")] >>=? "122-0"
    xgroupCreate "somestream8" "somegroup" "0" >>=? Ok
    xreadGroupOpts "somegroup" "consumer1" [("somestream8", ">")] defaultXReadGroupOpts { xReadGroupCount = Just 2 }

    let opts = XAutoclaimOpts {
        xAutoclaimCount = Just 1
    }
    xautoclaimJustIdsOpts "somestream8" "somegroup" "consumer2" 0 "0-0" opts  >>@? (\case
        XAutoclaimResult{..} -> do
            xAutoclaimClaimedMessages HUnit.@=? ["121-0"]
            xAutoclaimDeletedMessages HUnit.@=? []
            return ())

    xtrim "somestream8" (trimOpts (TrimMaxlen 1) TrimExact) >>=? 1
    xautoclaim "somestream8" "somegroup" "consumer2" 0 "0-0" >>@? (\case
        XAutoclaimResult{..} -> do
            xAutoclaimClaimedMessages HUnit.@=? [StreamsRecord {
                recordId = "122-0",
                keyValues = [("key2", "value2")]
            }]
            xAutoclaimDeletedMessages HUnit.@=? ["121-0"]
            return ()
        )
    return ()

testXAckDel8 :: Test
testXAckDel8 = testCase "xackdel" $ do
    xadd "somestream8-1" "121" [("key1", "value1")] >>=? "121-0"
    xgroupCreate "somestream8-1" "somegroup1" "0" >>=? Ok
    xgroupCreate "somestream8-1" "somegroup2" "0" >>=? Ok
    xreadGroup "somegroup1" "consumer1" [("somestream8-1", ">")] >>@? const (pure ())
    xreadGroup "somegroup2" "consumer2" [("somestream8-1", ">")] >>@? const (pure ())

    let ackedOpts = defaultXEntryDeletionOpts { xEntryDeletionRefPolicy = XRefPolicyAcked }

    xackdelOpts "somestream8-1" "somegroup1" ("121-0" NE.:| []) ackedOpts
        >>=? [XEntryDeletionResultNotDeleted]
    xrange "somestream8-1" "-" "+" Nothing >>@? \records ->
        HUnit.assertEqual "entry should remain until all groups acknowledge it" 1 (length records)

    xackdelOpts "somestream8-1" "somegroup2" ("121-0" NE.:| []) ackedOpts
        >>=? [XEntryDeletionResultDeleted]
    xrange "somestream8-1" "-" "+" Nothing >>=? []

testXDelEx8 :: Test
testXDelEx8 = testCase "xdelex" $ do
    xadd "somestream8" "121" [("key1", "value1")] >>=? "121-0"
    xgroupCreate "somestream8" "somegroup1" "0" >>=? Ok

    let ackedOpts = defaultXEntryDeletionOpts { xEntryDeletionRefPolicy = XRefPolicyAcked }

    xdelexOpts "somestream8" ("121-0" NE.:| []) ackedOpts
        >>=? [XEntryDeletionResultNotDeleted]
    xrange "somestream8" "-" "+" Nothing >>@? \records ->
       HUnit.assertEqual "ACKED should not delete without consumer groups" 1 (length records)

    xgroupCreate "somestream8" "somegroup" "0" >>=? Ok
    xreadGroup "somegroup" "consumer1" [("somestream8", ">")] >>@? const (pure ())
    xdelex "somestream8" ("121-0" NE.:| [])
        >>=? [XEntryDeletionResultDeleted]
    xpendingSummary "somestream8" "somegroup" >>@? \summary ->
        numPendingMessages summary HUnit.@=? 1

testXInfo ::Test
-- This test does not work with pipelining because it relies on the certaino order of commands execution
-- and fails if commands reach different nodes.
testXInfo = testCase "xinfo" $ void $ runExceptT $ do
    _ <- ExceptT $ xadd "somestream8" "121" [("key1", "value1")]
    _ <- ExceptT $ xadd "somestream8" "122" [("key2", "value2")]
    _ <- ExceptT $ xgroupCreate "somestream8" "somegroup" "0"
    _ <- ExceptT $ xreadGroupOpts "somegroup" "consumer1" [("somestream8", ">")] defaultXReadGroupOpts { xReadGroupCount = Just 2 }

    z <- ExceptT $ xinfoConsumers "somestream8" "somegroup"
    liftIO $ case z of
        [XInfoConsumersResponse{..}] -> do
            xinfoConsumerName HUnit.@=? "consumer1"
            xinfoConsumerNumPendingMessages HUnit.@=? 2

        bad -> HUnit.assertFailure $ "Unexpectedly got " ++ show bad

    x <- ExceptT $ xinfoGroups "somestream8"
    liftIO $ case x of
        [XInfoGroupsResponse{..}] -> do
            xinfoGroupsGroupName              HUnit.@=? "somegroup"
            xinfoGroupsNumConsumers           HUnit.@=? 1
            xinfoGroupsNumPendingMessages     HUnit.@=? 2
            xinfoGroupsLastDeliveredMessageId HUnit.@=? "122-0"

            (do xinfoGroupsEntriesRead          HUnit.@=? Nothing -- Redis 6
                xinfoGroupsLag                  HUnit.@=? Nothing) <|?>
                (do xinfoGroupsEntriesRead          HUnit.@=? Just 2 -- Redis 7
                    xinfoGroupsLag                  HUnit.@=? Just 0)

        bad -> HUnit.assertFailure $ "Unexpectedly got " ++ show bad

    a <- ExceptT $ xinfoStream "somestream8"
    liftIO $ case a of
        XInfoStreamResponse{..} -> do
            xinfoStreamLength         HUnit.@=? 2
            xinfoStreamRadixTreeKeys  HUnit.@=? 1
            xinfoStreamRadixTreeNodes HUnit.@=? 2
            xinfoStreamNumGroups      HUnit.@=? 1
            xinfoStreamLastEntryId    HUnit.@=? "122-0"
            xinfoStreamFirstEntry     HUnit.@=? StreamsRecord {
                                                      recordId = "121-0"
                                                    , keyValues = [("key1", "value1")]}
            xinfoStreamLastEntry      HUnit.@=? StreamsRecord {
                                                      recordId = "122-0"
                                                    , keyValues = [("key2", "value2")] }
            (do xinfoMaxDeletedEntryId    HUnit.@=? Nothing -- Redis 6.0
                xinfoEntriesAdded         HUnit.@=? Nothing
                xinfoRecordedFirstEntryId HUnit.@=? Nothing) <|?> -- Redis 7.0
                (do xinfoMaxDeletedEntryId    HUnit.@=? Just "0-0"
                    xinfoEntriesAdded         HUnit.@=? Just 2
                    xinfoRecordedFirstEntryId HUnit.@=? Just "121-0")
        bad -> HUnit.assertFailure $ "Unexpectedly got " ++ show bad
    return ()

testXDel ::Test
testXDel = testCase "xdel" $ do
    xadd "somestream8" "121" [("key1", "value1")]
    xadd "somestream8" "122" [("key2", "value2")]
    xdel "somestream8" ["122"] >>=? 1
    xlen "somestream8" >>=? 1

testVRange84 :: Test
testVRange84 = testCase "vrange" $ do
    vadd "word_embeddings" (0.1 NE.:| [1.2, 0.5]) "Redis" >>=? True
    vadd "word_embeddings" (0.2 NE.:| [1.1, 0.4]) "a7" >>=? True
    vadd "word_embeddings" (0.3 NE.:| [1.0, 0.3]) "b1" >>=? True
    vadd "word_embeddings" (0.4 NE.:| [0.9, 0.2]) "z9" >>=? True

    vrangeCount "word_embeddings" "[Redis" "+" 10 >>=? ["Redis", "a7", "b1", "z9"]
    vrangeCount "word_embeddings" "-" "+" 10 >>=? ["Redis", "a7", "b1", "z9"]
    vrangeCount "word_embeddings" "(a7" "+" 10 >>=? ["b1", "z9"]
    vrangeCount "word_embeddings" "-" "+" (-1) >>=? ["Redis", "a7", "b1", "z9"]

testRedis86Commands :: Test
testRedis86Commands = testCase "redis 8.6 commands" $ do
    xadd "idmp-stream" "*" [("field", "value")] >>@? const (pure ())

    xcfgset "idmp-stream" defaultXCfgSetOpts { xCfgSetIdmpDuration = Just 300 } >>= \case
        Left reply | isUnknownCommandReply reply -> pure ()
        Left reply -> liftIO $ HUnit.assertFailure $ "Unexpected XCFGSET reply: " ++ show reply
        Right Ok -> do
            xcfgset "idmp-stream" defaultXCfgSetOpts
                { xCfgSetIdmpDuration = Just 600
                , xCfgSetIdmpMaxsize = Just 500
                }
                >>=? Ok
        Right status ->
            liftIO $ HUnit.assertFailure $ "Unexpected XCFGSET status: " ++ show status

    hotkeysStop >>= \case
        Left reply | isUnknownCommandReply reply || isHotkeysInactiveReply reply -> pure ()
        Left reply -> liftIO $ HUnit.assertFailure $ "Unexpected HOTKEYS STOP reply: " ++ show reply
        Right Ok -> pure ()
        Right status -> liftIO $ HUnit.assertFailure $ "Unexpected HOTKEYS STOP status: " ++ show status

    hotkeysReset >>= \case
        Left reply | isUnknownCommandReply reply -> pure ()
        Left reply -> liftIO $ HUnit.assertFailure $ "Unexpected HOTKEYS RESET reply: " ++ show reply
        Right Ok -> do
            hotkeysStartOpts
                (HotkeysMetricCPU NE.:| [HotkeysMetricNET])
                defaultHotkeysStartOpts { hotkeysStartTopKCount = Just 2 }
                >>= \case
                    Left reply | isUnknownCommandReply reply -> pure ()
                    Left reply -> liftIO $ HUnit.assertFailure $ "Unexpected HOTKEYS START reply: " ++ show reply
                    Right Ok -> do
                        set "hotkey:001" "payload" >>=? Ok
                        replicateM_ 25 $ do
                            incr "hotkey:counter" >>@? const (pure ())
                            get "hotkey:001" >>=? Just "payload"

                        hotkeysGet >>@? \HotkeysGetResponse{..} -> do
                            HUnit.assertBool "tracking should be active before HOTKEYS STOP" hotkeysGetTrackingActive
                            HUnit.assertBool "sample ratio should be positive" (hotkeysGetSampleRatio >= 1)
                            HUnit.assertBool "selected slots should not be empty" (not $ null hotkeysGetSelectedSlots)
                            HUnit.assertBool "collection duration should be non-negative" (hotkeysGetCollectionDurationMs >= 0)
                            HUnit.assertBool "expected CPU hotkeys to include generated keys" $
                                maybe False (any (\(key, _) -> "hotkey:" `Char8.isPrefixOf` key)) hotkeysGetByCpuTimeUs
                            HUnit.assertBool "expected NET hotkeys to include generated keys" $
                                maybe False (any (\(key, _) -> "hotkey:" `Char8.isPrefixOf` key)) hotkeysGetByNetBytes

                        hotkeysStop >>=? Ok
                        hotkeysGet >>@? \HotkeysGetResponse{..} ->
                            HUnit.assertBool "tracking should be stopped after HOTKEYS STOP" (not hotkeysGetTrackingActive)
                        hotkeysReset >>=? Ok
                    Right status ->
                        liftIO $ HUnit.assertFailure $ "Unexpected HOTKEYS START status: " ++ show status
        Right status ->
            liftIO $ HUnit.assertFailure $ "Unexpected HOTKEYS RESET status: " ++ show status

testRedis88Commands :: Test
testRedis88Commands = testCase "redis 8.8 commands" $ do
    increx "counter88" >>= \case
        Left reply | isUnknownCommandReply reply -> pure ()
        Left reply -> liftIO $ HUnit.assertFailure $ "Unexpected INCREX reply: " ++ show reply
        Right (value, applied) -> do
            liftIO $ (1, 1) HUnit.@=? (value, applied)
            increxBy "counter88" 5 defaultIncrexOpts
                { increxLowerBound = Just 0
                , increxUpperBound = Just 10
                , increxExpiration = Just (IncrexSeconds 60)
                }
                >>=? (6, 5)
            ttl "counter88" >>@? \secondsLeft ->
                HUnit.assertBool "INCREX EX should set a TTL" (secondsLeft >= 0 && secondsLeft <= 60)
            increxByFloat "counter88:float" 0.5 defaultIncrexOpts
                { increxLowerBound = Just 0.0
                , increxUpperBound = Just 1.0
                }
                >>@? \(floatValue, floatApplied) ->
                    HUnit.assertBool "INCREX BYFLOAT should increment the floating-point value" $
                        abs (floatValue - 0.5) < 0.0001 && abs (floatApplied - 0.5) < 0.0001

            streamId <- xadd "stream88" "*" [("field", "value")] >>= \case
                Left reply -> liftIO (HUnit.assertFailure $ "Unexpected XADD reply: " ++ show reply) >> pure ""
                Right sid -> pure sid
            xidmprecord "stream88" "producer-1" "iid-1" streamId >>= \case
                Left reply | isUnknownCommandReply reply -> pure ()
                Left reply -> liftIO $ HUnit.assertFailure $ "Unexpected XIDMPRECORD reply: " ++ show reply
                Right Ok -> pure ()
                Right status -> liftIO $ HUnit.assertFailure $ "Unexpected XIDMPRECORD status: " ++ show status

            xadd "stream88-nack" "1-0" [("field", "value")] >>=? "1-0"
            xgroupCreate "stream88-nack" "group88" "0" >>=? Ok
            xreadGroup "group88" "consumer88" [("stream88-nack", ">")] >>@? const (pure ())
            xnack "stream88-nack" "group88" XNackFail ("1-0" NE.:| []) >>=? 1

            arset "arr88" 0 ("alpha" NE.:| ["beta", "gamma"]) >>= \case
                Left reply | isUnknownCommandReply reply -> pure ()
                Left reply -> liftIO $ HUnit.assertFailure $ "Unexpected ARSET reply: " ++ show reply
                Right createdSlots -> do
                    liftIO $ 3 HUnit.@=? createdSlots
                    arcount "arr88" >>=? 3
                    arlen "arr88" >>=? 3
                    armget "arr88" (0 NE.:| [2, 3]) >>=? [Just "alpha", Just "gamma", Nothing]
                    argetrange "arr88" 0 3 >>=? [Just "alpha", Just "beta", Just "gamma", Nothing]

                    argrep "arr88" "-" "+" (ARGrepExact "beta" NE.:| []) >>=? [1]
                    argrepWithValuesOpts "arr88" "-" "+" (ARGrepMatch "a" NE.:| []) defaultARGrepOpts
                        { arGrepLimit = Just 2
                        }
                        >>=? ARIndexValuePairsResponse [(0, "alpha"), (1, "beta")]

                    arinfo "arr88" >>@? \ARInfoResponse{..} -> do
                        3 HUnit.@=? arInfoCount
                        3 HUnit.@=? arInfoLength
                        HUnit.assertBool "ARINFO should report a positive slice size" (arInfoSliceSize > 0)

                    arseek "arr88" 5 >>=? True
                    arinsert "arr88" ("delta" NE.:| ["epsilon"]) >>=? 6
                    arnext "arr88" >>=? Just 7
                    arlastitems "arr88" 2 >>=? [Just "delta", Just "epsilon"]
                    arlastitemsOpts "arr88" 2 defaultARLastItemsOpts { arLastItemsReverse = True } >>=? [Just "epsilon", Just "delta"]
                    arscanOpts "arr88" 0 10 defaultARScanOpts { arScanLimit = Just 3 } >>=? ARIndexValuePairsResponse [(0, "alpha"), (1, "beta"), (2, "gamma")]
                    ardel "arr88" (1 NE.:| [5]) >>=? 2
                    arcount "arr88" >>=? 3

                    arset "nums88" 0 ("1" NE.:| ["2", "3"]) >>=? 3
                    aropValue "nums88" 0 2 AROpSum >>=? Just "6"
                    aropCount "nums88" 0 2 AROpUsed >>=? Just 3

                    arring "ring88" 3 ("v0" NE.:| ["v1", "v2", "v3"]) >>=? 0
                    arcount "ring88" >>=? 3
                    arlastitems "ring88" 3 >>=? [Just "v1", Just "v2", Just "v3"]

testVectorSet8 :: Test
testVectorSet8 = testCase "vector sets" $ do
    let key = "word_embeddings"
        members = ["apple", "apples", "pear", "pears", "potato"]
        insert element attrs vector =
            vaddOpts key vector element defaultVAddOpts
                { vAddQuantization = Just VAddNoQuant
                , vAddAttributes = attrs
                }

    insert "apple" (Just "{\"len\":5,\"kind\":\"fruit\"}") (1.0 NE.:| [0.0, 0.0]) >>=? True
    insert "apples" (Just "{\"len\":6,\"kind\":\"fruit\"}") (0.9 NE.:| [0.1, 0.0]) >>=? True
    insert "pear" (Just "{\"len\":4,\"kind\":\"fruit\"}") (0.8 NE.:| [0.2, 0.0]) >>=? True
    insert "pears" Nothing (0.75 NE.:| [0.25, 0.05]) >>=? True
    insert "potato" (Just "{\"len\":6,\"kind\":\"vegetable\"}") (0.0 NE.:| [1.0, 0.0]) >>=? True

    vcard key >>=? 5
    vdim key >>=? 3
    vismember key "apple" >>=? True
    vismember key "orange" >>=? False

    vemb key "apple" >>@? \case
        [x, y, z] -> do
            HUnit.assertBool "VEMB should approximately reconstruct the inserted vector" $
                abs (x - 1.0) < 0.001 && abs y < 0.001 && abs z < 0.001
        vector ->
            HUnit.assertFailure $ "Unexpected VEMB response: " ++ show vector

    vembRaw key "apple" >>@? \case
        Just VEmbRawResponse{..} -> do
            VQuantizationFP32 HUnit.@=? vEmbRawQuantization
            HUnit.assertBool "raw vector blob should not be empty" (BS.length vEmbRawData > 0)
            HUnit.assertBool "vector norm should be positive" (vEmbRawNorm > 0)
            Nothing HUnit.@=? vEmbRawRange
        reply ->
            HUnit.assertFailure $ "Unexpected VEMB RAW response: " ++ show reply

    vgetattr key "apple" >>=? Just "{\"len\":5,\"kind\":\"fruit\"}"
    vsetattr key "pears" "{\"len\":5,\"kind\":\"fruit\"}" >>=? True
    vgetattr key "pears" >>=? Just "{\"len\":5,\"kind\":\"fruit\"}"
    vsetattr key "pears" "" >>=? True
    vgetattr key "pears" >>=? Nothing

    vinfo key >>@? \case
        Just VInfoResponse{..} -> do
            HUnit.assertBool "quantization should be reported as f32/fp32" $
                vInfoQuantization == Just "f32" || vInfoQuantization == Just "fp32"
            Just 3 HUnit.@=? vInfoVectorDim
            Just 5 HUnit.@=? vInfoSize
            HUnit.assertBool "max level should be reported" $
                maybe False (>= 0) vInfoMaxLevel
        reply ->
            HUnit.assertFailure $ "Unexpected VINFO response: " ++ show reply

    vlinks key "apple" >>@? \case
        Just (VLinksResponse layers) ->
            HUnit.assertBool "VLINKS should return at least one adjacent element" $
                any (not . null) layers
        reply ->
            HUnit.assertFailure $ "Unexpected VLINKS response: " ++ show reply

    vlinksWithScores key "apple" >>@? \case
        Just (VLinksWithScoresResponse layers) -> do
            HUnit.assertBool "VLINKS WITHSCORES should return at least one adjacent element" $
                any (not . null) layers
            HUnit.assertBool "VLINKS WITHSCORES should only return known members" $
                all (\(neighbor, _) -> neighbor `elem` members)
                    [ pair | layer <- layers, pair <- layer ]
        reply ->
            HUnit.assertFailure $ "Unexpected VLINKS WITHSCORES response: " ++ show reply

    vrandmember key >>@? \member ->
        HUnit.assertBool "VRANDMEMBER should return one of the inserted elements" $
            maybe False (`elem` members) member

    vrandmemberCount key 3 >>@? \randomMembers -> do
        HUnit.assertEqual "VRANDMEMBER count" 3 (length randomMembers)
        HUnit.assertBool "VRANDMEMBER count should only return known members" $
            all (`elem` members) randomMembers

    vrange key "-" "+" >>=? members
    vrangeCount key "[apple" "[pear" 10 >>=? ["apple", "apples", "pear"]

    vsim key (VSimByElement "apple") >>@? \similar -> do
        HUnit.assertBool "VSIM should return at least one match" (not $ null similar)
        case similar of
            firstMatch:_ ->
                HUnit.assertEqual "VSIM first match" "apple" firstMatch
            [] ->
                HUnit.assertFailure "VSIM returned no matches"

    vsimOpts key (VSimByValues (1.0 NE.:| [0.0, 0.0])) defaultVSimOpts { vSimCount = Just 2 } >>@? \similar -> do
        HUnit.assertEqual "VSIM VALUES count" 2 (length similar)
        case similar of
            firstMatch:_ ->
                HUnit.assertEqual "VSIM VALUES first match" "apple" firstMatch
            [] ->
                HUnit.assertFailure "VSIM VALUES returned no matches"

    vsimWithScoresOpts key (VSimByElement "apple") defaultVSimOpts { vSimCount = Just 3 } >>@? \similar -> do
        HUnit.assertEqual "VSIM WITHSCORES count" 3 (length similar)
        case similar of
            (firstMatch, firstScore):_ -> do
                HUnit.assertEqual "VSIM WITHSCORES first match" "apple" firstMatch
                HUnit.assertBool "VSIM WITHSCORES self similarity should be close to 1" $
                    firstScore > 0.99
            [] ->
                HUnit.assertFailure "VSIM WITHSCORES returned no matches"

    vsimWithScoresWithAttribsOpts key (VSimByElement "apple") defaultVSimOpts { vSimCount = Just 3 } >>@? \VSimWithAttribsResponse{..} -> do
        HUnit.assertEqual "VSIM WITHATTRIBS count" 3 (length vSimWithAttribsResults)
        case vSimWithAttribsResults of
            firstMatch:_ -> do
                HUnit.assertEqual "VSIM WITHATTRIBS first match" "apple" (vSimResultElement firstMatch)
                Just "{\"len\":5,\"kind\":\"fruit\"}" HUnit.@=? vSimResultAttributes firstMatch
            [] ->
                HUnit.assertFailure "VSIM WITHATTRIBS returned no matches"

    vrem key "potato" >>=? True
    vismember key "potato" >>=? False
    vcard key >>=? 4

testClusterSlotStats8 :: Test
testClusterSlotStats8 = testCase "cluster slot-stats" $ do
    clusterSlotStatsSlotsRange 0 16383 >>@? \ClusterSlotStatsResponse{..} -> do
        HUnit.assertBool "CLUSTER SLOT-STATS SLOTSRANGE should return at least one slot" $
            not (null clusterSlotStatsResponseEntries)
        forM_ clusterSlotStatsResponseEntries $ \ClusterSlotStatsResponseEntry{..} -> do
            HUnit.assertBool "slot number should be in the valid cluster range" $
                clusterSlotStatsResponseEntrySlot >= 0 && clusterSlotStatsResponseEntrySlot <= 16383
            HUnit.assertBool "key-count should be present" $
                maybe False (>= 0) clusterSlotStatsResponseEntryKeyCount

    clusterSlotStatsOrderByOpts ClusterSlotStatsKeyCount
        defaultClusterSlotStatsOrderByOpts { clusterSlotStatsOrderByLimit = Just 1 }
        >>@? \ClusterSlotStatsResponse{..} ->
            HUnit.assertBool "ORDERBY with LIMIT should return at most one entry" $
                length clusterSlotStatsResponseEntries <= 1

testClusterMigration84 :: Test
testClusterMigration84 = testCase "cluster migration" $ do
    clusterMigrationCancelAll >>@? \cancelled ->
        HUnit.assertBool "cancel count should be non-negative" (cancelled >= 0)

    clusterMigrationStatusAll >>@? \ClusterMigrationStatusResponse{..} ->
        forM_ clusterMigrationStatusTasks $ \ClusterMigrationTask{..} -> do
            HUnit.assertBool "migration task id should not be empty" (clusterMigrationTaskId /= "")
            HUnit.assertBool "migration task retries should be non-negative when present" $
                maybe True (>= 0) clusterMigrationTaskRetries

testXTrim ::Test
testXTrim = testCase "xtrim" $ do
    xadd "somestream8" "121" [("key1", "value1")]
    xadd "somestream8" "122" [("key2", "value2")]
    xadd "somestream8" "123" [("key3", "value3")]
    streamId <- fromRight "" <$> xadd "somestream8" "124" [("key4", "value4")]
    xadd "somestream8" "125" [("key5", "value5")]
    xtrim "somestream8" (trimOpts (TrimMaxlen 3) TrimExact) >>=? 2
    xtrim "somestream8" (trimOpts (TrimMinId streamId) TrimExact) >>=? 1