{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving, RecordWildCards,
    MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances, CPP,
    DeriveDataTypeable, StandaloneDeriving #-}

module Database.Redis.Core (
    Connection(..), ConnectError(..), connect, checkedConnect, disconnect,
    withConnect, withCheckedConnect,
    ConnectInfo(..), defaultConnectInfo,
    Redis(), runRedis, unRedis, reRedis,
    RedisCtx(..), MonadRedis(..),
    send, recv, sendRequest,
    auth, select, ping
) where

import Prelude
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Exception
import Control.Monad.Reader
import qualified Control.Monad.Catch as Catch
import qualified Data.ByteString as B
import Data.IORef
import Data.Pool
import Data.Time
import Data.Typeable
import qualified Network.Socket as NS
import Network.TLS (ClientParams)
import Database.Redis.Core.Internal
import Database.Redis.Protocol
import qualified Database.Redis.ProtocolPipelining as PP
import Database.Redis.Types


--------------------------------------------------------------------------------
-- The Redis Monad
--

-- |This class captures the following behaviour: In a context @m@, a command
--  will return its result wrapped in a \"container\" of type @f@.
--
--  Please refer to the Command Type Signatures section of this page for more
--  information.
class (MonadRedis m) => RedisCtx m f | m -> f where
    returnDecode :: RedisResult a => Reply -> m (f a)

instance RedisCtx Redis (Either Reply) where
    returnDecode :: Reply -> Redis (Either Reply a)
returnDecode = Either Reply a -> Redis (Either Reply a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either Reply a -> Redis (Either Reply a))
-> (Reply -> Either Reply a) -> Reply -> Redis (Either Reply a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Reply -> Either Reply a
forall a. RedisResult a => Reply -> Either Reply a
decode

class (Monad m) => MonadRedis m where
    liftRedis :: Redis a -> m a

instance MonadRedis Redis where
    liftRedis :: Redis a -> Redis a
liftRedis = Redis a -> Redis a
forall a. a -> a
id

-- |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.
runRedis :: Connection -> Redis a -> IO a
runRedis :: Connection -> Redis a -> IO a
runRedis (Conn Pool Connection
pool) Redis a
redis =
  Pool Connection -> (Connection -> IO a) -> IO a
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource Pool Connection
pool ((Connection -> IO a) -> IO a) -> (Connection -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> Connection -> Redis a -> IO a
forall a. Connection -> Redis a -> IO a
runRedisInternal Connection
conn Redis a
redis

-- |Deconstruct Redis constructor.
--
--  'unRedis' and 'reRedis' can be used to define instances for
--  arbitrary typeclasses.
-- 
--  WARNING! These functions are considered internal and no guarantee
--  is given at this point that they will not break in future.
unRedis :: Redis a -> ReaderT RedisEnv IO a
unRedis :: Redis a -> ReaderT RedisEnv IO a
unRedis (Redis ReaderT RedisEnv IO a
r) = ReaderT RedisEnv IO a
r

-- |Reconstruct Redis constructor.
reRedis :: ReaderT RedisEnv IO a -> Redis a
reRedis :: ReaderT RedisEnv IO a -> Redis a
reRedis ReaderT RedisEnv IO a
r = ReaderT RedisEnv IO a -> Redis a
forall a. ReaderT RedisEnv IO a -> Redis a
Redis ReaderT RedisEnv IO a
r

-- |Internal version of 'runRedis' that does not depend on the 'Connection'
--  abstraction. Used to run the AUTH command when connecting.
runRedisInternal :: PP.Connection -> Redis a -> IO a
runRedisInternal :: Connection -> Redis a -> IO a
runRedisInternal Connection
conn (Redis ReaderT RedisEnv IO a
redis) = do
  -- Dummy reply in case no request is sent.
  IORef Reply
ref <- Reply -> IO (IORef Reply)
forall a. a -> IO (IORef a)
newIORef (ByteString -> Reply
SingleLine ByteString
"nobody will ever see this")
  a
r <- ReaderT RedisEnv IO a -> RedisEnv -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT RedisEnv IO a
redis (Connection -> IORef Reply -> RedisEnv
Env Connection
conn IORef Reply
ref)
  -- Evaluate last reply to keep lazy IO inside runRedis.
  IORef Reply -> IO Reply
forall a. IORef a -> IO a
readIORef IORef Reply
ref IO Reply -> (Reply -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Reply -> IO () -> IO ()
`seq` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ())
  a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
r

setLastReply :: Reply -> ReaderT RedisEnv IO ()
setLastReply :: Reply -> ReaderT RedisEnv IO ()
setLastReply Reply
r = do
  IORef Reply
ref <- (RedisEnv -> IORef Reply) -> ReaderT RedisEnv IO (IORef Reply)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RedisEnv -> IORef Reply
envLastReply
  IO () -> ReaderT RedisEnv IO ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IORef Reply -> Reply -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Reply
ref Reply
r)

recv :: (MonadRedis m) => m Reply
recv :: m Reply
recv = Redis Reply -> m Reply
forall (m :: * -> *) a. MonadRedis m => Redis a -> m a
liftRedis (Redis Reply -> m Reply) -> Redis Reply -> m Reply
forall a b. (a -> b) -> a -> b
$ ReaderT RedisEnv IO Reply -> Redis Reply
forall a. ReaderT RedisEnv IO a -> Redis a
Redis (ReaderT RedisEnv IO Reply -> Redis Reply)
-> ReaderT RedisEnv IO Reply -> Redis Reply
forall a b. (a -> b) -> a -> b
$ do
  Connection
conn <- (RedisEnv -> Connection) -> ReaderT RedisEnv IO Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RedisEnv -> Connection
envConn
  Reply
r <- IO Reply -> ReaderT RedisEnv IO Reply
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (Connection -> IO Reply
PP.recv Connection
conn)
  Reply -> ReaderT RedisEnv IO ()
setLastReply Reply
r
  Reply -> ReaderT RedisEnv IO Reply
forall (m :: * -> *) a. Monad m => a -> m a
return Reply
r

send :: (MonadRedis m) => [B.ByteString] -> m ()
send :: [ByteString] -> m ()
send [ByteString]
req = Redis () -> m ()
forall (m :: * -> *) a. MonadRedis m => Redis a -> m a
liftRedis (Redis () -> m ()) -> Redis () -> m ()
forall a b. (a -> b) -> a -> b
$ ReaderT RedisEnv IO () -> Redis ()
forall a. ReaderT RedisEnv IO a -> Redis a
Redis (ReaderT RedisEnv IO () -> Redis ())
-> ReaderT RedisEnv IO () -> Redis ()
forall a b. (a -> b) -> a -> b
$ do
    Connection
conn <- (RedisEnv -> Connection) -> ReaderT RedisEnv IO Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RedisEnv -> Connection
envConn
    IO () -> ReaderT RedisEnv IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> ReaderT RedisEnv IO ())
-> IO () -> ReaderT RedisEnv IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO ()
PP.send Connection
conn ([ByteString] -> ByteString
renderRequest [ByteString]
req)

-- |'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]
-- @
--
sendRequest :: (RedisCtx m f, RedisResult a)
    => [B.ByteString] -> m (f a)
sendRequest :: [ByteString] -> m (f a)
sendRequest [ByteString]
req = do
    Reply
r' <- Redis Reply -> m Reply
forall (m :: * -> *) a. MonadRedis m => Redis a -> m a
liftRedis (Redis Reply -> m Reply) -> Redis Reply -> m Reply
forall a b. (a -> b) -> a -> b
$ ReaderT RedisEnv IO Reply -> Redis Reply
forall a. ReaderT RedisEnv IO a -> Redis a
Redis (ReaderT RedisEnv IO Reply -> Redis Reply)
-> ReaderT RedisEnv IO Reply -> Redis Reply
forall a b. (a -> b) -> a -> b
$ do
        Connection
conn <- (RedisEnv -> Connection) -> ReaderT RedisEnv IO Connection
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks RedisEnv -> Connection
envConn
        Reply
r <- IO Reply -> ReaderT RedisEnv IO Reply
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Reply -> ReaderT RedisEnv IO Reply)
-> IO Reply -> ReaderT RedisEnv IO Reply
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO Reply
PP.request Connection
conn ([ByteString] -> ByteString
renderRequest [ByteString]
req)
        Reply -> ReaderT RedisEnv IO ()
