@@ -0,0 +1,437 @@
1+module Test.Redis.Main where
5+import Data.Array (length)
6+import Data.Either (Either(..))
7+import Data.Maybe (Maybe(..), isJust)
8+import Data.Time.Duration (Milliseconds(..))
10+import Effect.Aff (Aff, delay, launchAff_, try, bracket)
11+import Effect.Class (liftEffect)
12+import Effect.Console (log)
13+import Test.Spec (Spec, around, describe, it)
14+import Test.Spec.Assertions (shouldEqual, shouldSatisfy)
15+import Test.Spec.Reporter.Console (consoleReporter)
16+import Test.Spec.Runner (runSpec)
17+import Yoga.Test.Docker as Docker
18+import Yoga.Redis as Redis
21+testHost :: Redis.RedisHost
22+testHost = Redis.RedisHost "localhost"
24+testPort :: Redis.RedisPort
25+testPort = Redis.RedisPort 6380 -- Test port from docker-compose.test.yml
27+-- Helper to create and manage Redis connection
28+withRedis :: (Redis.Redis -> Aff Unit) -> Aff Unit
30+ redis <- liftEffect $ Redis.createRedis { host: testHost, port: testPort }
31+ _ <- Redis.connect redis
32+ -- Clean up test keys before each test
33+ _ <- try $ Redis.del [ Redis.RedisKey "test:*" ] redis
35+ _ <- Redis.quit redis
38+-- Helper to check if value is Left
39+isLeft :: forall a b. Either a b -> Boolean
40+isLeft (Left _) = true
45+ describe "Yoga.Redis Integration Tests" do
47+ -- Connection Management Tests
49+ describe "Connection Management" do
50+ it "connects to Redis successfully" \redis -> do
51+ pong <- Redis.ping redis
52+ pong `shouldEqual` "PONG"
54+ it "handles ping operations" \redis -> do
55+ pong <- Redis.ping redis
56+ pong `shouldSatisfy` (_ == "PONG")
58+ describe "Connection Errors" do
59+ it "handles connection failures gracefully" do
61+ redis <- liftEffect $ Redis.createRedis
62+ { host: Redis.RedisHost "invalid-host-that-does-not-exist"
63+ , port: Redis.RedisPort 9999
65+ _ <- Redis.connect redis
67+ result `shouldSatisfy` isLeft
69+ -- String Operations Tests
71+ describe "String Operations" do
72+ it "sets and gets values" \redis -> do
73+ let key = Redis.RedisKey "test:string:key1"
74+ let value = Redis.RedisValue "test-value"
75+ _ <- Redis.set key value {} redis
76+ result <- Redis.get key redis
77+ result `shouldEqual` Just value
79+ it "returns Nothing for non-existent keys" \redis -> do
80+ result <- Redis.get (Redis.RedisKey "test:nonexistent:key") redis
81+ result `shouldEqual` Nothing
83+ it "deletes keys successfully" \redis -> do
84+ let key = Redis.RedisKey "test:string:delete"
85+ let value = Redis.RedisValue "value-to-delete"
86+ _ <- Redis.set key value {} redis
87+ count <- Redis.del [ key ] redis
88+ count `shouldEqual` 1
89+ result <- Redis.get key redis
90+ result `shouldEqual` Nothing
92+ it "checks key existence" \redis -> do
93+ let key = Redis.RedisKey "test:string:exists"
94+ let value = Redis.RedisValue "exists-value"
95+ _ <- Redis.set key value {} redis
96+ existsCount <- Redis.exists [ key ] redis
97+ existsCount `shouldEqual` 1
99+ _ <- Redis.del [ key ] redis
100+ notExistsCount <- Redis.exists [ key ] redis
101+ notExistsCount `shouldEqual` 0
103+ it "increments and decrements counters" \redis -> do
104+ let key = Redis.RedisKey "test:string:counter"
106+ -- Increment from 0 to 1
107+ val1 <- Redis.incr key redis
108+ val1 `shouldEqual` 1
111+ val2 <- Redis.incrBy key 5 redis
112+ val2 `shouldEqual` 6
115+ val3 <- Redis.decr key redis
116+ val3 `shouldEqual` 5
119+ val4 <- Redis.decrBy key 3 redis
120+ val4 `shouldEqual` 2
122+ -- Hash Operations Tests
124+ describe "Hash Operations" do
125+ it "sets and gets hash fields" \redis -> do
126+ let hashKey = Redis.RedisKey "test:hash:user1"
127+ let field1 = Redis.RedisField "name"
128+ let value1 = Redis.RedisValue "Alice"
130+ _ <- Redis.hset hashKey [ { field: field1, value: value1 } ] redis
131+ result <- Redis.hget hashKey field1 redis
132+ result `shouldEqual` Just value1
134+ it "gets all hash fields" \redis -> do
135+ let hashKey = Redis.RedisKey "test:hash:user2"
138+ [ { field: Redis.RedisField "name", value: Redis.RedisValue "Bob" }
139+ , { field: Redis.RedisField "email", value: Redis.RedisValue "bob@example.com" }
140+ , { field: Redis.RedisField "age", value: Redis.RedisValue "30" }
143+ _ <- Redis.hset hashKey fields redis
144+ result <- Redis.hgetall hashKey redis
145+ length result `shouldEqual` 3
147+ it "checks if hash field exists" \redis -> do
148+ let hashKey = Redis.RedisKey "test:hash:exists"
149+ let field = Redis.RedisField "field1"
150+ let value = Redis.RedisValue "value1"
152+ _ <- Redis.hset hashKey [ { field, value } ] redis
153+ exists <- Redis.hexists hashKey field redis
154+ exists `shouldEqual` true
156+ notExists <- Redis.hexists hashKey (Redis.RedisField "nonexistent") redis
157+ notExists `shouldEqual` false
159+ it "deletes hash fields" \redis -> do
160+ let hashKey = Redis.RedisKey "test:hash:delete"
161+ let field = Redis.RedisField "temp"
162+ let value = Redis.RedisValue "temporary"
164+ _ <- Redis.hset hashKey [ { field, value } ] redis
165+ count <- Redis.hdel hashKey [ field ] redis
166+ count `shouldEqual` 1
168+ result <- Redis.hget hashKey field redis
169+ result `shouldEqual` Nothing
171+ it "gets hash length" \redis -> do
172+ let hashKey = Redis.RedisKey "test:hash:len"
175+ [ { field: Redis.RedisField "f1", value: Redis.RedisValue "v1" }
176+ , { field: Redis.RedisField "f2", value: Redis.RedisValue "v2" }
177+ , { field: Redis.RedisField "f3", value: Redis.RedisValue "v3" }
180+ _ <- Redis.hset hashKey fields redis
181+ len <- Redis.hlen hashKey redis
184+ -- List Operations Tests
186+ describe "List Operations" do
187+ it "pushes and pops from lists (right push, left pop)" \redis -> do
188+ let key = Redis.RedisKey "test:list:queue"
191+ [ Redis.RedisValue "first"
192+ , Redis.RedisValue "second"
193+ , Redis.RedisValue "third"
196+ len <- Redis.rpush key values redis
199+ popped <- Redis.lpop key redis
200+ popped `shouldEqual` Just (Redis.RedisValue "first")
202+ it "pushes to left and pops from right" \redis -> do
203+ let key = Redis.RedisKey "test:list:stack"
204+ let value1 = Redis.RedisValue "bottom"
205+ let value2 = Redis.RedisValue "top"
207+ _ <- Redis.lpush key [ value1 ] redis
208+ _ <- Redis.lpush key [ value2 ] redis
210+ popped <- Redis.rpop key redis
211+ popped `shouldEqual` Just value1
213+ it "gets list range" \redis -> do
214+ let key = Redis.RedisKey "test:list:range"
217+ [ Redis.RedisValue "a"
218+ , Redis.RedisValue "b"
219+ , Redis.RedisValue "c"
220+ , Redis.RedisValue "d"
223+ _ <- Redis.rpush key values redis
224+ result <- Redis.lrange key 0 (-1) redis
225+ result `shouldEqual` values
227+ partial <- Redis.lrange key 1 2 redis
228+ length partial `shouldEqual` 2
230+ it "gets list length" \redis -> do
231+ let key = Redis.RedisKey "test:list:length"
232+ let values = [ Redis.RedisValue "1", Redis.RedisValue "2", Redis.RedisValue "3" ]
234+ _ <- Redis.rpush key values redis
235+ len <- Redis.llen key redis
238+ -- Set Operations Tests
240+ describe "Set Operations" do
241+ it "adds and checks members" \redis -> do
242+ let key = Redis.RedisKey "test:set:members"
243+ let member1 = Redis.RedisValue "member1"
244+ let member2 = Redis.RedisValue "member2"
246+ count <- Redis.sadd key [ member1, member2 ] redis
247+ count `shouldEqual` 2
249+ isMember <- Redis.sismember key member1 redis
250+ isMember `shouldEqual` true
252+ isNotMember <- Redis.sismember key (Redis.RedisValue "nonexistent") redis
253+ isNotMember `shouldEqual` false
255+ it "gets all set members" \redis -> do
256+ let key = Redis.RedisKey "test:set:all"
259+ [ Redis.RedisValue "apple"
260+ , Redis.RedisValue "banana"
261+ , Redis.RedisValue "cherry"
264+ _ <- Redis.sadd key members redis
265+ result <- Redis.smembers key redis
266+ length result `shouldEqual` 3
268+ it "removes set members" \redis -> do
269+ let key = Redis.RedisKey "test:set:remove"
270+ let member = Redis.RedisValue "to-remove"
272+ _ <- Redis.sadd key [ member ] redis
273+ count <- Redis.srem key [ member ] redis
274+ count `shouldEqual` 1
276+ isMember <- Redis.sismember key member redis
277+ isMember `shouldEqual` false
279+ it "gets set cardinality" \redis -> do
280+ let key = Redis.RedisKey "test:set:card"
283+ [ Redis.RedisValue "1"
284+ , Redis.RedisValue "2"
285+ , Redis.RedisValue "3"
286+ , Redis.RedisValue "4"
289+ _ <- Redis.sadd key members redis
290+ card <- Redis.scard key redis
291+ card `shouldEqual` 4
293+ -- TTL and Expiration Tests
295+ describe "TTL and Expiration" do
296+ it "sets TTL on keys with setex" \redis -> do
297+ let key = Redis.RedisKey "test:ttl:setex"
298+ let value = Redis.RedisValue "expires-soon"
299+ let ttl = Redis.TTLSeconds 5
301+ _ <- Redis.setex key ttl value redis
302+ ttlResult <- Redis.ttl key redis
303+ ttlResult `shouldSatisfy` (\t -> t > 0 && t <= 5)
305+ it "sets expiry with expire command" \redis -> do
306+ let key = Redis.RedisKey "test:ttl:expire"
307+ let value = Redis.RedisValue "will-expire"
309+ _ <- Redis.set key value {} redis
310+ success <- Redis.expire key (Redis.TTLSeconds 10) redis
311+ success `shouldEqual` true
313+ ttlResult <- Redis.ttl key redis
314+ ttlResult `shouldSatisfy` (\t -> t > 0 && t <= 10)
316+ it "expires keys after TTL (short wait test)" \redis -> do
317+ let key = Redis.RedisKey "test:ttl:wait"
318+ let value = Redis.RedisValue "expires-fast"
320+ _ <- Redis.setex key (Redis.TTLSeconds 1) value redis
322+ -- Check it exists initially
323+ initial <- Redis.get key redis
324+ initial `shouldSatisfy` isJust
326+ -- Wait for expiration
327+ delay (Milliseconds 1200.0)
329+ result <- Redis.get key redis
330+ result `shouldEqual` Nothing
332+ it "returns -2 TTL for non-existent keys" \redis -> do
333+ let key = Redis.RedisKey "test:ttl:nonexistent"
334+ ttlResult <- Redis.ttl key redis
335+ ttlResult `shouldEqual` (-2)
337+ it "returns -1 TTL for keys without expiration" \redis -> do
338+ let key = Redis.RedisKey "test:ttl:persistent"
339+ let value = Redis.RedisValue "no-expiry"
341+ _ <- Redis.set key value {} redis
342+ ttlResult <- Redis.ttl key redis
343+ ttlResult `shouldEqual` (-1)
345+ -- Sorted Set Operations Tests
347+ describe "Sorted Set Operations" do
348+ it "adds members with scores" \redis -> do
349+ let key = Redis.RedisKey "test:zset:leaderboard"
352+ [ { score: Redis.RedisScore 100.0, value: Redis.RedisValue "player1" }
353+ , { score: Redis.RedisScore 200.0, value: Redis.RedisValue "player2" }
354+ , { score: Redis.RedisScore 150.0, value: Redis.RedisValue "player3" }
357+ count <- Redis.zadd key members {} redis
358+ count `shouldEqual` 3
360+ it "gets sorted set range with scores" \redis -> do
361+ let key = Redis.RedisKey "test:zset:range"
364+ [ { score: Redis.RedisScore 1.0, value: Redis.RedisValue "a" }
365+ , { score: Redis.RedisScore 2.0, value: Redis.RedisValue "b" }
366+ , { score: Redis.RedisScore 3.0, value: Redis.RedisValue "c" }
369+ _ <- Redis.zadd key members {} redis
370+ result <- Redis.zrange key 0 (-1) redis
371+ length result `shouldEqual` 3
373+ -- Verify order (should be sorted by score)
375+ [ first, _, _ ] -> first.value `shouldEqual` Redis.RedisValue "a"
378+ it "gets member score" \redis -> do
379+ let key = Redis.RedisKey "test:zset:score"
380+ let member = { score: Redis.RedisScore 42.5, value: Redis.RedisValue "test" }
382+ _ <- Redis.zadd key [ member ] {} redis
383+ score <- Redis.zscore key member.value redis
384+ score `shouldEqual` Just (Redis.RedisScore 42.5)
386+ it "removes sorted set members" \redis -> do
387+ let key = Redis.RedisKey "test:zset:remove"
388+ let member = { score: Redis.RedisScore 10.0, value: Redis.RedisValue "remove-me" }
390+ _ <- Redis.zadd key [ member ] {} redis
391+ count <- Redis.zrem key [ member.value ] redis
392+ count `shouldEqual` 1
394+ score <- Redis.zscore key member.value redis
395+ score `shouldEqual` Nothing
397+ it "gets sorted set cardinality" \redis -> do
398+ let key = Redis.RedisKey "test:zset:card"
401+ [ { score: Redis.RedisScore 1.0, value: Redis.RedisValue "x" }
402+ , { score: Redis.RedisScore 2.0, value: Redis.RedisValue "y" }
405+ _ <- Redis.zadd key members {} redis
406+ card <- Redis.zcard key redis
407+ card `shouldEqual` 2
411+ describe "Pub/Sub Operations" do
412+ it "publishes messages to channel" \redis -> do
413+ let channel = Redis.RedisChannel "test:pubsub:channel"
414+ let message = Redis.RedisValue "test-message"
416+ -- Publishing to a channel with no subscribers returns 0
417+ subscribers <- Redis.publish channel message redis
418+ subscribers `shouldSatisfy` (\s -> s >= 0)
422+ liftEffect $ log "\n🧪 Starting Redis Integration Tests (with Docker)\n"
425+ -- Start Docker before tests
427+ liftEffect $ log "⏳ Starting Redis and waiting for it to be ready..."
428+ Docker.startService "packages/yoga-redis/docker-compose.test.yml" 30
429+ liftEffect $ log "✅ Redis is ready!\n"
431+ -- Stop Docker after tests (always runs!)
433+ Docker.stopService "packages/yoga-redis/docker-compose.test.yml"
434+ liftEffect $ log "✅ Cleanup complete\n"
437+ (\_ -> runSpec [ consoleReporter ] spec)