nri-redis 0.2.0.3 → 0.4.1.1

raw patch · 17 files changed

+214/−69 lines, 17 filesdep ~aesondep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, base, bytestring, containers, megaparsec, nri-env-parser, nri-observability, nri-prelude, text

API changes (from Hackage documentation)

Files

• CHANGELOG.md +20/−0
• LICENSE +1/−1
• nri-redis.cabal +21/−21
• src/NonEmptyDict.hs +3/−3
• src/Redis.hs +13/−3
• src/Redis/Codec.hs +2/−2
• src/Redis/Handler.hs +18/−3
• src/Redis/Hash.hs +4/−4
• src/Redis/Internal.hs +34/−4
• src/Redis/Script.hs +6/−6
• src/Redis/Set.hs +3/−4
• src/Redis/Settings.hs +2/−2
• src/Redis/SortedSet.hs +1/−1
• test/Helpers.hs +5/−3
• test/Spec.hs +2/−2
• test/Spec/Redis.hs +76/−7
• test/Spec/Settings.hs +3/−3

@@ -1,3 +1,23 @@+# 0.4.1.1++- Require `nri-prelude >= 0.7.0.0`++# 0.4.1.0++- Add `handlerWithoutNamespace` for creating Redis handlers that skip+  namespace prefixing, for the cases where keys are shared with another+  system that doesn't follow the same namespacing convention.++# 0.4.0.0++- Support GHC 9.10.2, GHC 9.12.2, `megaparsec-9.7.x`, `containers-0.7.x`+- Drop support for GHC 9.4.x++# 0.3.0.0++- Drop support for GHC 9.2.x+- Support GHC 9.8.3, `bytestring-0.12.x.x`, `text-2.1.x`, `aeson-2.2.x.x`, `megaparsec-9.6.x`+ # 0.2.0.3  - [bugfix] When a query times out, its context is no longer removed from the Stack

@@ -1,6 +1,6 @@ BSD 3-Clause License -Copyright (c) 2024, NoRedInk+Copyright (c) 2026, NoRedInk All rights reserved.  Redistribution and use in source and binary forms, with or without

@@ -1,11 +1,11 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.36.0.+-- This file has been generated from package.yaml by hpack version 0.37.0. -- -- see: https://github.com/sol/hpack  name:           nri-redis-version:        0.2.0.3+version:        0.4.1.1 synopsis:       An intuitive hedis wrapper library. description:    Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-redis#readme>. category:       Web@@ -13,7 +13,7 @@ bug-reports:    https://github.com/NoRedInk/haskell-libraries/issues author:         NoRedInk maintainer:     haskell-open-source@noredink.com-copyright:      2024 NoRedInk Corp.+copyright:      2026 NoRedInk Corp. license:        BSD3 license-file:   LICENSE build-type:     Simple@@ -63,25 +63,25 @@       TypeOperators   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -fno-warn-type-defaults -fplugin=NriPrelude.Plugin   build-depends:-      aeson >=2.0 && <2.2+      aeson >=2.0 && <2.3     , async >=2.2.2 && <2.3-    , base >=4.16.4.0 && <4.19-    , bytestring >=0.10.8.2 && <0.12+    , base >=4.18 && <4.22+    , bytestring >=0.10.8.2 && <0.13     , conduit >=1.3.0 && <1.4-    , containers >=0.6.0.1 && <0.7+    , containers >=0.6.0.1 && <0.8     , cryptohash-sha1 >=0.11.101.0 && <0.12     , haskell-src-meta >=0.8.12 && <0.9     , hedis >=0.14.0 && <0.16-    , megaparsec >=9.2.2 && <9.6+    , megaparsec >=9.2.2 && <9.8     , modern-uri >=0.3.1.0 && <0.4-    , nri-env-parser >=0.1.0.0 && <0.3-    , nri-observability >=0.1.0 && <0.3-    , nri-prelude >=0.1.0.0 && <0.7+    , nri-env-parser >=0.1.0.0 && <0.5+    , nri-observability >=0.1.0 && <0.5+    , nri-prelude >=0.7.0.0 && <0.8     , pcre-light >=0.4.1.0 && <0.4.2     , resourcet >=1.2.0 && <1.4     , safe-exceptions >=0.1.7.0 && <1.3     , template-haskell >=2.16 && <3.0-    , text >=1.2.3.1 && <2.1+    , text >=1.2.3.1 && <2.2     , unordered-containers >=0.2.0.0 && <0.3     , uuid >=1.3.0 && <1.4   default-language: Haskell2010@@ -128,25 +128,25 @@       TypeOperators   ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -fno-warn-type-defaults -fplugin=NriPrelude.Plugin -threaded -rtsopts "-with-rtsopts=-N -T" -fno-warn-type-defaults   build-depends:-      aeson >=2.0 && <2.2+      aeson >=2.0 && <2.3     , async >=2.2.2 && <2.3-    , base >=4.16.4.0 && <4.19-    , bytestring >=0.10.8.2 && <0.12+    , base >=4.18 && <4.22+    , bytestring >=0.10.8.2 && <0.13     , conduit >=1.3.0 && <1.4-    , containers >=0.6.0.1 && <0.7+    , containers >=0.6.0.1 && <0.8     , cryptohash-sha1 >=0.11.101.0 && <0.12     , haskell-src-meta >=0.8.12 && <0.9     , hedis >=0.14.0 && <0.16-    , megaparsec >=9.2.2 && <9.6+    , megaparsec >=9.2.2 && <9.8     , modern-uri >=0.3.1.0 && <0.4-    , nri-env-parser >=0.1.0.0 && <0.3-    , nri-observability >=0.1.0 && <0.3-    , nri-prelude >=0.1.0.0 && <0.7+    , nri-env-parser >=0.1.0.0 && <0.5+    , nri-observability >=0.1.0 && <0.5+    , nri-prelude >=0.7.0.0 && <0.8     , pcre-light >=0.4.1.0 && <0.4.2     , resourcet >=1.2.0 && <1.4     , safe-exceptions >=0.1.7.0 && <1.3     , template-haskell >=2.16 && <3.0-    , text >=1.2.3.1 && <2.1+    , text >=1.2.3.1 && <2.2     , unordered-containers >=0.2.0.0 && <0.3     , uuid >=1.3.0 && <1.4   default-language: Haskell2010