setLastReply Reply
r
        Reply -> ReaderT RedisEnv IO Reply
forall (m :: * -> *) a. Monad m => a -> m a
return Reply
r
    Reply -> m (f a)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
Reply -> m (f a)
returnDecode Reply
r'


--------------------------------------------------------------------------------
-- Connection
--

-- |A threadsafe pool of network connections to a Redis server. Use the
--  'connect' function to create one.
newtype Connection = Conn (Pool PP.Connection)

-- |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\"}
-- @
--
data ConnectInfo = ConnInfo
    { ConnectInfo -> HostName
connectHost           :: NS.HostName
    , ConnectInfo -> PortID
connectPort           :: PP.PortID
    , ConnectInfo -> Maybe ByteString
connectAuth           :: Maybe B.ByteString
    -- ^ When the server is protected by a password, set 'connectAuth' to 'Just'
    --   the password. Each connection will then authenticate by the 'auth'
    --   command.
    , ConnectInfo -> Integer
connectDatabase       :: Integer
    -- ^ Each connection will 'select' the database with the given index.
    , ConnectInfo -> Int
connectMaxConnections :: Int
    -- ^ Maximum number of connections to keep open. The smallest acceptable
    --   value is 1.
    , ConnectInfo -> NominalDiffTime
connectMaxIdleTime    :: NominalDiffTime
    -- ^ Amount of time for which an unused connection is kept open. The
    --   smallest acceptable value is 0.5 seconds. If the @timeout@ value in
    --   your redis.conf file is non-zero, it should be larger than
    --   'connectMaxIdleTime'.
    , ConnectInfo -> Maybe NominalDiffTime
connectTimeout        :: Maybe NominalDiffTime
    -- ^ Optional timeout until connection to Redis gets
    --   established. 'ConnectTimeoutException' gets thrown if no socket
    --   get connected in this interval of time.
    , ConnectInfo -> Maybe ClientParams
connectTLSParams      :: Maybe ClientParams
    -- ^ Optional TLS parameters. TLS will be enabled if this is provided.
    } deriving Int -> ConnectInfo -> ShowS
