Merge pull request #130 from NoRedInk/expose-ttl-command

nri-redis: Expose ttl command

nri-redis/src/Redis.hs

@@ -39,6 +39,8 @@ module Redis
     set,
     setex,
     setnx,
+    ttl,
+    Internal.TTLResponse (..),
 
     -- * Running Redis queries
     Internal.query,
@@ -110,7 +112,7 @@ data Api key a = Api
     -- operation never fails.
     --
     -- https://redis.io/commands/mget
-    mget :: Ord key => NonEmpty key -> Internal.Query (Dict.Dict key a),
+    mget :: (Ord key) => NonEmpty key -> Internal.Query (Dict.Dict key a),
     -- | Sets the given keys to their respective values. MSET replaces existing
     -- values with new values, just as regular SET. See MSETNX if you don't want to
     -- overwrite existing values.
@@ -143,7 +145,13 @@ data Api key a = Api
     -- performed. SETNX is short for "SET if Not eXists".
     --
     -- https://redis.io/commands/setnx
-    setnx :: key -> a -> Internal.Query Bool
+    setnx :: key -> a -> Internal.Query Bool,
+    -- | Get the TTL (Time To Live / expiry time) for a key, in seconds.
+    --
+    -- __Important__: When using `HandlerAutoExtendExpire`, this command will **NOT** auto-extend expiry.
+    --
+    -- https://redis.io/commands/ttl
+    ttl :: key -> Internal.Query Internal.TTLResponse
   }
 
 -- | Creates a json API mapping a 'key' to a json-encodable-decodable type
@@ -189,5 +197,6 @@ makeApi Codec.Codec {Codec.codecEncoder, Codec.codecDecoder} toKey =
       ping = Internal.Ping |> map (\_ -> ()),
       set = \key value -> Internal.Set (toKey key) (codecEncoder value),
       setex = \key seconds value -> Internal.Setex (toKey key) seconds (codecEncoder value),
-      setnx = \key value -> Internal.Setnx (toKey key) (codecEncoder value)
+      setnx = \key value -> Internal.Setnx (toKey key) (codecEncoder value),
+      ttl = \key -> Internal.WithResult Internal.ttlResponseDecoder (Internal.Ttl (toKey key))
     }

nri-redis/src/Redis/Handler.hs

@@ -305,6 +305,10 @@ doRawQuery query =
       Database.Redis.smembers (toB key)
         |> PreparedQuery
         |> map Ok
+    Internal.Ttl key ->
+      Database.Redis.ttl (toB key)
+        |> PreparedQuery
+        |> map (Ok << Prelude.fromIntegral)
     Internal.Zadd key vals ->
       Dict.toList vals
         |> List.map (\(a, b) -> (b, a))

nri-redis/src/Redis/Internal.hs

@@ -11,6 +11,7 @@ module Redis.Internal
     HandlerAutoExtendExpire,
     HasAutoExtendExpire (..),
     Query (..),
+    TTLResponse (..),
     Database.Redis.Cursor,
     Database.Redis.cursor0,
     cmds,
@@ -26,6 +27,7 @@ module Redis.Internal
     wrapQuery,
     maybesToDict,
     keysTouchedByQuery,
+    ttlResponseDecoder,
   )
 where
 
@@ -113,6 +115,7 @@ cmds query'' =
     Srem key vals -> [unwords ("SREM" : key : List.map (\_ -> "*****") (NonEmpty.toList vals))]
     Sismember key _ -> [unwords ["SISMEMBER", key, "*****"]]
     Smembers key -> [unwords ["SMEMBERS", key]]
+    Ttl key -> [unwords ["TTL", key]]
     Zadd key vals -> [unwords ("ZADD" : key : List.concatMap (\(_, val) -> ["*****", Text.fromFloat val]) (Dict.toList vals))]
     Zrange key start stop -> [unwords ["ZRANGE", key, Text.fromInt start, Text.fromInt stop]]
     ZrangeByScoreWithScores key start stop -> [unwords ["ZRANGE", key, "BYSCORE", Text.fromFloat start, Text.fromFloat stop, "WITHSCORES"]]
