@@ -0,0 +1,437 @@
1+module Test.Redis.Main where
2+
3+import Prelude
4+
5+import Data.Array (length)
6+import Data.Either (Either(..))
7+import Data.Maybe (Maybe(..), isJust)
8+import Data.Time.Duration (Milliseconds(..))
9+import Effect (Effect)
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
19+
20+-- Test configuration
21+testHost :: Redis.RedisHost
22+testHost = Redis.RedisHost "localhost"
23+
24+testPort :: Redis.RedisPort
25+testPort = Redis.RedisPort 6380 -- Test port from docker-compose.test.yml
26+
27+-- Helper to create and manage Redis connection
28+withRedis :: (Redis.Redis -> Aff Unit) -> Aff Unit
29+withRedis test = do
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
34+ test redis
35+ _ <- Redis.quit redis
36+ pure unit
37+
38+-- Helper to check if value is Left
39+isLeft :: forall a b. Either a b -> Boolean
40+isLeft (Left _) = true
41+isLeft _ = false
42+
43+spec :: Spec Unit
44+spec = do
45+ describe "Yoga.Redis Integration Tests" do
46+
47+ -- Connection Management Tests
48+ around withRedis do
49+ describe "Connection Management" do
50+ it "connects to Redis successfully" \redis -> do
51+ pong <- Redis.ping redis
52+ pong `shouldEqual` "PONG"
53+
54+ it "handles ping operations" \redis -> do
55+ pong <- Redis.ping redis
56+ pong `shouldSatisfy` (_ == "PONG")
57+
58+ describe "Connection Errors" do
59+ it "handles connection failures gracefully" do
60+ result <- try do
61+ redis <- liftEffect $ Redis.createRedis
62+ { host: Redis.RedisHost "invalid-host-that-does-not-exist"
63+ , port: Redis.RedisPort 9999
64+ }
65+ _ <- Redis.connect redis
66+ Redis.ping redis
67+ result `shouldSatisfy` isLeft
68+
69+ -- String Operations Tests
70+ around withRedis do
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
78+
79+ it "returns Nothing for non-existent keys" \redis -> do
80+ result <- Redis.get (Redis.RedisKey "test:nonexistent:key") redis
81+ result `shouldEqual` Nothing
82+
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
91+
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
98+
99+ _ <- Redis.del [ key ] redis
100+ notExistsCount <- Redis.exists [ key ] redis
101+ notExistsCount `shouldEqual` 0
102+
103+ it "increments and decrements counters" \redis -> do
104+ let key = Redis.RedisKey "test:string:counter"
105+
106+ -- Increment from 0 to 1
107+ val1 <- Redis.incr key redis
108+ val1 `shouldEqual` 1
109+
110+ -- Increment by 5
111+ val2 <- Redis.incrBy key 5 redis
112+ val2 `shouldEqual` 6
113+
114+ -- Decrement by 1
115+ val3 <- Redis.decr key redis
116+ val3 `shouldEqual` 5
117+
118+ -- Decrement by 3
119+ val4 <- Redis.decrBy key 3 redis
120+ val4 `shouldEqual` 2
121+
122+ -- Hash Operations Tests
123+ around withRedis do
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"
129+
130+ _ <- Redis.hset hashKey [ { field: field1, value: value1 } ] redis
131+ result <- Redis.hget hashKey field1 redis
132+ result `shouldEqual` Just value1
133+
134+ it "gets all hash fields" \redis -> do
135+ let hashKey = Redis.RedisKey "test:hash:user2"
136+ let
137+ fields =
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" }
141+ ]
142+
143+ _ <- Redis.hset hashKey fields redis
144+ result <- Redis.hgetall hashKey redis
145+ length result `shouldEqual` 3
146+
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"
151+
152+ _ <- Redis.hset hashKey [ { field, value } ] redis
153+ exists <- Redis.hexists hashKey field redis
154+ exists `shouldEqual` true
155+
156+ notExists <- Redis.hexists hashKey (Redis.RedisField "nonexistent") redis
157+ notExists `shouldEqual` false
158+
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"
163+
164+ _ <- Redis.hset hashKey [ { field, value } ] redis
165+ count <- Redis.hdel hashKey [ field ] redis
166+ count `shouldEqual` 1
167+
168+ result <- Redis.hget hashKey field redis
169+ result `shouldEqual` Nothing
170+
171+ it "gets hash length" \redis -> do
172+ let hashKey = Redis.RedisKey "test:hash:len"
173+ let
174+ fields =
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" }
178+ ]
179+
180+ _ <- Redis.hset hashKey fields redis
181+ len <- Redis.hlen hashKey redis
182+ len `shouldEqual` 3
183+
184+ -- List Operations Tests
185+ around withRedis do
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"
189+ let
190+ values =
191+ [ Redis.RedisValue "first"
192+ , Redis.RedisValue "second"
193+ , Redis.RedisValue "third"
194+ ]
195+
196+ len <- Redis.rpush key values redis
197+ len `shouldEqual` 3
198+
199+ popped <- Redis.lpop key redis
200+ popped `shouldEqual` Just (Redis.RedisValue "first")
201+
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"
206+
207+ _ <- Redis.lpush key [ value1 ] redis
208+ _ <- Redis.lpush key [ value2 ] redis
209+
210+ popped <- Redis.rpop key redis
211+ popped `shouldEqual` Just value1
212+
213+ it "gets list range" \redis -> do
214+ let key = Redis.RedisKey "test:list:range"
215+ let
216+ values =
217+ [ Redis.RedisValue "a"
218+ , Redis.RedisValue "b"
219+ , Redis.RedisValue "c"
220+ , Redis.RedisValue "d"
221+ ]
222+
223+ _ <- Redis.rpush key values redis
224+ result <- Redis.lrange key 0 (-1) redis
225+ result `shouldEqual` values
226+
227+ partial <- Redis.lrange key 1 2 redis
228+ length partial `shouldEqual` 2
229+
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" ]
233+
234+ _ <- Redis.rpush key values redis
235+ len <- Redis.llen key redis
236+ len `shouldEqual` 3
237+
238+ -- Set Operations Tests
239+ around withRedis do
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"
245+
246+ count <- Redis.sadd key [ member1, member2 ] redis
247+ count `shouldEqual` 2
248+
249+ isMember <- Redis.sismember key member1 redis
250+ isMember `shouldEqual` true
251+
252+ isNotMember <- Redis.sismember key (Redis.RedisValue "nonexistent") redis
253+ isNotMember `shouldEqual` false
254+
255+ it "gets all set members" \redis -> do
256+ let key = Redis.RedisKey "test:set:all"
257+ let
258+ members =
259+ [ Redis.RedisValue "apple"
260+ , Redis.RedisValue "banana"
261+ , Redis.RedisValue "cherry"
262+ ]
263+
264+ _ <- Redis.sadd key members redis
265+ result <- Redis.smembers key redis
266+ length result `shouldEqual` 3
267+
268+ it "removes set members" \redis -> do
269+ let key = Redis.RedisKey "test:set:remove"
270+ let member = Redis.RedisValue "to-remove"
271+
272+ _ <- Redis.sadd key [ member ] redis
273+ count <- Redis.srem key [ member ] redis
274+ count `shouldEqual` 1
275+
276+ isMember <- Redis.sismember key member redis
277+ isMember `shouldEqual` false
278+
279+ it "gets set cardinality" \redis -> do
280+ let key = Redis.RedisKey "test:set:card"
281+ let
282+ members =
283+ [ Redis.RedisValue "1"
284+ , Redis.RedisValue "2"
285+ , Redis.RedisValue "3"
286+ , Redis.RedisValue "4"
287+ ]
288+
289+ _ <- Redis.sadd key members redis
290+ card <- Redis.scard key redis
291+ card `shouldEqual` 4
292+
293+ -- TTL and Expiration Tests
294+ around withRedis do
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
300+
301+ _ <- Redis.setex key ttl value redis
302+ ttlResult <- Redis.ttl key redis
303+ ttlResult `shouldSatisfy` (\t -> t > 0 && t <= 5)
304+
305+ it "sets expiry with expire command" \redis -> do
306+ let key = Redis.RedisKey "test:ttl:expire"
307+ let value = Redis.RedisValue "will-expire"
308+
309+ _ <- Redis.set key value {} redis
310+ success <- Redis.expire key (Redis.TTLSeconds 10) redis
311+ success `shouldEqual` true
312+
313+ ttlResult <- Redis.ttl key redis
314+ ttlResult `shouldSatisfy` (\t -> t > 0 && t <= 10)
315+
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"
319+
320+ _ <- Redis.setex key (Redis.TTLSeconds 1) value redis
321+
322+ -- Check it exists initially
323+ initial <- Redis.get key redis
324+ initial `shouldSatisfy` isJust
325+
326+ -- Wait for expiration
327+ delay (Milliseconds 1200.0)
328+
329+ result <- Redis.get key redis
330+ result `shouldEqual` Nothing
331+
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)
336+
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"
340+
341+ _ <- Redis.set key value {} redis
342+ ttlResult <- Redis.ttl key redis
343+ ttlResult `shouldEqual` (-1)
344+
345+ -- Sorted Set Operations Tests
346+ around withRedis do
347+ describe "Sorted Set Operations" do
348+ it "adds members with scores" \redis -> do
349+ let key = Redis.RedisKey "test:zset:leaderboard"
350+ let
351+ members =
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" }
355+ ]
356+
357+ count <- Redis.zadd key members {} redis
358+ count `shouldEqual` 3
359+
360+ it "gets sorted set range with scores" \redis -> do
361+ let key = Redis.RedisKey "test:zset:range"
362+ let
363+ members =
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" }
367+ ]
368+
369+ _ <- Redis.zadd key members {} redis
370+ result <- Redis.zrange key 0 (-1) redis
371+ length result `shouldEqual` 3
372+
373+ -- Verify order (should be sorted by score)
374+ case result of
375+ [ first, _, _ ] -> first.value `shouldEqual` Redis.RedisValue "a"
376+ _ -> pure unit
377+
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" }
381+
382+ _ <- Redis.zadd key [ member ] {} redis
383+ score <- Redis.zscore key member.value redis
384+ score `shouldEqual` Just (Redis.RedisScore 42.5)
385+
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" }
389+
390+ _ <- Redis.zadd key [ member ] {} redis
391+ count <- Redis.zrem key [ member.value ] redis
392+ count `shouldEqual` 1
393+
394+ score <- Redis.zscore key member.value redis
395+ score `shouldEqual` Nothing
396+
397+ it "gets sorted set cardinality" \redis -> do
398+ let key = Redis.RedisKey "test:zset:card"
399+ let
400+ members =
401+ [ { score: Redis.RedisScore 1.0, value: Redis.RedisValue "x" }
402+ , { score: Redis.RedisScore 2.0, value: Redis.RedisValue "y" }
403+ ]
404+
405+ _ <- Redis.zadd key members {} redis
406+ card <- Redis.zcard key redis
407+ card `shouldEqual` 2
408+
409+ -- Pub/Sub Tests
410+ around withRedis do
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"
415+
416+ -- Publishing to a channel with no subscribers returns 0
417+ subscribers <- Redis.publish channel message redis
418+ subscribers `shouldSatisfy` (\s -> s >= 0)
419+
420+main :: Effect Unit
421+main = launchAff_ do
422+ liftEffect $ log "\n🧪 Starting Redis Integration Tests (with Docker)\n"
423+
424+ bracket
425+ -- Start Docker before tests
426+ ( do
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"
430+ )
431+ -- Stop Docker after tests (always runs!)
432+ ( \_ -> do
433+ Docker.stopService "packages/yoga-redis/docker-compose.test.yml"
434+ liftEffect $ log "✅ Cleanup complete\n"
435+ )
436+ -- Run tests
437+ (\_ -> runSpec [ consoleReporter ] spec)