[ConnectInfo] -> ShowS
ConnectInfo -> HostName
(Int -> ConnectInfo -> ShowS)
-> (ConnectInfo -> HostName)
-> ([ConnectInfo] -> ShowS)
-> Show ConnectInfo
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [ConnectInfo] -> ShowS
$cshowList :: [ConnectInfo] -> ShowS
show :: ConnectInfo -> HostName
$cshow :: ConnectInfo -> HostName
showsPrec :: Int -> ConnectInfo -> ShowS
$cshowsPrec :: Int -> ConnectInfo -> ShowS
Show

data ConnectError = ConnectAuthError Reply
                  | ConnectSelectError Reply
    deriving (ConnectError -> ConnectError -> Bool
(ConnectError -> ConnectError -> Bool)
-> (ConnectError -> ConnectError -> Bool) -> Eq ConnectError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectError -> ConnectError -> Bool
$c/= :: ConnectError -> ConnectError -> Bool
== :: ConnectError -> ConnectError -> Bool
$c== :: ConnectError -> ConnectError -> Bool
Eq, Int -> ConnectError -> ShowS
[ConnectError] -> ShowS
ConnectError -> HostName
(Int -> ConnectError -> ShowS)
-> (ConnectError -> HostName)
-> ([ConnectError] -> ShowS)
-> Show ConnectError
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [ConnectError] -> ShowS
$cshowList :: [ConnectError] -> ShowS
show :: ConnectError -> HostName
$cshow :: ConnectError -> HostName
showsPrec :: Int -> ConnectError -> ShowS
$cshowsPrec :: Int -> ConnectError -> ShowS
Show, Typeable)

instance Exception ConnectError

-- |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
--  connectTimeout        = Nothing         -- Don't add timeout logic
--  connectTLSParams      = Nothing         -- Do not use TLS
-- @
--
defaultConnectInfo :: ConnectInfo
defaultConnectInfo :: ConnectInfo
defaultConnectInfo = ConnInfo :: HostName
-> PortID
-> Maybe ByteString
-> Integer
-> Int
-> NominalDiffTime
-> Maybe NominalDiffTime
-> Maybe ClientParams
-> ConnectInfo
ConnInfo
    { connectHost :: HostName
connectHost           = HostName
"localhost"
    , connectPort :: PortID
connectPort           = PortNumber -> PortID
PP.PortNumber PortNumber
6379
    , connectAuth :: Maybe ByteString
connectAuth           = Maybe ByteString
forall a. Maybe a
Nothing
    , connectDatabase :: Integer
connectDatabase       = Integer
0
    , connectMaxConnections :: Int
connectMaxConnections = Int
50
    , connectMaxIdleTime :: NominalDiffTime
connectMaxIdleTime    = NominalDiffTime
30
    , connectTimeout :: Maybe NominalDiffTime
connectTimeout        = Maybe NominalDiffTime
forall a. Maybe a
Nothing
    , connectTLSParams :: Maybe ClientParams
connectTLSParams      = Maybe ClientParams
forall a. Maybe a
Nothing
    }