@@ -170,6 +173,7 @@ data Query a where
   Srem :: Text -> NonEmpty ByteString -> Query Int
   Sismember :: Text -> ByteString -> Query Bool
   Smembers :: Text -> Query (List ByteString)
+  Ttl :: Text -> Query Int
   Zadd :: Text -> Dict.Dict ByteString Float -> Query Int
   Zrange :: Text -> Int -> Int -> Query [ByteString]
   ZrangeByScoreWithScores :: Text -> Float -> Float -> Query [(ByteString, Float)]
@@ -317,6 +321,7 @@ mapKeys fn query' =
     Srem key vals -> Task.map (\newKey -> Srem newKey vals) (fn key)
     Sismember key val -> Task.map (\newKey -> Sismember newKey val) (fn key)
     Smembers key -> Task.map Smembers (fn key)
+    Ttl key -> Task.map Ttl (fn key)
     Zadd key vals -> Task.map (\newKey -> Zadd newKey vals) (fn key)
     Zrange key start stop -> Task.map (\newKey -> Zrange newKey start stop) (fn key)
     ZrangeByScoreWithScores key start stop -> Task.map (\newKey -> ZrangeByScoreWithScores newKey start stop) (fn key)
@@ -360,6 +365,7 @@ mapReturnedKeys fn query' =
     Srem key vals -> Srem key vals
     Sismember key val -> Sismember key val
     Smembers key -> Smembers key
+    Ttl key -> Ttl key
     Zadd key vals -> Zadd key vals
     Zrange key start stop -> Zrange key start stop
     ZrangeByScoreWithScores key start stop -> ZrangeByScoreWithScores key start stop
@@ -418,6 +424,9 @@ keysTouchedByQuery query' =
     Srem key _ -> Set.singleton key
     Sismember key _ -> Set.singleton key
     Smembers key -> Set.singleton key
+    -- TTL is meant to just check the TTL. Let's not report the key back
+    -- so it doesn't auto-extending the TTL.
+    Ttl _ -> Set.empty
     Zadd key _ -> Set.singleton key
     Zrange key _ _ -> Set.singleton key
     ZrangeByScoreWithScores key _ _ -> Set.singleton key
@@ -486,6 +495,21 @@ foldWithScan handler keyMatchPattern approxCountPerBatch processKeyBatch initAcc
           else go nextAccumulator nextCursor
    in go initAccumulator Database.Redis.cursor0
 
+data TTLResponse = TTLKeyNotFound | NeverExpires | ExpiresInSeconds Int
+  deriving (Show, Eq)
+
+ttlResponseDecoder :: Int -> Result Error TTLResponse
+ttlResponseDecoder ttl =
+  if ttl >= 0
+    then Ok (ExpiresInSeconds ttl)
+    else
+      if ttl == -2
+        then Ok TTLKeyNotFound
+        else
+          if ttl == -1
+            then Ok NeverExpires
+            else Err (DecodingError ("Unexpected TTL value: " ++ Text.fromInt ttl))
+
 --------------------------------------
 -- Orphaned instances for RedisResult
 --------------------------------------

nri-redis/test/Spec/Redis.hs

@@ -62,7 +62,8 @@ tests TestHandlers {handler, autoExtendExpireHandler} =
     "Redis Library"
     [ Test.describe "query tests using handler" (queryTests handler),
       Test.describe "query tests using auto extend expire handler" (queryTests autoExtendExpireHandler),
-      Test.describe "observability tests" (observabilityTests handler)
+      Test.describe "observability tests" (observabilityTests handler),
+      Test.describe "ttl tests" (ttlTests handler autoExtendExpireHandler)
     ]
 
 -- We want to test all of our potential makeApi alternatives because it's easy
@@ -468,6 +469,23 @@ queryTests redisHandler =
   where
     testNS = addNamespace "testNamespace" redisHandler
 