@@ -20,14 +20,14 @@   deriving (Show)  -- | tries to create a 'NonEmptyDict' from a 'Dict'-fromDict :: Ord k => Dict.Dict k v -> Maybe (NonEmptyDict k v)+fromDict :: (Ord k) => Dict.Dict k v -> Maybe (NonEmptyDict k v) fromDict dict =   case Dict.toList dict of     [] -> Nothing     (k, v) : _ -> Just <| init k v dict  -- | creates a 'Dict' from a 'NonEmptyDict'-toDict :: Ord k => NonEmptyDict k v -> Dict k v+toDict :: (Ord k) => NonEmptyDict k v -> Dict k v toDict (NonEmptyDict (k, v) dict) =   Dict.insert k v dict @@ -37,6 +37,6 @@   kv :| Dict.toList dict  -- | creates a `NonEmptyDict` from a key, value, and dict-init :: Ord k => k -> v -> Dict.Dict k v -> NonEmptyDict k v+init :: (Ord k) => k -> v -> Dict.Dict k v -> NonEmptyDict k v init key val dict =   NonEmptyDict (key, val) (Dict.remove key dict)

@@ -10,6 +10,7 @@   ( -- * Creating a redis handler     Handler.handler,     Handler.handlerAutoExtendExpire,+    Handler.handlerWithoutNamespace,     Internal.Handler,     Internal.HandlerAutoExtendExpire,     Internal.Handler',@@ -39,6 +40,8 @@     set,     setex,     setnx,+    ttl,+    Internal.TTLResponse (..),      -- * Running Redis queries     Internal.query,@@ -110,7 +113,7 @@     -- 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 +146,13 @@     -- 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 +198,6 @@       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))     }

@@ -21,10 +21,10 @@ jsonCodec :: (Aeson.FromJSON a, Aeson.ToJSON a) => Codec a jsonCodec = Codec jsonEncoder jsonDecoder -jsonEncoder :: Aeson.ToJSON a => Encoder a+jsonEncoder :: (Aeson.ToJSON a) => Encoder a jsonEncoder = Aeson.encode >> Data.ByteString.Lazy.toStrict -jsonDecoder :: Aeson.FromJSON a => Decoder a+jsonDecoder :: (Aeson.FromJSON a) => Decoder a jsonDecoder byteString =   case Aeson.eitherDecodeStrict' byteString of     Prelude.Right decoded -> Ok decoded

@@ -4,6 +4,7 @@ module Redis.Handler   ( handler,     handlerAutoExtendExpire,+    handlerWithoutNamespace,     withQueryTimeoutMilliseconds,     withoutQueryTimeout,   )@@ -31,15 +32,25 @@ -- | Produce a namespaced handler for Redis access. handler :: Text -> Settings.Settings -> Data.Acquire.Acquire Internal.Handler handler namespace settings = do-  (namespacedHandler, _) <- Data.Acquire.mkAcquire (acquireHandler namespace settings) releaseHandler+  (namespacedHandler, _) <- Data.Acquire.mkAcquire (acquireHandler (Just namespace) settings) releaseHandler   namespacedHandler     |> Prelude.pure +-- | Produce a Redis handler that does NOT prefix keys with a namespace.+--+-- Prefer 'handler' unless you have a specific reason to opt out of+-- namespacing (e.g. reading/writing keys owned by another system). Using+-- this constructor bypasses the namespace isolation that 'handler' enforces.+handlerWithoutNamespace :: Settings.Settings -> Data.Acquire.Acquire Internal.Handler+handlerWithoutNamespace settings = do+  (h, _) <- Data.Acquire.mkAcquire (acquireHandler Nothing settings) releaseHandler+  Prelude.pure h+ -- | Produce a namespaced handler for Redis access. -- This will ensure that we extend all keys accessed by a query by a configured default time (see Settings.defaultExpiry) handlerAutoExtendExpire :: Text -> Settings.Settings -> Data.Acquire.Acquire Internal.HandlerAutoExtendExpire handlerAutoExtendExpire namespace settings = do-  (namespacedHandler, _) <- Data.Acquire.mkAcquire (acquireHandler namespace settings) releaseHandler+  (namespacedHandler, _) <- Data.Acquire.mkAcquire (acquireHandler (Just namespace) settings) releaseHandler   namespacedHandler     |> ( \handler' -> case Settings.defaultExpiry settings of            Settings.NoDefaultExpiry ->@@ -95,7 +106,7 @@             Stack.withFrozenCallStack (Internal.doEval handler' queryTimeout script')         } -acquireHandler :: Text -> Settings.Settings -> IO (Internal.Handler' x, Connection)+acquireHandler :: Maybe Text -> Settings.Settings -> IO (Internal.Handler' x, Connection) acquireHandler namespace settings = do   connection <- do     let connectionInfo = Settings.connectionInfo settings@@ -305,6 +316,10 @@       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))

@@ -153,7 +153,7 @@  -- | Creates a Redis API mapping a 'key' to Text textApi ::-  Ord field =>+  (Ord field) =>   (key -> Text) ->   (field -> Text) ->   (Text -> Maybe field) ->@@ -162,7 +162,7 @@  -- | Creates a Redis API mapping a 'key' to a ByteString byteStringApi ::-  Ord field =>+  (Ord field) =>   (key -> Text) ->   (field -> Text) ->   (Text -> Maybe field) ->@@ -170,7 +170,7 @@ byteStringApi = makeApi Codec.byteStringCodec  makeApi ::-  Ord field =>+  (Ord field) =>   Codec.Codec a ->   (key -> Text) ->   (field -> Text) ->@@ -211,7 +211,7 @@         Internal.Hsetnx (toKey key) (toField field) (codecEncoder val)     } -toDict :: Ord field => (Text -> Maybe field) -> Codec.Decoder a -> List (Text, ByteString) -> Result Internal.Error (Dict.Dict field a)+toDict :: (Ord field) => (Text -> Maybe field) -> Codec.Decoder a -> List (Text, ByteString) -> Result Internal.Error (Dict.Dict field a) toDict fromField decode =   Result.map Dict.fromList     << Prelude.traverse

@@ -11,6 +11,7 @@     HandlerAutoExtendExpire,     HasAutoExtendExpire (..),     Query (..),+    TTLResponse (..),     Database.Redis.Cursor,     Database.Redis.cursor0,     cmds,@@ -26,6 +27,7 @@     wrapQuery,     maybesToDict,     keysTouchedByQuery,+    ttlResponseDecoder,   ) where @@ -113,6 +115,7 @@     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 @@   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)]@@ -233,7 +237,7 @@   { doQuery :: (Stack.HasCallStack) => forall a. Settings.QueryTimeout -> Query a -> Task Error a,     doTransaction :: (Stack.HasCallStack) => forall a. Settings.QueryTimeout -> Query a -> Task Error a,     doEval :: (Stack.HasCallStack) => forall a. (Database.Redis.RedisResult a) => Settings.QueryTimeout -> Script.Script a -> Task Error a,-    namespace :: Text,+    namespace :: Maybe Text,     maxKeySize :: Settings.MaxKeySize,     queryTimeout :: Settings.QueryTimeout   }@@ -256,7 +260,7 @@ -- to run them using 'transaction' query :: (Stack.HasCallStack) => Handler' x -> Query a -> Task Error a query handler query' =-  namespaceQuery (namespace handler ++ ":") query'+  namespaceQuery (namespacePrefix handler) query'     |> Task.andThen (ensureMaxKeySize handler)     |> Task.andThen (Stack.withFrozenCallStack (doQuery handler) (queryTimeout handler)) @@ -268,15 +272,21 @@ -- see redis transaction semantics here: https://redis.io/topics/transactions transaction :: (Stack.HasCallStack) => Handler' x -> Query a -> Task Error a transaction handler query' =-  namespaceQuery (namespace handler ++ ":") query'+  namespaceQuery (namespacePrefix handler) query'     |> Task.andThen (ensureMaxKeySize handler)     |> Task.andThen (Stack.withFrozenCallStack (doTransaction handler) (queryTimeout handler))  eval :: (Stack.HasCallStack, Database.Redis.RedisResult a) => Handler' x -> Script.Script a -> Task Error a eval handler script =-  Script.mapKeys (\key -> Task.succeed (namespace handler ++ ":" ++ key)) script+  Script.mapKeys (\key -> Task.succeed (namespacePrefix handler ++ key)) script     |> Task.andThen (Stack.withFrozenCallStack (doEval handler) (queryTimeout handler)) +namespacePrefix :: Handler' x -> Text+namespacePrefix handler =+  case namespace handler of+    Just ns -> ns ++ ":"+    Nothing -> ""+ namespaceQuery :: Text -> Query a -> Task err (Query a) namespaceQuery prefix query' =   mapKeys (\key -> Task.succeed (prefix ++ key)) query'@@ -317,6 +327,7 @@     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 +371,7 @@     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 +430,9 @@     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@@ -485,6 +500,21 @@           then Task.succeed nextAccumulator           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