-- |Constructs a 'Connection' pool to a Redis server designated by the 
--  given 'ConnectInfo'. The first connection is not actually established
--  until the first call to the server.
connect :: ConnectInfo -> IO Connection
connect :: ConnectInfo -> IO Connection
connect ConnInfo{Int
Integer
HostName
Maybe ByteString
Maybe NominalDiffTime
Maybe ClientParams
NominalDiffTime
PortID
connectTLSParams :: Maybe ClientParams
connectTimeout :: Maybe NominalDiffTime
connectMaxIdleTime :: NominalDiffTime
connectMaxConnections :: Int
connectDatabase :: Integer
connectAuth :: Maybe ByteString
connectPort :: PortID
connectHost :: HostName
connectTLSParams :: ConnectInfo -> Maybe ClientParams
connectTimeout :: ConnectInfo -> Maybe NominalDiffTime
connectMaxIdleTime :: ConnectInfo -> NominalDiffTime
connectMaxConnections :: ConnectInfo -> Int
connectDatabase :: ConnectInfo -> Integer
connectAuth :: ConnectInfo -> Maybe ByteString
connectPort :: ConnectInfo -> PortID
connectHost :: ConnectInfo -> HostName
..} = Pool Connection -> Connection
Conn (Pool Connection -> Connection)
-> IO (Pool Connection) -> IO Connection
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    IO Connection
-> (Connection -> IO ())
-> Int
-> NominalDiffTime
-> Int
-> IO (Pool Connection)
forall a.
IO a
-> (a -> IO ()) -> Int -> NominalDiffTime -> Int -> IO (Pool a)
createPool IO Connection
create Connection -> IO ()
destroy Int
1 NominalDiffTime
connectMaxIdleTime Int
connectMaxConnections
  where
    create :: IO Connection
create = do
        let timeoutOptUs :: Maybe Int
timeoutOptUs =
              NominalDiffTime -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (NominalDiffTime -> Int)
-> (NominalDiffTime -> NominalDiffTime) -> NominalDiffTime -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NominalDiffTime
1000000 NominalDiffTime -> NominalDiffTime -> NominalDiffTime
forall a. Num a => a -> a -> a
*) (NominalDiffTime -> Int) -> Maybe NominalDiffTime -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe NominalDiffTime
connectTimeout
        Connection
conn <- HostName -> PortID -> Maybe Int -> IO Connection
PP.connect HostName
connectHost PortID
connectPort Maybe Int
timeoutOptUs
        Connection
conn' <- case Maybe ClientParams
connectTLSParams of
                   Maybe ClientParams
Nothing -> Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn
                   Just ClientParams
tlsParams -> ClientParams -> Connection -> IO Connection
PP.enableTLS ClientParams
tlsParams Connection
conn
        Connection -> IO ()
PP.beginReceiving Connection
conn'

        Connection -> Redis () -> IO ()
forall a. Connection -> Redis a -> IO a
runRedisInternal Connection
conn' (Redis () -> IO ()) -> Redis () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            -- AUTH
            case Maybe ByteString
connectAuth of
                Maybe ByteString
Nothing   -> () -> Redis ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just ByteString
pass -> do
                  Either Reply Status
resp <- ByteString -> Redis (Either Reply Status)
auth ByteString
pass
                  case Either Reply Status
resp of
                    Left Reply
r -> IO () -> Redis ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Redis ()) -> IO () -> Redis ()
forall a b. (a -> b) -> a -> b
$ ConnectError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ConnectError -> IO ()) -> ConnectError -> IO ()
forall a b. (a -> b) -> a -> b
$ Reply -> ConnectError
ConnectAuthError Reply
r
                    Either Reply Status
_      -> () -> Redis ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            -- SELECT
            Bool -> Redis () -> Redis ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
connectDatabase Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
0) (Redis () -> Redis ()) -> Redis () -> Redis ()
forall a b. (a -> b) -> a -> b
$ do
              Either Reply Status
