packages feed

nri-redis 0.1.0.0 → 0.1.0.1

raw patch · 12 files changed

+232/−64 lines, 12 filesnew-uploaderPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

+ Redis: KeyExceedsMaxSize :: Text -> Int -> Error
+ Redis: [maxKeySize] :: Settings -> MaxKeySize
+ Redis.Counter: KeyExceedsMaxSize :: Text -> Int -> Error
+ Redis.Counter: [maxKeySize] :: Settings -> MaxKeySize
+ Redis.Hash: KeyExceedsMaxSize :: Text -> Int -> Error
+ Redis.Hash: [maxKeySize] :: Settings -> MaxKeySize
+ Redis.List: KeyExceedsMaxSize :: Text -> Int -> Error
+ Redis.List: [maxKeySize] :: Settings -> MaxKeySize
+ Redis.Set: KeyExceedsMaxSize :: Text -> Int -> Error
+ Redis.Set: [maxKeySize] :: Settings -> MaxKeySize
- Redis: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> Settings
+ Redis: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> MaxKeySize -> Settings
- Redis: jsonApi :: (ToJSON a, FromJSON a) => (key -> Text) -> Api key a
+ Redis: jsonApi :: forall a key. (ToJSON a, FromJSON a) => (key -> Text) -> Api key a
- Redis.Counter: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> Settings
+ Redis.Counter: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> MaxKeySize -> Settings
- Redis.Hash: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> Settings
+ Redis.Hash: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> MaxKeySize -> Settings
- Redis.Hash: jsonApi :: (ToJSON a, FromJSON a, Ord field) => (key -> Text) -> (field -> Text) -> (Text -> Maybe field) -> Api key field a
+ Redis.Hash: jsonApi :: forall a field key. (ToJSON a, FromJSON a, Ord field) => (key -> Text) -> (field -> Text) -> (Text -> Maybe field) -> Api key field a
- Redis.List: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> Settings
+ Redis.List: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> MaxKeySize -> Settings
- Redis.List: jsonApi :: (ToJSON a, FromJSON a) => (key -> Text) -> Api key a
+ Redis.List: jsonApi :: forall a key. (ToJSON a, FromJSON a) => (key -> Text) -> Api key a
- Redis.Set: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> Settings
+ Redis.Set: Settings :: ConnectInfo -> ClusterMode -> DefaultExpiry -> QueryTimeout -> MaxKeySize -> Settings
- Redis.Set: jsonApi :: (ToJSON a, FromJSON a, Ord a) => (key -> Text) -> Api key a
+ Redis.Set: jsonApi :: forall a key. (ToJSON a, FromJSON a, Ord a) => (key -> Text) -> Api key a

Files