@@ -70,7 +70,7 @@ -- -- It is what forces us to hav UndecidableInstances enabled. instance-  GHC.TypeLits.TypeError ('GHC.TypeLits.Text "[script| ${..} ] interpolation only supports Key or Literal inputs.") =>+  (GHC.TypeLits.TypeError ('GHC.TypeLits.Text "[script| ${..} ] interpolation only supports Key or Literal inputs.")) =>   HasScriptParam x   where   getScriptParam = Prelude.error "This won't ever hit bc this generates a compile-time error."@@ -129,18 +129,18 @@     ScriptText text -> [|EvaluatedText text|]     ScriptVariable var -> pure <| (TH.VarE 'evaluateScriptParam) `TH.AppE` (varToExp var) -evaluateScriptParam :: HasScriptParam a => a -> EvaluatedToken+evaluateScriptParam :: (HasScriptParam a) => a -> EvaluatedToken evaluateScriptParam scriptParam =   case getScriptParam scriptParam of     Key a ->-      EvaluatedVariable-        <| EvaluatedParam+      EvaluatedVariable <|+        EvaluatedParam           { kind = RedisKey,             value = unquoteString (Debug.toString a)           }     Literal a ->-      EvaluatedVariable-        <| EvaluatedParam+      EvaluatedVariable <|+        EvaluatedParam           { kind = ArbitraryValue,             value = unquoteString (Debug.toString a)           }

@@ -134,7 +134,7 @@ byteStringApi = makeApi Codec.byteStringCodec  makeApi ::-  Ord a =>+  (Ord a) =>   Codec.Codec a ->   (key -> Text) ->   Api key a@@ -154,7 +154,6 @@         Internal.Smembers (toKey key)           |> Internal.WithResult (Prelude.traverse codecDecoder)           |> Internal.map Set.fromList,-    sismember = \key val->-            Internal.Sismember (toKey key) (codecEncoder val)-+      sismember = \key val ->+        Internal.Sismember (toKey key) (codecEncoder val)     }

