hedis-0.7.8: Client library for the Redis datastore: supports full command set, pipelining.

Safe HaskellNone
LanguageHaskell98

Database.Redis

Contents

Synopsis

How To Use This Module

Connect to a Redis server:

-- connects to localhost:6379
conn <- connect defaultConnectInfo

Send commands to the server:

{-# LANGUAGE OverloadedStrings #-}
...
runRedis conn $ do
     set "hello" "hello"
     set "world" "world"
     hello <- get "hello"
     world <- get "world"
     liftIO $ print (hello,world)

Command Type Signatures

Redis commands behave differently when issued in- or outside of a transaction. To make them work in both contexts, most command functions have a type signature similar to the following:

 echo :: (RedisCtx m f) => ByteString -> m (f ByteString)
 

Here is how to interpret this type signature:

  • The argument types are independent of the execution context. echo always takes a ByteString parameter, whether in- or outside of a transaction. This is true for all command functions.
  • All Redis commands return their result wrapped in some "container". The type f of this container depends on the commands execution context m. The ByteString return type in the example is specific to the echo command. For other commands, it will often be another type.
  • In the "normal" context Redis, outside of any transactions, results are wrapped in an Either Reply.
  • Inside a transaction, in the RedisTx context, results are wrapped in a Queued.

In short, you can view any command with a RedisCtx constraint in the type signature, to "have two types". For example echo "has both types":

 echo :: ByteString -> Redis (Either Reply ByteString)
 echo :: ByteString -> RedisTx (Queued ByteString)
 
Exercise
What are the types of expire inside a transaction and lindex outside of a transaction? The solutions are at the very bottom of this page.

Lua Scripting

Lua values returned from the eval and evalsha functions will be converted to Haskell values by the decode function from the RedisResult type class.

 Lua Type      | Haskell Type       | Conversion Example
 --------------|--------------------|-----------------------------
 Number        | Integer            | 1.23   => 1
 String        | ByteString, Double | "1.23" => "1.23" or 1.23
 Boolean       | Bool               | false  => False
 Table         | List               | {1,2}  => [1,2]
 

Additionally, any of the Haskell types from the table above can be wrapped in a Maybe:

 42  => Just 42 :: Maybe Integer
 nil => Nothing :: Maybe Integer
 

Note that Redis imposes some limitations on the possible conversions:

  • Lua numbers can only be converted to Integers. Only Lua strings can be interpreted as Doubles.
  • Associative Lua tables can not be converted at all. Returned tables must be "arrays", i.e. indexed only by integers.

The Redis Scripting website (http://redis.io/commands/eval) documents the exact semantics of the scripting commands and value conversion.

Automatic Pipelining

Commands are automatically pipelined as much as possible. For example, in the above "hello world" example, all four commands are pipelined. Automatic pipelining makes use of Haskell's laziness. As long as a previous reply is not evaluated, subsequent commands can be pipelined.

Automatic pipelining is limited to the scope of runRedis call and it is guaranteed that every reply expected as a part of runRedis execution gets received after runRedis invocation.

To keep memory usage low, the number of requests "in the pipeline" is limited (per connection) to 1000. After that number, the next command is sent only when at least one reply has been received. That means, command functions may block until there are less than 1000 outstanding replies.

Error Behavior

Operations against keys holding the wrong kind of value:
Outside of a transaction, if the Redis server returns an Error, command functions will return Left the Reply. The library user can inspect the error message to gain information on what kind of error occured.
Connection to the server lost:
In case of a lost connection, command functions throw a ConnectionLostException. It can only be caught outside of runRedis.
Exceptions:
Any exceptions can only be caught outside of runRedis. This way the connection pool can properly close the connection, making sure it is not left in an unusable state, e.g. closed or inside a transaction.

The Redis Monad

data Redis a Source #

Context for normal command execution, outside of transactions. Use runRedis to run actions of this type.

In this context, each result is wrapped in an Either to account for the possibility of Redis returning an Error reply.

Instances

Monad Redis Source # 

Methods

(>>=) :: Redis a -> (a -> Redis b) -> Redis b #

(>>) :: Redis a -> Redis b -> Redis b #

return :: a -> Redis a #

fail :: String -> Redis a #

Functor Redis Source # 

Methods

fmap :: (a -> b) -> Redis a -> Redis b #

(<$) :: a -> Redis b -> Redis a #

Applicative Redis Source # 

Methods

pure :: a -> Redis a #

(<*>) :: Redis (a -> b) -> Redis a -> Redis b #

(*>) :: Redis a -> Redis b -> Redis b #

(<*) :: Redis a -> Redis b -> Redis a #

MonadIO Redis Source # 

Methods

liftIO :: IO a -> Redis a #

MonadRedis Redis Source # 

Methods

liftRedis :: Redis a -> Redis a

RedisCtx Redis (Either Reply) Source # 

runRedis :: Connection -> Redis a -> IO a Source #

Interact with a Redis datastore specified by the given Connection.

Each call of runRedis takes a network connection from the Connection pool and runs the given Redis action. Calls to runRedis may thus block while all connections from the pool are in use.

class MonadRedis m => RedisCtx m f | m -> f Source #

This class captures the following behaviour: In a context m, a command will return it's result wrapped in a "container" of type f.

Please refer to the Command Type Signatures section of this page for more information.

Minimal complete definition

returnDecode

class Monad m => MonadRedis m Source #

Minimal complete definition

liftRedis

Instances

Connection

data Connection Source #

A threadsafe pool of network connections to a Redis server. Use the connect function to create one.

connect :: ConnectInfo -> IO Connection Source #

Opens a Connection to a Redis server designated by the given ConnectInfo.

data ConnectInfo Source #

Information for connnecting to a Redis server.

It is recommended to not use the ConnInfo data constructor directly. Instead use defaultConnectInfo and update it with record syntax. For example to connect to a password protected Redis server running on localhost and listening to the default port:

myConnectInfo :: ConnectInfo
myConnectInfo = defaultConnectInfo {connectAuth = Just "secret"}

Constructors

ConnInfo 

Fields

defaultConnectInfo :: ConnectInfo Source #

Default information for connecting:

 connectHost           = "localhost"
 connectPort           = PortNumber 6379 -- Redis default port
 connectAuth           = Nothing         -- No password
 connectDatabase       = 0               -- SELECT database 0
 connectMaxConnections = 50              -- Up to 50 connections
 connectMaxIdleTime    = 30              -- Keep open for 30 seconds

type HostName = String #

Either a host name e.g., "haskell.org" or a numeric host address string consisting of a dotted decimal IPv4 address or an IPv6 address e.g., "192.168.0.1".

data PortID :: * #

Instances

Eq PortID 

Methods

(==) :: PortID -> PortID -> Bool #

(/=) :: PortID -> PortID -> Bool #

Show PortID 

Commands

Connection

auth Source #

Arguments

:: ByteString

password

-> Redis (Either Reply Status) 

Authenticate to the server (http://redis.io/commands/auth).

echo Source #

Arguments

:: RedisCtx m f 
=> ByteString

message

-> m (f ByteString) 

Echo the given string (http://redis.io/commands/echo).

ping :: RedisCtx m f => m (f Status) Source #

quit :: RedisCtx m f => m (f Status) Source #

Close the connection (http://redis.io/commands/quit).

select Source #

Arguments

:: RedisCtx m f 
=> Integer

index

-> m (f Status) 

Change the selected database for the current connection (http://redis.io/commands/select).

Keys

del Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

key

-> m (f Integer) 

dump Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f ByteString) 

Return a serialized version of the value stored at the specified key. (http://redis.io/commands/dump).

exists Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Bool) 

Determine if a key exists (http://redis.io/commands/exists).

expire Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

seconds

-> m (f Bool) 

Set a key's time to live in seconds (http://redis.io/commands/expire).

expireat Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

timestamp

-> m (f Bool) 

Set the expiration for a key as a UNIX timestamp (http://redis.io/commands/expireat).

keys Source #

Arguments

:: RedisCtx m f 
=> ByteString

pattern

-> m (f [ByteString]) 

Find all keys matching the given pattern (http://redis.io/commands/keys).

migrate Source #

Arguments

:: RedisCtx m f 
=> ByteString

host

-> ByteString

port

-> ByteString

key

-> Integer

destinationDb

-> Integer

timeout

-> m (f Status) 

Atomically transfer a key from a Redis instance to another one. (http://redis.io/commands/migrate).

move Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

db

-> m (f Bool) 

Move a key to another database (http://redis.io/commands/move).

objectRefcount Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Inspect the internals of Redis objects (http://redis.io/commands/object). The Redis command OBJECT is split up into objectRefcount, objectEncoding, objectIdletime.

objectEncoding Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f ByteString) 

Inspect the internals of Redis objects (http://redis.io/commands/object). The Redis command OBJECT is split up into objectRefcount, objectEncoding, objectIdletime.

objectIdletime Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Inspect the internals of Redis objects (http://redis.io/commands/object). The Redis command OBJECT is split up into objectRefcount, objectEncoding, objectIdletime.

persist Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Bool) 

Remove the expiration from a key (http://redis.io/commands/persist).

pexpire Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

milliseconds

-> m (f Bool) 

Set a key's time to live in milliseconds (http://redis.io/commands/pexpire).

pexpireat Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

millisecondsTimestamp

-> m (f Bool) 

Set the expiration for a key as a UNIX timestamp specified in milliseconds (http://redis.io/commands/pexpireat).

pttl Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Get the time to live for a key in milliseconds (http://redis.io/commands/pttl).

Return a random key from the keyspace (http://redis.io/commands/randomkey).

rename Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

newkey

-> m (f Status) 

renamenx Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

newkey

-> m (f Bool) 

Rename a key, only if the new key does not exist (http://redis.io/commands/renamenx).

restore Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

timeToLive

-> ByteString

serializedValue

-> m (f Status) 

Create a key using the provided serialized value, previously obtained using DUMP. (http://redis.io/commands/restore).

data SortOpts Source #

Options for the sort command.

defaultSortOpts :: SortOpts Source #

Redis default SortOpts. Equivalent to omitting all optional parameters.

SortOpts
    { sortBy    = Nothing -- omit the BY option
    , sortLimit = (0,-1)  -- return entire collection
    , sortGet   = []      -- omit the GET option
    , sortOrder = Asc     -- sort in ascending order
    , sortAlpha = False   -- sort numerically, not lexicographically
    }

sort Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> SortOpts 
-> m (f [ByteString]) 

Sort the elements in a list, set or sorted set (http://redis.io/commands/sort). The Redis command SORT is split up into sort, sortStore.

sortStore Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

destination

-> SortOpts 
-> m (f Integer) 

Sort the elements in a list, set or sorted set (http://redis.io/commands/sort). The Redis command SORT is split up into sort, sortStore.

ttl Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Get the time to live for a key (http://redis.io/commands/ttl).

getType Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f RedisType) 

Determine the type stored at key (http://redis.io/commands/type).

Hashes

hdel Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [ByteString]

field

-> m (f Integer) 

Delete one or more hash fields (http://redis.io/commands/hdel).

hexists Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

field

-> m (f Bool) 

Determine if a hash field exists (http://redis.io/commands/hexists).

hget Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

field

-> m (f (Maybe ByteString)) 

Get the value of a hash field (http://redis.io/commands/hget).

hgetall Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f [(ByteString, ByteString)]) 

Get all the fields and values in a hash (http://redis.io/commands/hgetall).

hincrby Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

field

-> Integer

increment

-> m (f Integer) 

Increment the integer value of a hash field by the given number (http://redis.io/commands/hincrby).

hincrbyfloat Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

field

-> Double

increment

-> m (f Double) 

Increment the float value of a hash field by the given amount (http://redis.io/commands/hincrbyfloat).

hkeys Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f [ByteString]) 

Get all the fields in a hash (http://redis.io/commands/hkeys).

hlen Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Get the number of fields in a hash (http://redis.io/commands/hlen).

hmget Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [ByteString]

field

-> m (f [Maybe ByteString]) 

Get the values of all the given hash fields (http://redis.io/commands/hmget).

hmset Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [(ByteString, ByteString)]

fieldValue

-> m (f Status) 

Set multiple hash fields to multiple values (http://redis.io/commands/hmset).

hset Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

field

-> ByteString

value

-> m (f Bool) 

Set the string value of a hash field (http://redis.io/commands/hset).

hsetnx Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

field

-> ByteString

value

-> m (f Bool) 

Set the value of a hash field, only if the field does not exist (http://redis.io/commands/hsetnx).

hvals Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f [ByteString]) 

Get all the values in a hash (http://redis.io/commands/hvals).

HyperLogLogs

pfadd Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [ByteString]

value

-> m (f Integer) 

Adds all the elements arguments to the HyperLogLog data structure stored at the variable name specified as first argument. (http://redis.io/commands/pfadd).

pfcount Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

key

-> m (f Integer) 

Returns the approximated cardinality for the union of the HyperLogLogs stored in the specified keys. (http://redis.io/commands/pfcount).

pfmerge Source #

Arguments

:: RedisCtx m f 
=> ByteString

destkey

-> [ByteString]

sourcekey

-> m (f ByteString) 

Merge multiple HyperLogLog values into an unique value that will approximate the cardinality of the union of the observed Sets of the source HyperLogLog structures. (http://redis.io/commands/pfmerge).

Lists

blpop Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

key

-> Integer

timeout

-> m (f (Maybe (ByteString, ByteString))) 

Remove and get the first element in a list, or block until one is available (http://redis.io/commands/blpop).

brpop Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

key

-> Integer

timeout

-> m (f (Maybe (ByteString, ByteString))) 

Remove and get the last element in a list, or block until one is available (http://redis.io/commands/brpop).

brpoplpush Source #

Arguments

:: RedisCtx m f 
=> ByteString

source

-> ByteString

destination

-> Integer

timeout

-> m (f (Maybe ByteString)) 

Pop a value from a list, push it to another list and return it; or block until one is available (http://redis.io/commands/brpoplpush).

lindex Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

index

-> m (f (Maybe ByteString)) 

Get an element from a list by its index (http://redis.io/commands/lindex).

linsertBefore Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

pivot

-> ByteString

value

-> m (f Integer) 

Insert an element before or after another element in a list (http://redis.io/commands/linsert). The Redis command LINSERT is split up into linsertBefore, linsertAfter.

linsertAfter Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

pivot

-> ByteString

value

-> m (f Integer) 

Insert an element before or after another element in a list (http://redis.io/commands/linsert). The Redis command LINSERT is split up into linsertBefore, linsertAfter.

llen Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Get the length of a list (http://redis.io/commands/llen).

lpop Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f (Maybe ByteString)) 

Remove and get the first element in a list (http://redis.io/commands/lpop).

lpush Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [ByteString]

value

-> m (f Integer) 

Prepend one or multiple values to a list (http://redis.io/commands/lpush).

lpushx Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

value

-> m (f Integer) 

Prepend a value to a list, only if the list exists (http://redis.io/commands/lpushx).

lrange Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

stop

-> m (f [ByteString]) 

Get a range of elements from a list (http://redis.io/commands/lrange).

lrem Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

count

-> ByteString

value

-> m (f Integer) 

Remove elements from a list (http://redis.io/commands/lrem).

lset Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

index

-> ByteString

value

-> m (f Status) 

Set the value of an element in a list by its index (http://redis.io/commands/lset).

ltrim Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

stop

-> m (f Status) 

Trim a list to the specified range (http://redis.io/commands/ltrim).

rpop Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f (Maybe ByteString)) 

Remove and get the last element in a list (http://redis.io/commands/rpop).

rpoplpush Source #

Arguments

:: RedisCtx m f 
=> ByteString

source

-> ByteString

destination

-> m (f (Maybe ByteString)) 

Remove the last element in a list, append it to another list and return it (http://redis.io/commands/rpoplpush).

rpush Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [ByteString]

value

-> m (f Integer) 

Append one or multiple values to a list (http://redis.io/commands/rpush).

rpushx Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

value

-> m (f Integer) 

Append a value to a list, only if the list exists (http://redis.io/commands/rpushx).

Scripting

eval Source #

Arguments

:: (RedisCtx m f, RedisResult a) 
=> ByteString

script

-> [ByteString]

keys

-> [ByteString]

args

-> m (f a) 

Execute a Lua script server side (http://redis.io/commands/eval).

evalsha Source #

Arguments

:: (RedisCtx m f, RedisResult a) 
=> ByteString

script

-> [ByteString]

keys

-> [ByteString]

args

-> m (f a) 

Execute a Lua script server side (http://redis.io/commands/evalsha).

scriptExists Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

script

-> m (f [Bool]) 

Check existence of scripts in the script cache. (http://redis.io/commands/script-exists).

Remove all the scripts from the script cache. (http://redis.io/commands/script-flush).

Kill the script currently in execution. (http://redis.io/commands/script-kill).

scriptLoad Source #

Arguments

:: RedisCtx m f 
=> ByteString

script

-> m (f ByteString) 

Load the specified Lua script into the script cache. (http://redis.io/commands/script-load).

Server

Asynchronously rewrite the append-only file (http://redis.io/commands/bgrewriteaof).

bgsave :: RedisCtx m f => m (f Status) Source #

Asynchronously save the dataset to disk (http://redis.io/commands/bgsave).

configGet Source #

Arguments

:: RedisCtx m f 
=> ByteString

parameter

-> m (f [(ByteString, ByteString)]) 

Get the value of a configuration parameter (http://redis.io/commands/config-get).

Reset the stats returned by INFO (http://redis.io/commands/config-resetstat).

configSet Source #

Arguments

:: RedisCtx m f 
=> ByteString

parameter

-> ByteString

value

-> m (f Status) 

Set a configuration parameter to the given value (http://redis.io/commands/config-set).

dbsize :: RedisCtx m f => m (f Integer) Source #

Return the number of keys in the selected database (http://redis.io/commands/dbsize).

debugObject Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f ByteString) 

Get debugging information about a key (http://redis.io/commands/debug-object).

flushall :: RedisCtx m f => m (f Status) Source #

Remove all keys from all databases (http://redis.io/commands/flushall).

flushdb :: RedisCtx m f => m (f Status) Source #

Remove all keys from the current database (http://redis.io/commands/flushdb).

info :: RedisCtx m f => m (f ByteString) Source #

Get information and statistics about the server (http://redis.io/commands/info).

lastsave :: RedisCtx m f => m (f Integer) Source #

Get the UNIX time stamp of the last successful save to disk (http://redis.io/commands/lastsave).

save :: RedisCtx m f => m (f Status) Source #

Synchronously save the dataset to disk (http://redis.io/commands/save).

slaveof Source #

Arguments

:: RedisCtx m f 
=> ByteString

host

-> ByteString

port

-> m (f Status) 

Make the server a slave of another instance, or promote it as master (http://redis.io/commands/slaveof).

data Slowlog Source #

A single entry from the slowlog.

Constructors

Slowlog 

Fields

slowlogGet Source #

Arguments

:: RedisCtx m f 
=> Integer

cnt

-> m (f [Slowlog]) 

Manages the Redis slow queries log (http://redis.io/commands/slowlog). The Redis command SLOWLOG is split up into slowlogGet, slowlogLen, slowlogReset.

Manages the Redis slow queries log (http://redis.io/commands/slowlog). The Redis command SLOWLOG is split up into slowlogGet, slowlogLen, slowlogReset.

Manages the Redis slow queries log (http://redis.io/commands/slowlog). The Redis command SLOWLOG is split up into slowlogGet, slowlogLen, slowlogReset.

time :: RedisCtx m f => m (f (Integer, Integer)) Source #

Return the current server time (http://redis.io/commands/time).

Sets

sadd Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [ByteString]

member

-> m (f Integer) 

Add one or more members to a set (http://redis.io/commands/sadd).

scard Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Get the number of members in a set (http://redis.io/commands/scard).

sdiff Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

key

-> m (f [ByteString]) 

Subtract multiple sets (http://redis.io/commands/sdiff).

sdiffstore Source #

Arguments

:: RedisCtx m f 
=> ByteString

destination

-> [ByteString]

key

-> m (f Integer) 

Subtract multiple sets and store the resulting set in a key (http://redis.io/commands/sdiffstore).

sinter Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

key

-> m (f [ByteString]) 

Intersect multiple sets (http://redis.io/commands/sinter).

sinterstore Source #

Arguments

:: RedisCtx m f 
=> ByteString

destination

-> [ByteString]

key

-> m (f Integer) 

Intersect multiple sets and store the resulting set in a key (http://redis.io/commands/sinterstore).

sismember Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

member

-> m (f Bool) 

Determine if a given value is a member of a set (http://redis.io/commands/sismember).

smembers Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f [ByteString]) 

Get all the members in a set (http://redis.io/commands/smembers).

smove Source #

Arguments

:: RedisCtx m f 
=> ByteString

source

-> ByteString

destination

-> ByteString

member

-> m (f Bool) 

Move a member from one set to another (http://redis.io/commands/smove).

spop Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f (Maybe ByteString)) 

Remove and return a random member from a set (http://redis.io/commands/spop).

srandmember Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f (Maybe ByteString)) 

Get a random member from a set (http://redis.io/commands/srandmember).

srem Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [ByteString]

member

-> m (f Integer) 

Remove one or more members from a set (http://redis.io/commands/srem).

sunion Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

key

-> m (f [ByteString]) 

Add multiple sets (http://redis.io/commands/sunion).

sunionstore Source #

Arguments

:: RedisCtx m f 
=> ByteString

destination

-> [ByteString]

key

-> m (f Integer) 

Add multiple sets and store the resulting set in a key (http://redis.io/commands/sunionstore).

Sorted Sets

zadd Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [(Double, ByteString)]

scoreMember

-> m (f Integer) 

Add one or more members to a sorted set, or update its score if it already exists (http://redis.io/commands/zadd).

zcard Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Get the number of members in a sorted set (http://redis.io/commands/zcard).

zcount Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

min

-> Double

max

-> m (f Integer) 

Count the members in a sorted set with scores within the given values (http://redis.io/commands/zcount).

zincrby Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

increment

-> ByteString

member

-> m (f Double) 

Increment the score of a member in a sorted set (http://redis.io/commands/zincrby).

zinterstore Source #

Arguments

:: RedisCtx m f 
=> ByteString

destination

-> [ByteString]

keys

-> Aggregate 
-> m (f Integer) 

Intersect multiple sorted sets and store the resulting sorted set in a new key (http://redis.io/commands/zinterstore). The Redis command ZINTERSTORE is split up into zinterstore, zinterstoreWeights.

zinterstoreWeights Source #

Arguments

:: RedisCtx m f 
=> ByteString

destination

-> [(ByteString, Double)]

weighted keys

-> Aggregate 
-> m (f Integer) 

Intersect multiple sorted sets and store the resulting sorted set in a new key (http://redis.io/commands/zinterstore). The Redis command ZINTERSTORE is split up into zinterstore, zinterstoreWeights.

zrange Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

stop

-> m (f [ByteString]) 

Return a range of members in a sorted set, by index (http://redis.io/commands/zrange). The Redis command ZRANGE is split up into zrange, zrangeWithscores.

zrangeWithscores Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

stop

-> m (f [(ByteString, Double)]) 

Return a range of members in a sorted set, by index (http://redis.io/commands/zrange). The Redis command ZRANGE is split up into zrange, zrangeWithscores.

zrangebyscore Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

min

-> Double

max

-> m (f [ByteString]) 

Return a range of members in a sorted set, by score (http://redis.io/commands/zrangebyscore). The Redis command ZRANGEBYSCORE is split up into zrangebyscore, zrangebyscoreWithscores, zrangebyscoreLimit, zrangebyscoreWithscoresLimit.

zrangebyscoreWithscores Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

min

-> Double

max

-> m (f [(ByteString, Double)]) 

Return a range of members in a sorted set, by score (http://redis.io/commands/zrangebyscore). The Redis command ZRANGEBYSCORE is split up into zrangebyscore, zrangebyscoreWithscores, zrangebyscoreLimit, zrangebyscoreWithscoresLimit.

zrangebyscoreLimit Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

min

-> Double

max

-> Integer

offset

-> Integer

count

-> m (f [ByteString]) 

Return a range of members in a sorted set, by score (http://redis.io/commands/zrangebyscore). The Redis command ZRANGEBYSCORE is split up into zrangebyscore, zrangebyscoreWithscores, zrangebyscoreLimit, zrangebyscoreWithscoresLimit.

zrangebyscoreWithscoresLimit Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

min

-> Double

max

-> Integer

offset

-> Integer

count

-> m (f [(ByteString, Double)]) 

Return a range of members in a sorted set, by score (http://redis.io/commands/zrangebyscore). The Redis command ZRANGEBYSCORE is split up into zrangebyscore, zrangebyscoreWithscores, zrangebyscoreLimit, zrangebyscoreWithscoresLimit.

zrank Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

member

-> m (f (Maybe Integer)) 

Determine the index of a member in a sorted set (http://redis.io/commands/zrank).

zrem Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> [ByteString]

member

-> m (f Integer) 

Remove one or more members from a sorted set (http://redis.io/commands/zrem).

zremrangebyrank Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

stop

-> m (f Integer) 

Remove all members in a sorted set within the given indexes (http://redis.io/commands/zremrangebyrank).

zremrangebyscore Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

min

-> Double

max

-> m (f Integer) 

Remove all members in a sorted set within the given scores (http://redis.io/commands/zremrangebyscore).

zrevrange Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

stop

-> m (f [ByteString]) 

Return a range of members in a sorted set, by index, with scores ordered from high to low (http://redis.io/commands/zrevrange). The Redis command ZREVRANGE is split up into zrevrange, zrevrangeWithscores.

zrevrangeWithscores Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

stop

-> m (f [(ByteString, Double)]) 

Return a range of members in a sorted set, by index, with scores ordered from high to low (http://redis.io/commands/zrevrange). The Redis command ZREVRANGE is split up into zrevrange, zrevrangeWithscores.

zrevrangebyscore Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

max

-> Double

min

-> m (f [ByteString]) 

Return a range of members in a sorted set, by score, with scores ordered from high to low (http://redis.io/commands/zrevrangebyscore). The Redis command ZREVRANGEBYSCORE is split up into zrevrangebyscore, zrevrangebyscoreWithscores, zrevrangebyscoreLimit, zrevrangebyscoreWithscoresLimit.

zrevrangebyscoreWithscores Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

max

-> Double

min

-> m (f [(ByteString, Double)]) 

Return a range of members in a sorted set, by score, with scores ordered from high to low (http://redis.io/commands/zrevrangebyscore). The Redis command ZREVRANGEBYSCORE is split up into zrevrangebyscore, zrevrangebyscoreWithscores, zrevrangebyscoreLimit, zrevrangebyscoreWithscoresLimit.

zrevrangebyscoreLimit Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

max

-> Double

min

-> Integer

offset

-> Integer

count

-> m (f [ByteString]) 

Return a range of members in a sorted set, by score, with scores ordered from high to low (http://redis.io/commands/zrevrangebyscore). The Redis command ZREVRANGEBYSCORE is split up into zrevrangebyscore, zrevrangebyscoreWithscores, zrevrangebyscoreLimit, zrevrangebyscoreWithscoresLimit.

zrevrangebyscoreWithscoresLimit Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

max

-> Double

min

-> Integer

offset

-> Integer

count

-> m (f [(ByteString, Double)]) 

Return a range of members in a sorted set, by score, with scores ordered from high to low (http://redis.io/commands/zrevrangebyscore). The Redis command ZREVRANGEBYSCORE is split up into zrevrangebyscore, zrevrangebyscoreWithscores, zrevrangebyscoreLimit, zrevrangebyscoreWithscoresLimit.

zrevrank Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

member

-> m (f (Maybe Integer)) 

Determine the index of a member in a sorted set, with scores ordered from high to low (http://redis.io/commands/zrevrank).

zscore Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

member

-> m (f (Maybe Double)) 

Get the score associated with the given member in a sorted set (http://redis.io/commands/zscore).

zunionstore Source #

Arguments

:: RedisCtx m f 
=> ByteString

destination

-> [ByteString]

keys

-> Aggregate 
-> m (f Integer) 

Add multiple sorted sets and store the resulting sorted set in a new key (http://redis.io/commands/zunionstore). The Redis command ZUNIONSTORE is split up into zunionstore, zunionstoreWeights.

zunionstoreWeights Source #

Arguments

:: RedisCtx m f 
=> ByteString

destination

-> [(ByteString, Double)]

weighted keys

-> Aggregate 
-> m (f Integer) 

Add multiple sorted sets and store the resulting sorted set in a new key (http://redis.io/commands/zunionstore). The Redis command ZUNIONSTORE is split up into zunionstore, zunionstoreWeights.

Strings

append Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

value

-> m (f Integer) 

Append a value to a key (http://redis.io/commands/append).

bitcount Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Count set bits in a string (http://redis.io/commands/bitcount). The Redis command BITCOUNT is split up into bitcount, bitcountRange.

bitcountRange Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

end

-> m (f Integer) 

Count set bits in a string (http://redis.io/commands/bitcount). The Redis command BITCOUNT is split up into bitcount, bitcountRange.

bitopAnd Source #

Arguments

:: RedisCtx m f 
=> ByteString

destkey

-> [ByteString]

srckeys

-> m (f Integer) 

Perform bitwise operations between strings (http://redis.io/commands/bitop). The Redis command BITOP is split up into bitopAnd, bitopOr, bitopXor, bitopNot.

bitopOr Source #

Arguments

:: RedisCtx m f 
=> ByteString

destkey

-> [ByteString]

srckeys

-> m (f Integer) 

Perform bitwise operations between strings (http://redis.io/commands/bitop). The Redis command BITOP is split up into bitopAnd, bitopOr, bitopXor, bitopNot.

bitopXor Source #

Arguments

:: RedisCtx m f 
=> ByteString

destkey

-> [ByteString]

srckeys

-> m (f Integer) 

Perform bitwise operations between strings (http://redis.io/commands/bitop). The Redis command BITOP is split up into bitopAnd, bitopOr, bitopXor, bitopNot.

bitopNot Source #

Arguments

:: RedisCtx m f 
=> ByteString

destkey

-> ByteString

srckey

-> m (f Integer) 

Perform bitwise operations between strings (http://redis.io/commands/bitop). The Redis command BITOP is split up into bitopAnd, bitopOr, bitopXor, bitopNot.

decr Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Decrement the integer value of a key by one (http://redis.io/commands/decr).

decrby Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

decrement

-> m (f Integer) 

Decrement the integer value of a key by the given number (http://redis.io/commands/decrby).

get Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f (Maybe ByteString)) 

Get the value of a key (http://redis.io/commands/get).

getbit Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

offset

-> m (f Integer) 

Returns the bit value at offset in the string value stored at key (http://redis.io/commands/getbit).

getrange Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

start

-> Integer

end

-> m (f ByteString) 

Get a substring of the string stored at a key (http://redis.io/commands/getrange).

getset Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

value

-> m (f (Maybe ByteString)) 

Set the string value of a key and return its old value (http://redis.io/commands/getset).

incr Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Increment the integer value of a key by one (http://redis.io/commands/incr).

incrby Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

increment

-> m (f Integer) 

Increment the integer value of a key by the given amount (http://redis.io/commands/incrby).

incrbyfloat Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Double

increment

-> m (f Double) 

Increment the float value of a key by the given amount (http://redis.io/commands/incrbyfloat).

mget Source #

Arguments

:: RedisCtx m f 
=> [ByteString]

key

-> m (f [Maybe ByteString]) 

Get the values of all the given keys (http://redis.io/commands/mget).

mset Source #

Arguments

:: RedisCtx m f 
=> [(ByteString, ByteString)]

keyValue

-> m (f Status) 

Set multiple keys to multiple values (http://redis.io/commands/mset).

msetnx Source #

Arguments

:: RedisCtx m f 
=> [(ByteString, ByteString)]

keyValue

-> m (f Bool) 

Set multiple keys to multiple values, only if none of the keys exist (http://redis.io/commands/msetnx).

psetex Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

milliseconds

-> ByteString

value

-> m (f Status) 

Set the value and expiration in milliseconds of a key (http://redis.io/commands/psetex).

set Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

value

-> m (f Status) 

Set the string value of a key (http://redis.io/commands/set).

setbit Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

offset

-> ByteString

value

-> m (f Integer) 

Sets or clears the bit at offset in the string value stored at key (http://redis.io/commands/setbit).

setex Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

seconds

-> ByteString

value

-> m (f Status) 

Set the value and expiration of a key (http://redis.io/commands/setex).

setnx Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> ByteString

value

-> m (f Bool) 

Set the value of a key, only if the key does not exist (http://redis.io/commands/setnx).

setrange Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> Integer

offset

-> ByteString

value

-> m (f Integer) 

Overwrite part of a string at key starting at the specified offset (http://redis.io/commands/setrange).

strlen Source #

Arguments

:: RedisCtx m f 
=> ByteString

key

-> m (f Integer) 

Get the length of the value stored in a key (http://redis.io/commands/strlen).

Unimplemented Commands

These commands are not implemented, as of now. Library users can implement these or other commands from experimental Redis versions by using the sendRequest function.

Transactions

watch Source #

Arguments

:: [ByteString]

key

-> Redis (Either Reply Status) 

Watch the given keys to determine execution of the MULTI/EXEC block (http://redis.io/commands/watch).

multiExec :: RedisTx (Queued a) -> Redis (TxResult a) Source #

Run commands inside a transaction. For documentation on the semantics of Redis transaction see http://redis.io/topics/transactions.

Inside the transaction block, command functions return their result wrapped in a Queued. The Queued result is a proxy object for the actual command's result, which will only be available after EXECing the transaction.

Example usage (note how Queued 's Applicative instance is used to combine the two individual results):

 runRedis conn $ do
     set "hello" "hello"
     set "world" "world"
     helloworld <- multiExec $ do
         hello <- get "hello"
         world <- get "world"
         return $ (,) <$> hello <*> world
     liftIO (print helloworld)
 

data Queued a Source #

A Queued value represents the result of a command inside a transaction. It is a proxy object for the actual result, which will only be available after returning from a multiExec transaction.

Queued values are composable by utilizing the Functor, Applicative or Monad interfaces.

Instances

Monad Queued Source # 

Methods

(>>=) :: Queued a -> (a -> Queued b) -> Queued b #

(>>) :: Queued a -> Queued b -> Queued b #

return :: a -> Queued a #

fail :: String -> Queued a #

Functor Queued Source # 

Methods

fmap :: (a -> b) -> Queued a -> Queued b #

(<$) :: a -> Queued b -> Queued a #

Applicative Queued Source # 

Methods

pure :: a -> Queued a #

(<*>) :: Queued (a -> b) -> Queued a -> Queued b #

(*>) :: Queued a -> Queued b -> Queued b #

(<*) :: Queued a -> Queued b -> Queued a #

RedisCtx RedisTx Queued Source # 

data TxResult a Source #

Result of a multiExec transaction.

Constructors

TxSuccess a

Transaction completed successfully. The wrapped value corresponds to the Queued value returned from the multiExec argument action.

TxAborted

Transaction aborted due to an earlier watch command.

TxError String

At least one of the commands returned an Error reply.

Instances

Eq a => Eq (TxResult a) Source # 

Methods

(==) :: TxResult a -> TxResult a -> Bool #

(/=) :: TxResult a -> TxResult a -> Bool #

Show a => Show (TxResult a) Source # 

Methods

showsPrec :: Int -> TxResult a -> ShowS #

show :: TxResult a -> String #

showList :: [TxResult a] -> ShowS #

Generic (TxResult a) Source # 

Associated Types

type Rep (TxResult a) :: * -> * #

Methods

from :: TxResult a -> Rep (TxResult a) x #

to :: Rep (TxResult a) x -> TxResult a #

NFData a => NFData (TxResult a) Source # 

Methods

rnf :: TxResult a -> () #

type Rep (TxResult a) Source # 
type Rep (TxResult a) = D1 (MetaData "TxResult" "Database.Redis.Transactions" "hedis-0.7.8-AXiOaDSsVkgA0aupzatkOg" False) ((:+:) (C1 (MetaCons "TxSuccess" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 a))) ((:+:) (C1 (MetaCons "TxAborted" PrefixI False) U1) (C1 (MetaCons "TxError" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 String)))))

data RedisTx a Source #

Command-context inside of MULTI/EXEC transactions. Use multiExec to run actions of this type.

In the RedisTx context, all commands return a Queued value. It is a proxy object for the actual result, which will only be available after finishing the transaction.

Instances

Monad RedisTx Source # 

Methods

(>>=) :: RedisTx a -> (a -> RedisTx b) -> RedisTx b #

(>>) :: RedisTx a -> RedisTx b -> RedisTx b #

return :: a -> RedisTx a #

fail :: String -> RedisTx a #

Functor RedisTx Source # 

Methods

fmap :: (a -> b) -> RedisTx a -> RedisTx b #

(<$) :: a -> RedisTx b -> RedisTx a #

Applicative RedisTx Source # 

Methods

pure :: a -> RedisTx a #

(<*>) :: RedisTx (a -> b) -> RedisTx a -> RedisTx b #

(*>) :: RedisTx a -> RedisTx b -> RedisTx b #

(<*) :: RedisTx a -> RedisTx b -> RedisTx a #

MonadIO RedisTx Source # 

Methods

liftIO :: IO a -> RedisTx a #

MonadRedis RedisTx Source # 

Methods

liftRedis :: Redis a -> RedisTx a

RedisCtx RedisTx Queued Source # 

Pub/Sub

publish Source #

Arguments

:: RedisCtx m f 
=> ByteString

channel

-> ByteString

message

-> m (f Integer) 

Post a message to a channel (http://redis.io/commands/publish).

pubSub Source #

Arguments

:: PubSub

Initial subscriptions.

-> (Message -> IO PubSub)

Callback function.

-> Redis () 

Listens to published messages on subscribed channels and channels matching the subscribed patterns. For documentation on the semantics of Redis Pub/Sub see http://redis.io/topics/pubsub.

The given callback function is called for each received message. Subscription changes are triggered by the returned PubSub. To keep subscriptions unchanged, the callback can return mempty.

Example: Subscribe to the "news" channel indefinitely.

 pubSub (subscribe ["news"]) $ \msg -> do
     putStrLn $ "Message from " ++ show (msgChannel msg)
     return mempty
 

Example: Receive a single message from the "chat" channel.

 pubSub (subscribe ["chat"]) $ \msg -> do
     putStrLn $ "Message from " ++ show (msgChannel msg)
     return $ unsubscribe ["chat"]
 

It should be noted that Redis Pub/Sub by its nature is asynchronous so returning unsubscribe does not mean that callback won't be able to receive any further messages. And to guarantee that you won't won't process messages after unsubscription and won't unsubscribe from the same channel more than once you need to use IORef or something similar

data PubSub Source #

Encapsulates subscription changes. Use subscribe, unsubscribe, psubscribe, punsubscribe or mempty to construct a value. Combine values by using the Monoid interface, i.e. mappend and mconcat.

Instances

subscribe Source #

Arguments

:: [ByteString]

channel

-> PubSub 

Listen for messages published to the given channels (http://redis.io/commands/subscribe).

unsubscribe Source #

Arguments

:: [ByteString]

channel

-> PubSub 

Stop listening for messages posted to the given channels (http://redis.io/commands/unsubscribe).

psubscribe Source #

Arguments

:: [ByteString]

pattern

-> PubSub 

Listen for messages published to channels matching the given patterns (http://redis.io/commands/psubscribe).

punsubscribe Source #

Arguments

:: [ByteString]

pattern

-> PubSub 

Stop listening for messages posted to channels matching the given patterns (http://redis.io/commands/punsubscribe).

Low-Level Command API

sendRequest :: (RedisCtx m f, RedisResult a) => [ByteString] -> m (f a) Source #

sendRequest can be used to implement commands from experimental versions of Redis. An example of how to implement a command is given below.

-- |Redis DEBUG OBJECT command
debugObject :: ByteString -> Redis (Either Reply ByteString)
debugObject key = sendRequest ["DEBUG", "OBJECT", key]

data Reply Source #

Low-level representation of replies from the Redis server.

data Status Source #

Constructors

Ok 
Pong 
Status ByteString 

Instances

Eq Status Source # 

Methods

(==) :: Status -> Status -> Bool #

(/=) :: Status -> Status -> Bool #

Show Status Source # 
Generic Status Source # 

Associated Types

type Rep Status :: * -> * #

Methods

from :: Status -> Rep Status x #

to :: Rep Status x -> Status #

NFData Status Source # 

Methods

rnf :: Status -> () #

RedisResult Status Source # 
type Rep Status Source # 
type Rep Status = D1 (MetaData "Status" "Database.Redis.Types" "hedis-0.7.8-AXiOaDSsVkgA0aupzatkOg" False) ((:+:) (C1 (MetaCons "Ok" PrefixI False) U1) ((:+:) (C1 (MetaCons "Pong" PrefixI False) U1) (C1 (MetaCons "Status" PrefixI False) (S1 (MetaSel (Nothing Symbol) NoSourceUnpackedness NoSourceStrictness DecidedLazy) (Rec0 ByteString)))))
Solution to Exercise

Type of expire inside a transaction:

expire :: ByteString -> Integer -> RedisTx (Queued Bool)

Type of lindex outside of a transaction:

lindex :: ByteString -> Integer -> Redis (Either Reply ByteString)