+ttlTests :: Redis.Handler -> Redis.HandlerAutoExtendExpire -> List Test.Test
+ttlTests handler autoExtendExpireHandler =
+  let testNS = addNamespace "ttlTestNamespace" handler
+      testNSWithExpiry = addNamespace "ttlTestNamespace" autoExtendExpireHandler
+   in [ Test.test "ttl reads key w/o ttl" <| \() -> do
+          Redis.set api "no-expiry" "value" |> Redis.query testNS |> Expect.succeeds
+          result <- Redis.ttl api "no-expiry" |> Redis.query testNS |> Expect.succeeds
+          Expect.equal result Redis.NeverExpires,
+        Test.test "ttl reads key w/ ttl" <| \() -> do
+          Redis.set api "expires" "value" |> Redis.query testNSWithExpiry |> Expect.succeeds
+          result <- Redis.ttl api "expires" |> Redis.query testNSWithExpiry |> Expect.succeeds
+          Expect.equal result (Redis.ExpiresInSeconds 1),
+        Test.test "ttl reports missing key" <| \() -> do
+          result <- Redis.ttl api "not-found" |> Redis.query testNSWithExpiry |> Expect.succeeds
+          Expect.equal result Redis.TTLKeyNotFound
+      ]
+
 addNamespace :: Text -> Redis.Handler' x -> Redis.Handler' x
 addNamespace namespace handler' =
   handler' {Internal.namespace = Internal.namespace handler' ++ ":" ++ namespace}

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-query

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 122
+                    , srcLocStartLine = 123
                     , srcLocStartCol = 9
-                    , srcLocEndLine = 122
+                    , srcLocEndLine = 123
                     , srcLocEndCol = 28
                     }
                 )

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-counter-transaction

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 129
+                    , srcLocStartLine = 130
                     , srcLocStartCol = 9
-                    , srcLocEndLine = 129
+                    , srcLocEndLine = 130
                     , srcLocEndCol = 34
                     }
                 )

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-query

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 94
+                    , srcLocStartLine = 95
                     , srcLocStartCol = 9
-                    , srcLocEndLine = 94
+                    , srcLocEndLine = 95
                     , srcLocEndCol = 25
                     }
                 )

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-hash-transaction

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 101
+                    , srcLocStartLine = 102
                     , srcLocStartCol = 9
-                    , srcLocEndLine = 101
+                    , srcLocEndLine = 102
                     , srcLocEndCol = 31
                     }
                 )

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-query

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 108
+                    , srcLocStartLine = 109
                     , srcLocStartCol = 9
-                    , srcLocEndLine = 108
+                    , srcLocEndLine = 109
                     , srcLocEndCol = 25
                     }
                 )

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-list-transaction

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 115
+                    , srcLocStartLine = 116
                     , srcLocStartCol = 9
-                    , srcLocEndLine = 115
+                    , srcLocEndLine = 116
                     , srcLocEndCol = 31
                     }
                 )

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-query

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 80
+                    , srcLocStartLine = 81
                     , srcLocStartCol = 9
-                    , srcLocEndLine = 80
+                    , srcLocEndLine = 81
                     , srcLocEndCol = 20
                     }
                 )

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-query-timeout

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 139
+                    , srcLocStartLine = 140
                     , srcLocStartCol = 13
-                    , srcLocEndLine = 139
+                    , srcLocEndLine = 140
                     , srcLocEndCol = 24
                     }
                 )

nri-redis/test/golden-results-9.2/observability-spec-reporting-redis-transaction

@@ -32,9 +32,9 @@ TracingSpan
                     { srcLocPackage = "main"
                     , srcLocModule = "Spec.Redis"
                     , srcLocFile = "test/Spec/Redis.hs"
-                    , srcLocStartLine = 87
+                    , srcLocStartLine = 88
                     , srcLocStartCol = 9
-                    , srcLocEndLine = 87
+                    , srcLocEndLine = 88
                     , srcLocEndCol = 26
                     }
                 )