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 +4/−0
- nri-redis.cabal +36/−6
- src/NonEmptyDict.hs +3/−0
- src/Redis.hs +13/−9
- src/Redis/Counter.hs +6/−0
- src/Redis/Hash.hs +19/−0
- src/Redis/Internal.hs +60/−35
- src/Redis/List.hs +23/−1
- src/Redis/Mock.hs +3/−1
- src/Redis/Real.hs +7/−6
- src/Redis/Set.hs +23/−1
- src/Redis/Settings.hs +35/−5
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) ) )