CHANGELOG.md view
@@ -1,5 +1,9 @@ # Unreleased next version +# 0.1.0.1++- Support GHC 9.0.1.+ # 0.1.0.0  - First release, but we've battle-tested it against significant load for months now!
nri-redis.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.18 --- This file has been generated from package.yaml by hpack version 0.34.2.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack  name:           nri-redis-version:        0.1.0.0+version:        0.1.0.1 synopsis:       An intuitive hedis wrapper library.-description:    Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-redis>.+description:    Please see the README at <https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-redis#readme>. category:       Web homepage:       https://github.com/NoRedInk/haskell-libraries/tree/trunk/nri-redis#readme bug-reports:    https://github.com/NoRedInk/haskell-libraries/issues@@ -44,7 +44,22 @@       Paths_nri_redis   hs-source-dirs:       src-  default-extensions: DataKinds DeriveGeneric ExtendedDefaultRules FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude NumericUnderscores OverloadedStrings PartialTypeSignatures ScopedTypeVariables Strict TypeOperators+  default-extensions:+      DataKinds+      DeriveGeneric+      ExtendedDefaultRules+      FlexibleContexts+      FlexibleInstances+      GeneralizedNewtypeDeriving+      MultiParamTypeClasses+      NamedFieldPuns+      NoImplicitPrelude+      NumericUnderscores+      OverloadedStrings+      PartialTypeSignatures+      ScopedTypeVariables+      Strict+      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 >=1.4.6.0 && <1.6@@ -82,8 +97,23 @@   hs-source-dirs:       test       src-  default-extensions: DataKinds DeriveGeneric ExtendedDefaultRules FlexibleContexts FlexibleInstances GeneralizedNewtypeDeriving MultiParamTypeClasses NamedFieldPuns NoImplicitPrelude NumericUnderscores OverloadedStrings PartialTypeSignatures ScopedTypeVariables Strict TypeOperators-  ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wpartial-fields -Wredundant-constraints -Wincomplete-uni-patterns -fno-warn-type-defaults -fplugin=NriPrelude.Plugin+  default-extensions:+      DataKinds+      DeriveGeneric+      ExtendedDefaultRules+      FlexibleContexts+      FlexibleInstances+      GeneralizedNewtypeDeriving+      MultiParamTypeClasses+      NamedFieldPuns+      NoImplicitPrelude+      NumericUnderscores+      OverloadedStrings+      PartialTypeSignatures+      ScopedTypeVariables+      Strict+      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 >=1.4.6.0 && <1.6     , async >=2.2.2 && <2.3
src/NonEmptyDict.hs view
@@ -13,6 +13,8 @@ import Data.List.NonEmpty (NonEmpty ((:|))) import Dict +-- | A Dict with at least one entry. For use in writing to redis, where it's an+-- error when writing nothing data NonEmptyDict k v   = NonEmptyDict (k, v) (Dict.Dict k v)   deriving (Show)@@ -34,6 +36,7 @@ toNonEmptyList (NonEmptyDict kv dict) =   kv :| Dict.toList dict +-- | creates a `Dict` from a key, value, and dict init :: Ord k => k -> v -> Dict.Dict k v -> NonEmptyDict k v init key val dict =   NonEmptyDict (key, val) (Dict.remove key dict)
src/Redis.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}  -- | A simple Redis library providing high level access to Redis features we -- use here at NoRedInk@@ -123,7 +124,7 @@     --     -- https://redis.io/commands/setex     setex :: key -> Int -> a -> Internal.Query (),-    -- Set key to hold string value if key does not exist. In that case, it+    -- | Set key to hold string value if key does not exist. In that case, it     -- is equal to SET. When key already holds a value, no operation is     -- performed. SETNX is short for "SET if Not eXists".     --@@ -132,15 +133,18 @@   }  -- | Creates a json API mapping a 'key' to a json-encodable-decodable type--- @--- data Key = Key { fieldA: Text, fieldB: Text }--- data Val = Val { ... } ----- myJsonApi :: Redis.Api Key Val--- myJsonApi = Redis.jsonApi (\Key {fieldA, fieldB}-> Text.join "-" [fieldA, fieldB, "v1"])--- @-jsonApi :: (Aeson.ToJSON a, Aeson.FromJSON a) => (key -> Text) -> Api key a-jsonApi = makeApi Codec.jsonCodec+-- > data Key = Key { fieldA: Text, fieldB: Text }+-- > data Val = Val { ... }+-- >+-- > myJsonApi :: Redis.Api Key Val+-- > myJsonApi = Redis.jsonApi (\Key {fieldA, fieldB}-> Text.join "-" [fieldA, fieldB, "v1"])+jsonApi ::+  forall a key.+  (Aeson.ToJSON a, Aeson.FromJSON a) =>+  (key -> Text) ->+  Api key a+jsonApi toKey = makeApi Codec.jsonCodec toKey  -- | Creates a Redis API mapping a 'key' to Text textApi :: (key -> Text) -> Api key Text
src/Redis/Counter.hs view
@@ -46,6 +46,8 @@ import qualified Redis.Settings as Settings import qualified Prelude +-- | a API type can be used to help enforce a consistent key usage.+-- Without an API type, it can be easy to naiively change key serialization. data Api key = Api   { -- | Removes the specified keys. A key is ignored if it does not exist.     --@@ -97,6 +99,10 @@     set :: key -> Int -> Internal.Query ()   } +-- | Creates a Redis API to help enforce consistent key serialization+--+-- > myJsonApi :: Redis.Counter.Api Key+-- > myJsonApi = Redis.counter.makeApi (\Key {fieldA, fieldB}-> Text.join "-" [fieldA, fieldB, "v1"]) makeApi ::   (key -> Text) ->   Api key
src/Redis/Hash.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}  -- | A simple Redis library providing high level access to Redis features we -- use here at NoRedInk@@ -58,6 +59,14 @@ import qualified Result import qualified Prelude +-- | a API type can be used to enforce a mapping of keys to values.+-- without an API type, it can be easy to naiively serialize the wrong type+-- into a redis key.+--+-- Out of the box, we have helpers to support+-- - 'jsonApi' for json-encodable and decodable values+-- - 'textApi' for 'Text' values+-- - 'byteStringApi' for 'ByteString' values data Api key field a = Api   { -- | Removes the specified keys. A key is ignored if it does not exist.     --@@ -124,7 +133,15 @@     hsetnx :: key -> field -> a -> Internal.Query Bool   } +-- | Creates a json API mapping a 'key' to a json-encodable-decodable type+--+-- > data Key = Key { fieldA: Text, fieldB: Text }+-- > data Val = Val { ... }+-- >+-- > myJsonApi :: Redis.Api Key Val+-- > myJsonApi = Redis.jsonApi (\Key {fieldA, jsonApi ::+  forall a field key.   (Aeson.ToJSON a, Aeson.FromJSON a, Ord field) =>   (key -> Text) ->   (field -> Text) ->@@ -132,6 +149,7 @@   Api key field a jsonApi = makeApi Codec.jsonCodec +-- | Creates a Redis API mapping a 'key' to Text textApi ::   Ord field =>   (key -> Text) ->@@ -140,6 +158,7 @@   Api key field Text textApi = makeApi Codec.textCodec +-- | Creates a Redis API mapping a 'key' to a ByteString byteStringApi ::   Ord field =>   (key -> Text) ->
src/Redis/Internal.hs view
@@ -30,6 +30,7 @@ import qualified Log.RedisCommands as RedisCommands import NriPrelude hiding (map, map2, map3) import qualified Platform+import qualified Redis.Settings as Settings import qualified Set import qualified Text import qualified Tuple@@ -44,6 +45,7 @@   | LibraryError Text   | TransactionAborted   | TimeoutError+  | KeyExceedsMaxSize Text Int  instance Aeson.ToJSON Error where   toJSON err = Aeson.toJSON (errorForHumans err)@@ -61,6 +63,7 @@     DecodingFieldError err -> "Could not decode field of hash: " ++ err     TransactionAborted -> "Transaction aborted."     TimeoutError -> "Redis query took too long."+    KeyExceedsMaxSize key maxKeySize -> "Redis key (" ++ key ++ ") exceeded max size (" ++ Text.fromInt maxKeySize ++ ")."  -- | Render the commands a query is going to run for monitoring and debugging -- purposes. Values we write are replaced with "*****" because they might@@ -141,6 +144,9 @@ instance Prelude.Functor Query where   fmap = map +instance Prelude.Show (Query a) where+  show = Text.toList << Text.join "<|" << cmds+ -- | Used to map the type of a query to another type -- useful in combination with 'transaction' map :: (a -> b) -> Query a -> Query b@@ -180,7 +186,8 @@ data Handler = Handler   { doQuery :: Stack.HasCallStack => forall a. Query a -> Task Error a,     doTransaction :: Stack.HasCallStack => forall a. Query a -> Task Error a,-    namespace :: Text+    namespace :: Text,+    maxKeySize :: Settings.MaxKeySize   }  -- | Run a 'Query'.@@ -190,7 +197,8 @@ query :: Stack.HasCallStack => Handler -> Query a -> Task Error a query handler query' =   namespaceQuery (namespace handler ++ ":") query'-    |> Stack.withFrozenCallStack doQuery handler+    |> Task.andThen (ensureMaxKeySize handler)+    |> Task.andThen (Stack.withFrozenCallStack (doQuery handler))  -- | Run a redis Query in a transaction. If the query contains several Redis -- commands they're all executed together, and Redis will guarantee other@@ -201,41 +209,58 @@ transaction :: Stack.HasCallStack => Handler -> Query a -> Task Error a transaction handler query' =   namespaceQuery (namespace handler ++ ":") query'-    |> Stack.withFrozenCallStack doTransaction handler+    |> Task.andThen (ensureMaxKeySize handler)+    |> Task.andThen (Stack.withFrozenCallStack (doTransaction handler)) -namespaceQuery :: Text -> Query a -> Query a-namespaceQuery prefix query' =+namespaceQuery :: Text -> Query a -> Task err (Query a)+namespaceQuery prefix query' = mapKeys (\key -> Task.succeed (prefix ++ key)) query'++mapKeys :: (Text -> Task err Text) -> Query a -> Task err (Query a)+mapKeys fn query' =   case query' of-    Exists key -> Exists (prefix ++ key)-    Ping -> Ping-    Get key -> Get (prefix ++ key)-    Set key value -> Set (prefix ++ key) value-    Setex key seconds value -> Setex (prefix ++ key) seconds value-    Setnx key value -> Setnx (prefix ++ key) value-    Getset key value -> Getset (prefix ++ key) value-    Mget keys -> Mget (NonEmpty.map (\k -> prefix ++ k) keys)-    Mset assocs -> Mset (NonEmpty.map (\(k, v) -> (prefix ++ k, v)) assocs)-    Del keys -> Del (NonEmpty.map (prefix ++) keys)-    Hgetall key -> Hgetall (prefix ++ key)-    Hkeys key -> Hkeys (prefix ++ key)-    Hmget key fields -> Hmget (prefix ++ key) fields-    Hget key field -> Hget (prefix ++ key) field-    Hset key field val -> Hset (prefix ++ key) field val-    Hsetnx key field val -> Hsetnx (prefix ++ key) field val-    Hmset key vals -> Hmset (prefix ++ key) vals-    Hdel key fields -> Hdel (prefix ++ key) fields-    Incr key -> Incr (prefix ++ key)-    Incrby key amount -> Incrby (prefix ++ key) amount-    Expire key secs -> Expire (prefix ++ key) secs-    Lrange key lower upper -> Lrange (prefix ++ key) lower upper-    Rpush key vals -> Rpush (prefix ++ key) vals-    Sadd key vals -> Sadd (prefix ++ key) vals-    Scard key -> Scard (prefix ++ key)-    Srem key vals -> Srem (prefix ++ key) vals-    Smembers key -> Smembers (prefix ++ key)-    Pure x -> Pure x-    Apply f x -> Apply (namespaceQuery prefix f) (namespaceQuery prefix x)-    WithResult f q -> WithResult f (namespaceQuery prefix q)+    Exists key -> Task.map Exists (fn key)+    Ping -> Task.succeed Ping+    Get key -> Task.map Get (fn key)+    Set key value -> Task.map (\newKey -> Set newKey value) (fn key)+    Setex key seconds value -> Task.map (\newKey -> Setex newKey seconds value) (fn key)+    Setnx key value -> Task.map (\newKey -> Setnx newKey value) (fn key)+    Getset key value -> Task.map (\newKey -> Getset newKey value) (fn key)+    Mget keys -> Task.map Mget (Prelude.traverse (\k -> fn k) keys)+    Mset assocs -> Task.map Mset (Prelude.traverse (\(k, v) -> Task.map (\newKey -> (newKey, v)) (fn k)) assocs)+    Del keys -> Task.map Del (Prelude.traverse (fn) keys)+    Hgetall key -> Task.map Hgetall (fn key)+    Hkeys key -> Task.map Hkeys (fn key)+    Hmget key fields -> Task.map (\newKeys -> Hmget newKeys fields) (fn key)+    Hget key field -> Task.map (\newKeys -> Hget newKeys field) (fn key)+    Hset key field val -> Task.map (\newKeys -> Hset newKeys field val) (fn key)+    Hsetnx key field val -> Task.map (\newKeys -> Hsetnx newKeys field val) (fn key)+    Hmset key vals -> Task.map (\newKeys -> Hmset newKeys vals) (fn key)+    Hdel key fields -> Task.map (\newKeys -> Hdel newKeys fields) (fn key)+    Incr key -> Task.map Incr (fn key)+    Incrby key amount -> Task.map (\newKeys -> Incrby newKeys amount) (fn key)+    Expire key secs -> Task.map (\newKeys -> Expire newKeys secs) (fn key)+    Lrange key lower upper -> Task.map (\newKeys -> Lrange newKeys lower upper) (fn key)+    Rpush key vals -> Task.map (\newKeys -> Rpush newKeys vals) (fn key)+    Sadd key vals -> Task.map (\newKeys -> Sadd newKeys vals) (fn key)+    Scard key -> Task.map Scard (fn key)+    Srem key vals -> Task.map (\newKeys -> Srem newKeys vals) (fn key)+    Smembers key -> Task.map Smembers (fn key)+    Pure x -> Task.succeed (Pure x)+    Apply f x -> Task.map2 Apply (mapKeys fn f) (mapKeys fn x)+    WithResult f q -> Task.map (WithResult f) (mapKeys fn q)++ensureMaxKeySize :: Handler -> Query a -> Task Error (Query a)+ensureMaxKeySize handler query' =+  case maxKeySize handler of+    Settings.NoMaxKeySize -> Task.succeed query'+    Settings.MaxKeySize maxKeySize ->+      mapKeys (checkMaxKeySize maxKeySize) query'++checkMaxKeySize :: Int -> Text -> Task Error Text+checkMaxKeySize maxKeySize key =+  if Text.length key <= maxKeySize+    then Task.succeed key+    else Task.fail (KeyExceedsMaxSize key maxKeySize)  keysTouchedByQuery :: Query a -> Set.Set Text keysTouchedByQuery query' =
src/Redis/List.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}  -- | A simple Redis library providing high level access to Redis features we -- use here at NoRedInk@@ -48,6 +49,14 @@ import qualified Redis.Settings as Settings import qualified Prelude +-- | a API type can be used to enforce a mapping of keys to values.+-- without an API type, it can be easy to naiively serialize the wrong type+-- into a redis key.+--+-- Out of the box, we have helpers to support+-- - 'jsonApi' for json-encodable and decodable values+-- - 'textApi' for 'Text' values+-- - 'byteStringApi' for 'ByteString' values data Api key a = Api   { -- | Removes the specified keys. A key is ignored if it does not exist.     --@@ -84,12 +93,25 @@     rpush :: key -> NonEmpty a -> Internal.Query Int   } -jsonApi :: (Aeson.ToJSON a, Aeson.FromJSON a) => (key -> Text) -> Api key a+-- | Creates a json API mapping a 'key' to a json-encodable-decodable type+--+-- > data Key = Key { fieldA: Text, fieldB: Text }+-- > data Val = Val { ... }+-- >+-- > myJsonApi :: Redis.Api Key Val+-- > myJsonApi = Redis.jsonApi (\Key {fieldA,+jsonApi ::+  forall a key.+  (Aeson.ToJSON a, Aeson.FromJSON a) =>+  (key -> Text) ->+  Api key a jsonApi = makeApi Codec.jsonCodec +-- | Creates a Redis API mapping a 'key' to Text textApi :: (key -> Text) -> Api key Text textApi = makeApi Codec.textCodec +-- | Creates a Redis API mapping a 'key' to a ByteString byteStringApi :: (key -> Text) -> Api key ByteString.ByteString byteStringApi = makeApi Codec.byteStringCodec 
src/Redis/Mock.hs view
@@ -19,6 +19,7 @@ import qualified List import qualified Platform import qualified Redis.Internal as Internal+import qualified Redis.Settings as Settings import qualified Text import qualified Tuple import Prelude (IO, pure)@@ -40,7 +41,8 @@   Internal.Handler     { Internal.doQuery = doQuery' modelRef doAnything,       Internal.doTransaction = doQuery' modelRef doAnything,-      Internal.namespace = "tests"+      Internal.namespace = "tests",+      Internal.maxKeySize = Settings.NoMaxKeySize     }     |> Prelude.pure   where
src/Redis/Real.hs view
@@ -44,10 +44,10 @@ timeoutAfterMilliseconds milliseconds handler' =   handler'     { Internal.doQuery =-        Stack.withFrozenCallStack Internal.doQuery handler'+        Stack.withFrozenCallStack (Internal.doQuery handler')           >> Task.timeout milliseconds Internal.TimeoutError,       Internal.doTransaction =-        Stack.withFrozenCallStack Internal.doTransaction handler'+        Stack.withFrozenCallStack (Internal.doTransaction handler')           >> Task.timeout milliseconds Internal.TimeoutError     } @@ -63,10 +63,10 @@    in handler'         { Internal.doQuery = \query' ->             wrapWithExpire query'-              |> Stack.withFrozenCallStack Internal.doQuery handler',+              |> Stack.withFrozenCallStack (Internal.doQuery handler'),           Internal.doTransaction = \query' ->             wrapWithExpire query'-              |> Stack.withFrozenCallStack Internal.doTransaction handler'+              |> Stack.withFrozenCallStack (Internal.doTransaction handler')         }  acquireHandler :: Text -> Settings.Settings -> IO (Internal.Handler, Connection)@@ -102,8 +102,9 @@                           Database.Redis.TxAborted -> Right (Err Internal.TransactionAborted)                           Database.Redis.TxError err -> Right (Err (Internal.RedisError (Text.fromList err)))                     )-                  |> Stack.withFrozenCallStack platformRedis (Internal.cmds query) connection anything,-          Internal.namespace = namespace+                  |> Stack.withFrozenCallStack (platformRedis (Internal.cmds query) connection anything),+          Internal.namespace = namespace,+          Internal.maxKeySize = Settings.maxKeySize settings         },       connection     )
src/Redis/Set.hs view
@@ -1,5 +1,6 @@ {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}  -- | A simple Redis library providing high level access to Redis features we -- use here at NoRedInk@@ -51,6 +52,14 @@ import qualified Set import qualified Prelude +-- | a API type can be used to enforce a mapping of keys to values.+-- without an API type, it can be easy to naiively serialize the wrong type+-- into a redis key.+--+-- Out of the box, we have helpers to support+-- - 'jsonApi' for json-encodable and decodable values+-- - 'textApi' for 'Text' values+-- - 'byteStringApi' for 'ByteString' values data Api key a = Api   { -- | Removes the specified keys. A key is ignored if it does not exist.     --@@ -95,12 +104,25 @@     smembers :: key -> Internal.Query (Set.Set a)   } -jsonApi :: (Aeson.ToJSON a, Aeson.FromJSON a, Ord a) => (key -> Text) -> Api key a+-- | Creates a json API mapping a 'key' to a json-encodable-decodable type+--+-- > data Key = Key { fieldA: Text, fieldB: Text }+-- > data Val = Val { ... }+-- >+-- > myJsonApi :: Redis.Api Key Val+-- > myJsonApi = Redis.jsonApi (\Key {fieldA,+jsonApi ::+  forall a key.+  (Aeson.ToJSON a, Aeson.FromJSON a, Ord a) =>+  (key -> Text) ->+  Api key a jsonApi = makeApi Codec.jsonCodec +-- | Creates a Redis API mapping a 'key' to Text textApi :: (key -> Text) -> Api key Text textApi = makeApi Codec.textCodec +-- | Creates a Redis API mapping a 'key' to a ByteString byteStringApi :: (key -> Text) -> Api key ByteString.ByteString byteStringApi = makeApi Codec.byteStringCodec 
src/Redis/Settings.hs view
@@ -1,4 +1,13 @@-module Redis.Settings (Settings (..), ClusterMode (..), DefaultExpiry (..), QueryTimeout (..), decoder, decoderWithEnvVarPrefix) where+module Redis.Settings+  ( Settings (..),+    ClusterMode (..),+    DefaultExpiry (..),+    QueryTimeout (..),+    MaxKeySize (..),+    decoder,+    decoderWithEnvVarPrefix,+  )+where  import Database.Redis hiding (Ok) import qualified Environment@@ -30,28 +39,32 @@     --     -- Default env var name is REDIS_QUERY_TIMEOUT_MILLISECONDS     -- default is 1000-    queryTimeout :: QueryTimeout+    queryTimeout :: QueryTimeout,+    maxKeySize :: MaxKeySize   } +data MaxKeySize = NoMaxKeySize | MaxKeySize Int+ data DefaultExpiry = NoDefaultExpiry | ExpireKeysAfterSeconds Int  data QueryTimeout = NoQueryTimeout | TimeoutQueryAfterMilliseconds Int --- decodes Settings from environmental variables+-- | decodes Settings from environmental variables decoder :: Environment.Decoder Settings decoder =   decoderWithEnvVarPrefix "" --- decodes Settings from environmental variables prefixed with a Text+-- | decodes Settings from environmental variables prefixed with a Text -- >>> decoderWithEnvVarPrefix "WORKER_" decoderWithEnvVarPrefix :: Text -> Environment.Decoder Settings decoderWithEnvVarPrefix prefix =-  map4+  map5     Settings     (decoderConnectInfo prefix)     (decoderClusterMode prefix)     (decoderDefaultExpiry prefix)     (decoderQueryTimeout prefix)+    (decoderMaxKeySize prefix)  decoderClusterMode :: Text -> Environment.Decoder ClusterMode decoderClusterMode prefix =@@ -117,5 +130,22 @@             if milliseconds <= 0               then Ok NoQueryTimeout               else Ok (TimeoutQueryAfterMilliseconds milliseconds)+        )+    )++decoderMaxKeySize :: Text -> Environment.Decoder MaxKeySize+decoderMaxKeySize prefix =+  Environment.variable+    Environment.Variable+      { Environment.name = prefix ++ "REDIS_MAX_KEY_SIZE",+        Environment.description = "0 means no max key size, every other value is a max key size.",+        Environment.defaultValue = "0"+      }+    ( Environment.custom+        Environment.int+        ( \maxKeySize ->+            if maxKeySize <= 0+              then Ok NoMaxKeySize+              else Ok (MaxKeySize maxKeySize)         )     )