resp <- Integer -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *).
RedisCtx m f =>
Integer -> m (f Status)
select Integer
connectDatabase
              case Either Reply Status
resp of
                  Left Reply
r -> IO () -> Redis ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Redis ()) -> IO () -> Redis ()
forall a b. (a -> b) -> a -> b
$ ConnectError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (ConnectError -> IO ()) -> ConnectError -> IO ()
forall a b. (a -> b) -> a -> b
$ Reply -> ConnectError
ConnectSelectError Reply
r
                  Either Reply Status
_      -> () -> Redis ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn'

    destroy :: Connection -> IO ()
destroy = Connection -> IO ()
PP.disconnect

-- |Constructs a 'Connection' pool to a Redis server designated by the
--  given 'ConnectInfo', then tests if the server is actually there. 
--  Throws an exception if the connection to the Redis server can't be
--  established.
checkedConnect :: ConnectInfo -> IO Connection
checkedConnect :: ConnectInfo -> IO Connection
checkedConnect ConnectInfo
connInfo = do
    Connection
conn <- ConnectInfo -> IO Connection
connect ConnectInfo
connInfo
    Connection -> Redis () -> IO ()
forall a. Connection -> Redis a -> IO a
runRedis Connection
conn (Redis () -> IO ()) -> Redis () -> IO ()
forall a b. (a -> b) -> a -> b
$ Redis (Either Reply Status) -> Redis ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *). RedisCtx m f => m (f Status)
ping
    Connection -> IO Connection
forall (m :: * -> *) a. Monad m => a -> m a
return Connection
conn

-- |Destroy all idle resources in the pool.
disconnect :: Connection -> IO ()
disconnect :: Connection -> IO ()
disconnect (Conn Pool Connection
pool) = Pool Connection -> IO ()
forall a. Pool a -> IO ()
destroyAllResources Pool Connection
pool

-- | Memory bracket around 'connect' and 'disconnect'. 
withConnect :: (Catch.MonadMask m, MonadIO m) => ConnectInfo -> (Connection -> m c) -> m c
withConnect :: ConnectInfo -> (Connection -> m c) -> m c
withConnect ConnectInfo
connInfo = m Connection -> (Connection -> m ()) -> (Connection -> m c) -> m c
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
Catch.bracket (IO Connection -> m Connection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> IO Connection
connect ConnectInfo
connInfo) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Connection -> IO ()) -> Connection -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
disconnect)

-- | Memory bracket around 'checkedConnect' and 'disconnect'
withCheckedConnect :: (Catch.MonadMask m, MonadIO m) => ConnectInfo -> (Connection -> m c) -> m c
withCheckedConnect :: ConnectInfo -> (Connection -> m c) -> m c
withCheckedConnect ConnectInfo
connInfo = m Connection -> (Connection -> m ()) -> (Connection -> m c) -> m c
forall (m :: * -> *) a c b.
MonadMask m =>
m a -> (a -> m c) -> (a -> m b) -> m b
Catch.bracket (IO Connection -> m Connection
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Connection -> m Connection) -> IO Connection -> m Connection
forall a b. (a -> b) -> a -> b
$ ConnectInfo -> IO Connection
checkedConnect ConnectInfo
connInfo) (IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (Connection -> IO ()) -> Connection -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Connection -> IO ()
disconnect)

-- The AUTH command. It has to be here because it is used in 'connect'.
auth
    :: B.ByteString -- ^ password
    -> Redis (Either Reply Status)
auth :: ByteString -> Redis (Either Reply Status)
auth ByteString
password = [ByteString] -> Redis (Either Reply Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"AUTH", ByteString
password]

-- The SELECT command. Used in 'connect'.
select
    :: RedisCtx m f
    => Integer -- ^ index
    -> m (f Status)
select :: Integer -> m (f Status)
select Integer
ix = [ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest [ByteString
"SELECT", Integer -> ByteString
forall a. RedisArg a => a -> ByteString
encode Integer
ix]

-- The PING command. Used in 'checkedConnect'.
ping
    :: (RedisCtx m f)
    => m (f Status)
ping :: m (f Status)
ping  = [ByteString] -> m (f Status)
forall (m :: * -> *) (f :: * -> *) a.
(RedisCtx m f, RedisResult a) =>
[ByteString] -> m (f a)
sendRequest ([ByteString
"PING"] )