@@ -160,8 +160,8 @@    in do         uriPathText <- uriPathTextFromURI         dbNum <- dbNumFromParams (URI.uriQuery uri)-        pure-          <| defaultConnectInfo+        pure <|+          defaultConnectInfo             { connectPort = UnixSocket (Text.toList uriPathText),               connectDatabase = dbNum,               connectAuth = maybePasswordFromURI

@@ -138,7 +138,7 @@ byteStringApi = makeApi Codec.byteStringCodec  makeApi ::-  Ord a =>+  (Ord a) =>   Codec.Codec a ->   (key -> Text) ->   Api key a

@@ -11,7 +11,8 @@  data TestHandlers = TestHandlers   { autoExtendExpireHandler :: Redis.HandlerAutoExtendExpire,-    handler :: Redis.Handler+    handler :: Redis.Handler,+    noNamespaceHandler :: Redis.Handler   }  getHandlers :: Conduit.Acquire TestHandlers@@ -19,7 +20,8 @@   settings <- Conduit.liftIO (Environment.decode Settings.decoder)   autoExtendExpireHandler <- Handler.handlerAutoExtendExpire "tests-auto-extend-expire" settings {Settings.defaultExpiry = Settings.ExpireKeysAfterSeconds 1}   handler <- Handler.handler "tests" settings {Settings.defaultExpiry = Settings.NoDefaultExpiry}-  Prelude.pure TestHandlers {autoExtendExpireHandler, handler}+  noNamespaceHandler <- Handler.handlerWithoutNamespace settings {Settings.defaultExpiry = Settings.NoDefaultExpiry}+  Prelude.pure TestHandlers {autoExtendExpireHandler, handler, noNamespaceHandler}  -- | Historical context: -- Golden results are slightly different between GHC 9.2.x and 8.10.x due@@ -37,4 +39,4 @@ -- -- We keep this here in case similar is true in later versions of GHC. goldenResultsDir :: Text-goldenResultsDir = "test/golden-results-9.2"+goldenResultsDir = "test/golden-results-9.8"

@@ -9,8 +9,8 @@ main :: Prelude.IO () main =   Conduit.withAcquire Helpers.getHandlers <| \testHandlers ->-    Test.run-      <| Test.describe+    Test.run <|+      Test.describe         "nri-redis"         [ Spec.Redis.tests testHandlers,           Spec.Settings.tests,

@@ -30,6 +30,7 @@     res <-       Platform.rootTracingSpanIO         "test-request"+        Platform.silentTrack         (MVar.putMVar spanVar)         "test-root"         (\log -> Task.attempt log task)@@ -46,6 +47,7 @@     res <-       Platform.rootTracingSpanIO         "test-request"+        Platform.silentTrack         (MVar.putMVar spanVar)         "test-root"         (\log -> Task.attempt log task)@@ -57,12 +59,14 @@         Prelude.fail "Expected task to fail"  tests :: TestHandlers -> Test.Test-tests TestHandlers {handler, autoExtendExpireHandler} =+tests TestHandlers {handler, autoExtendExpireHandler, noNamespaceHandler} =   Test.describe     "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),+      Test.describe "no-namespace handler tests" (noNamespaceTests noNamespaceHandler handler)     ]  -- We want to test all of our potential makeApi alternatives because it's easy@@ -365,8 +369,8 @@       let firstKey = "scanTest::key1"       let firstValue = "value 1"       let nonEmptyDict =-            NonEmptyDict.init firstKey firstValue-              <| Dict.fromList+            NonEmptyDict.init firstKey firstValue <|+              Dict.fromList                 [ ("scanTest::key2", "value 2"),                   ("scanTest::key3", "value 3"),                   ("scanTest::key4", "value 4")@@ -389,8 +393,8 @@       let firstKey = "scanDeleteTest::key1"       let firstValue = "value 1"       let nonEmptyDict =-            NonEmptyDict.init firstKey firstValue-              <| Dict.fromList+            NonEmptyDict.init firstKey firstValue <|+              Dict.fromList                 [ ("scanDeleteTest::key2", "value 2"),                   ("scanDeleteTest::key3", "value 3"),                   ("scanDeleteTest::key4", "value 4")@@ -468,9 +472,74 @@   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+      ]++-- | Tests that pin down the contract of `handlerWithoutNamespace`: keys are+-- neither prefixed on the way in nor stripped on the way out. The+-- `nsHandler` argument is the regular namespaced `handler` (namespace+-- `"tests"`); we use it to confirm prefixing happens on the namespaced side+-- but not on the no-namespace side.+noNamespaceTests :: Redis.Handler -> Redis.Handler -> List Test.Test+noNamespaceTests noNs nsHandler =+  [ Test.test "set via no-namespace handler stores the key under its literal name" <| \() -> do+      -- Write at literal key "noNs::literalKey" using the no-namespace handler.+      Redis.set api "noNs::literalKey" "value-no-ns" |> Redis.query noNs |> Expect.succeeds+      -- The namespaced handler would look at "tests:noNs::literalKey", which+      -- nothing has written to, so it should see Nothing.+      result <- Redis.get api "noNs::literalKey" |> Redis.query nsHandler |> Expect.succeeds+      Expect.equal result Nothing,+    Test.test "get via no-namespace handler reads the literal key (no prefix added)" <| \() -> do+      -- Namespaced handler writes "noNs::roundTrip" → redis sees "tests:noNs::roundTrip".+      Redis.set api "noNs::roundTrip" "via-namespace" |> Redis.query nsHandler |> Expect.succeeds+      -- The no-namespace handler can reach that same value by spelling out+      -- the full prefixed key, since it adds no prefix of its own.+      result <- Redis.get api "tests:noNs::roundTrip" |> Redis.query noNs |> Expect.succeeds+      Expect.equal result (Just "via-namespace"),+    Test.test "eval via no-namespace handler does not prefix script keys" <| \() -> do+      let script = [Redis.script|return ${Redis.Key "noNs::evalKey"}|]+      (result :: Text) <- Redis.eval noNs script |> Expect.succeeds+      Expect.equal result "noNs::evalKey",+    Test.test "foldWithScan via no-namespace handler returns keys verbatim" <| \() -> do+      let scanPrefix = "noNs::scanTest::"+      let firstKey = scanPrefix ++ "k1"+      let nonEmptyDict =+            NonEmptyDict.init firstKey "v1"+              <| Dict.fromList [(scanPrefix ++ "k2", "v2")]+      let expectedKeys =+            NonEmptyDict.toDict nonEmptyDict+              |> Dict.keys+      Redis.mset api nonEmptyDict |> Redis.query noNs |> Expect.succeeds+      let processBatch = \batchKeys acc ->+            Task.succeed (List.foldl Set.insert acc batchKeys)+      keySet <-+        Redis.foldWithScan noNs (Just (scanPrefix ++ "*")) (Just 10) processBatch Set.empty+          |> Expect.succeeds+      keySet+        |> Set.toList+        |> Expect.equal expectedKeys+  ]+ addNamespace :: Text -> Redis.Handler' x -> Redis.Handler' x addNamespace namespace handler' =-  handler' {Internal.namespace = Internal.namespace handler' ++ ":" ++ namespace}+  let combined = case Internal.namespace handler' of+        Just existing -> existing ++ ":" ++ namespace+        Nothing -> namespace+   in handler' {Internal.namespace = Just combined}  api :: Redis.Api Text Text api = Redis.textApi identity

@@ -21,7 +21,7 @@ -- -- We lean on `show` for equality since `Database.Redis.ConnectInfo` doesn't have -- an `Eq` instance (but does have a `Show` instance)-expectEqualShow :: Show a => a -> a -> Expect.Expectation+expectEqualShow :: (Show a) => a -> a -> Expect.Expectation expectEqualShow x y = Expect.equal (show x) (show y)  decoderTests :: Test.Test@@ -242,7 +242,7 @@  parseConnectInfoElseFailTest :: String -> Expect.Expectation' ConnectInfo parseConnectInfoElseFailTest uri = do-  Expect.succeeds-    <| case parseConnectInfo uri of+  Expect.succeeds <|+    case parseConnectInfo uri of       Left err -> Task.fail <| "you wrote this test wrong, got err: " ++ Text.fromList err       Right connectInfo -> pure connectInfo