{-# LANGUAGE CPP #-}
module Database.Memcache.Client (
newClient, Client, ServerSpec(..), Options(..),
Authentication(..), Username, Password, def,
quit,
get, gat, touch,
set, cas, add, replace,
increment, decrement, append, prepend,
delete, flush,
StatResults, stats, version,
MemcacheError(..), Status(..), ClientError(..), ProtocolError(..)
) where
import Database.Memcache.Cluster
import Database.Memcache.Errors
import Database.Memcache.Server
import Database.Memcache.Socket
import Database.Memcache.Types hiding (cas)
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Control.Exception (handle, throwIO, SomeException)
import Control.Monad (forM_, void, when)
import Data.Default.Class
import Data.Word
import Data.ByteString (ByteString)
import qualified Data.ByteString as B (null)
type Client = Cluster
newClient :: [ServerSpec] -> Options -> IO Client
newClient :: [ServerSpec] -> Options -> IO Client
newClient [ServerSpec]
scs = do
case [ServerSpec]
scs of
[] -> [ServerSpec] -> Options -> IO Client
newCluster [ServerSpec
forall a. Default a => a
def]
[ServerSpec]
_ -> [ServerSpec] -> Options -> IO Client
newCluster [ServerSpec]
scs
quit :: Cluster -> IO ()
quit :: Client -> IO ()
quit Client
c = IO [(Server, ())] -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO [(Server, ())] -> IO ()) -> IO [(Server, ())] -> IO ()
forall a b. (a -> b) -> a -> b
$ Client -> (Server -> IO ()) -> IO [(Server, ())]
forall a. Client -> (Server -> IO a) -> IO [(Server, a)]
allOp' Client
c Server -> IO ()
serverQuit
where
serverQuit :: Server -> IO ()
serverQuit :: Server -> IO ()
serverQuit Server
s = (SomeException -> IO ()) -> IO () -> IO ()
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle SomeException -> IO ()
consumeError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> OpRequest
ReqQuit Q
Quiet }
Server -> (Socket -> IO ()) -> IO ()
forall a. Server -> (Socket -> IO a) -> IO a
withSocket Server
s ((Socket -> IO ()) -> IO ()) -> (Socket -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> Socket -> Request -> IO ()
send Socket
sock Request
msg
Server -> IO ()
close Server
s
consumeError :: SomeException -> IO ()
consumeError :: SomeException -> IO ()
consumeError SomeException
_ = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
get :: Cluster -> Key -> IO (Maybe (Value, Flags, Version))
get :: Client -> Key -> IO (Maybe (Key, Flags, Version))
get Client
c Key
k = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> K -> Key -> OpRequest
ReqGet Q
Loud K
NoKey Key
k }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
(Key
v, Flags
f) <- case Response -> OpResponse
resOp Response
r of
ResGet Q
Loud Key
v Flags
f -> (Key, Flags) -> IO (Key, Flags)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key
v, Flags
f)
OpResponse
_ -> MemcacheError -> IO (Key, Flags)
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO (Key, Flags))
-> MemcacheError -> IO (Key, Flags)
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"GET"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe (Key, Flags, Version) -> IO (Maybe (Key, Flags, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Key, Flags, Version) -> IO (Maybe (Key, Flags, Version)))
-> Maybe (Key, Flags, Version) -> IO (Maybe (Key, Flags, Version))
forall a b. (a -> b) -> a -> b
$ (Key, Flags, Version) -> Maybe (Key, Flags, Version)
forall a. a -> Maybe a
Just (Key
v, Flags
f, Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe (Key, Flags, Version) -> IO (Maybe (Key, Flags, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Key, Flags, Version)
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe (Key, Flags, Version))
forall a. Status -> IO a
throwStatus Status
rs
gat :: Cluster -> Key -> Expiration -> IO (Maybe (Value, Flags, Version))
gat :: Client -> Key -> Flags -> IO (Maybe (Key, Flags, Version))
gat Client
c Key
k Flags
e = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> K -> Key -> SETouch -> OpRequest
ReqGAT Q
Loud K
NoKey Key
k (Flags -> SETouch
SETouch Flags
e) }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
(Key
v, Flags
f) <- case Response -> OpResponse
resOp Response
r of
ResGAT Q
Loud Key
v Flags
f -> (Key, Flags) -> IO (Key, Flags)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key
v, Flags
f)
OpResponse
_ -> MemcacheError -> IO (Key, Flags)
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO (Key, Flags))
-> MemcacheError -> IO (Key, Flags)
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"GAT"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe (Key, Flags, Version) -> IO (Maybe (Key, Flags, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Key, Flags, Version) -> IO (Maybe (Key, Flags, Version)))
-> Maybe (Key, Flags, Version) -> IO (Maybe (Key, Flags, Version))
forall a b. (a -> b) -> a -> b
$ (Key, Flags, Version) -> Maybe (Key, Flags, Version)
forall a. a -> Maybe a
Just (Key
v, Flags
f, Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe (Key, Flags, Version) -> IO (Maybe (Key, Flags, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Key, Flags, Version)
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe (Key, Flags, Version))
forall a. Status -> IO a
throwStatus Status
rs
touch :: Cluster -> Key -> Expiration -> IO (Maybe Version)
touch :: Client -> Key -> Flags -> IO (Maybe Version)
touch Client
c Key
k Flags
e = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Key -> SETouch -> OpRequest
ReqTouch Key
k (Flags -> SETouch
SETouch Flags
e) }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= OpResponse
ResTouch) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"TOUCH"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just (Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe Version)
forall a. Status -> IO a
throwStatus Status
rs
set :: Cluster -> Key -> Value -> Flags -> Expiration -> IO Version
set :: Client -> Key -> Key -> Flags -> Flags -> IO Version
set Client
c Key
k Key
v Flags
f Flags
e = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> Key -> SESet -> OpRequest
ReqSet Q
Loud Key
k Key
v (Flags -> Flags -> SESet
SESet Flags
f Flags
e) }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= Q -> OpResponse
ResSet Q
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"SET"
case Response -> Status
resStatus Response
r of
Status
NoError -> Version -> IO Version
forall (m :: * -> *) a. Monad m => a -> m a
return (Version -> IO Version) -> Version -> IO Version
forall a b. (a -> b) -> a -> b
$ Response -> Version
resCas Response
r
Status
rs -> Status -> IO Version
forall a. Status -> IO a
throwStatus Status
rs
cas :: Cluster -> Key -> Value -> Flags -> Expiration -> Version -> IO (Maybe Version)
cas :: Client
-> Key -> Key -> Flags -> Flags -> Version -> IO (Maybe Version)
cas Client
c Key
k Key
v Flags
f Flags
e Version
ver = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> Key -> SESet -> OpRequest
ReqSet Q
Loud Key
k Key
v (Flags -> Flags -> SESet
SESet Flags
f Flags
e), reqCas :: Version
reqCas = Version
ver }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= Q -> OpResponse
ResSet Q
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"SET"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just (Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
Status
ErrKeyExists -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe Version)
forall a. Status -> IO a
throwStatus Status
rs
add :: Cluster -> Key -> Value -> Flags -> Expiration -> IO (Maybe Version)
add :: Client -> Key -> Key -> Flags -> Flags -> IO (Maybe Version)
add Client
c Key
k Key
v Flags
f Flags
e = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> Key -> SESet -> OpRequest
ReqAdd Q
Loud Key
k Key
v (Flags -> Flags -> SESet
SESet Flags
f Flags
e) }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= Q -> OpResponse
ResAdd Q
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"ADD"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just (Response -> Version
resCas Response
r)
Status
ErrKeyExists -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe Version)
forall a. Status -> IO a
throwStatus Status
rs
replace :: Cluster -> Key -> Value -> Flags -> Expiration -> Version -> IO (Maybe Version)
replace :: Client
-> Key -> Key -> Flags -> Flags -> Version -> IO (Maybe Version)
replace Client
c Key
k Key
v Flags
f Flags
e Version
ver = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> Key -> SESet -> OpRequest
ReqReplace Q
Loud Key
k Key
v (Flags -> Flags -> SESet
SESet Flags
f Flags
e), reqCas :: Version
reqCas = Version
ver }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= Q -> OpResponse
ResReplace Q
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"REPLACE"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just (Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
Status
ErrKeyExists -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe Version)
forall a. Status -> IO a
throwStatus Status
rs
increment :: Cluster -> Key -> Initial -> Delta -> Expiration -> Version -> IO (Maybe (Word64, Version))
increment :: Client
-> Key
-> Version
-> Version
-> Flags
-> Version
-> IO (Maybe (Version, Version))
increment Client
c Key
k Version
i Version
d Flags
e Version
ver = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> SEIncr -> OpRequest
ReqIncrement Q
Loud Key
k (Version -> Version -> Flags -> SEIncr
SEIncr Version
i Version
d Flags
e), reqCas :: Version
reqCas = Version
ver }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Version
n <- case Response -> OpResponse
resOp Response
r of
ResIncrement Q
Loud Version
n -> Version -> IO Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
n
OpResponse
_ -> MemcacheError -> IO Version
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO Version) -> MemcacheError -> IO Version
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"INCREMENT"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe (Version, Version) -> IO (Maybe (Version, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Version, Version) -> IO (Maybe (Version, Version)))
-> Maybe (Version, Version) -> IO (Maybe (Version, Version))
forall a b. (a -> b) -> a -> b
$ (Version, Version) -> Maybe (Version, Version)
forall a. a -> Maybe a
Just (Version
n, Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe (Version, Version) -> IO (Maybe (Version, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Version, Version)
forall a. Maybe a
Nothing
Status
ErrKeyExists -> Maybe (Version, Version) -> IO (Maybe (Version, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Version, Version)
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe (Version, Version))
forall a. Status -> IO a
throwStatus Status
rs
decrement :: Cluster -> Key -> Initial -> Delta -> Expiration -> Version -> IO (Maybe (Word64, Version))
decrement :: Client
-> Key
-> Version
-> Version
-> Flags
-> Version
-> IO (Maybe (Version, Version))
decrement Client
c Key
k Version
i Version
d Flags
e Version
ver = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> SEIncr -> OpRequest
ReqDecrement Q
Loud Key
k (Version -> Version -> Flags -> SEIncr
SEIncr Version
i Version
d Flags
e), reqCas :: Version
reqCas = Version
ver }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Version
n <- case Response -> OpResponse
resOp Response
r of
ResDecrement Q
Loud Version
n -> Version -> IO Version
forall (m :: * -> *) a. Monad m => a -> m a
return Version
n
OpResponse
_ -> MemcacheError -> IO Version
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO Version) -> MemcacheError -> IO Version
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"DECREMENT"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe (Version, Version) -> IO (Maybe (Version, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe (Version, Version) -> IO (Maybe (Version, Version)))
-> Maybe (Version, Version) -> IO (Maybe (Version, Version))
forall a b. (a -> b) -> a -> b
$ (Version, Version) -> Maybe (Version, Version)
forall a. a -> Maybe a
Just (Version
n, Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe (Version, Version) -> IO (Maybe (Version, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Version, Version)
forall a. Maybe a
Nothing
Status
ErrKeyExists -> Maybe (Version, Version) -> IO (Maybe (Version, Version))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (Version, Version)
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe (Version, Version))
forall a. Status -> IO a
throwStatus Status
rs
append :: Cluster -> Key -> Value -> Version -> IO (Maybe Version)
append :: Client -> Key -> Key -> Version -> IO (Maybe Version)
append Client
c Key
k Key
v Version
ver = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> Key -> OpRequest
ReqAppend Q
Loud Key
k Key
v, reqCas :: Version
reqCas = Version
ver }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= Q -> OpResponse
ResAppend Q
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"APPEND"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just (Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe Version)
forall a. Status -> IO a
throwStatus Status
rs
prepend :: Cluster -> Key -> Value -> Version -> IO (Maybe Version)
prepend :: Client -> Key -> Key -> Version -> IO (Maybe Version)
prepend Client
c Key
k Key
v Version
ver = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> Key -> OpRequest
ReqPrepend Q
Loud Key
k Key
v, reqCas :: Version
reqCas = Version
ver }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= Q -> OpResponse
ResPrepend Q
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"PREPEND"
case Response -> Status
resStatus Response
r of
Status
NoError -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Version -> IO (Maybe Version))
-> Maybe Version -> IO (Maybe Version)
forall a b. (a -> b) -> a -> b
$ Version -> Maybe Version
forall a. a -> Maybe a
Just (Response -> Version
resCas Response
r)
Status
ErrKeyNotFound -> Maybe Version -> IO (Maybe Version)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Version
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe Version)
forall a. Status -> IO a
throwStatus Status
rs
delete :: Cluster -> Key -> Version -> IO Bool
delete :: Client -> Key -> Version -> IO Bool
delete Client
c Key
k Version
ver = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Key -> OpRequest
ReqDelete Q
Loud Key
k, reqCas :: Version
reqCas = Version
ver }
Response
r <- Client -> Key -> Request -> IO Response
keyedOp Client
c Key
k Request
msg
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= Q -> OpResponse
ResDelete Q
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"DELETE"
case Response -> Status
resStatus Response
r of
Status
NoError -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
Status
ErrKeyNotFound -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Status
ErrKeyExists -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
Status
rs -> Status -> IO Bool
forall a. Status -> IO a
throwStatus Status
rs
flush :: Cluster -> Maybe Expiration -> IO ()
flush :: Client -> Maybe Flags -> IO ()
flush Client
c Maybe Flags
e = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Q -> Maybe SETouch -> OpRequest
ReqFlush Q
Loud (Flags -> SETouch
SETouch (Flags -> SETouch) -> Maybe Flags -> Maybe SETouch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Flags
e) }
[(Server, Response)]
results <- Client -> Request -> IO [(Server, Response)]
allOp Client
c Request
msg
[(Server, Response)] -> ((Server, Response) -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(Server, Response)]
results (((Server, Response) -> IO ()) -> IO ())
-> ((Server, Response) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Server
_, Response
r) -> do
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Response -> OpResponse
resOp Response
r OpResponse -> OpResponse -> Bool
forall a. Eq a => a -> a -> Bool
/= Q -> OpResponse
ResFlush Q
Loud) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ MemcacheError -> IO ()
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO ()) -> MemcacheError -> IO ()
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"FLUSH"
case Response -> Status
resStatus Response
r of
Status
NoError -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Status
rs -> Status -> IO ()
forall a. Status -> IO a
throwStatus Status
rs
type StatResults = [(ByteString, ByteString)]
stats :: Cluster -> Maybe Key -> IO [(Server, Maybe StatResults)]
stats :: Client -> Maybe Key -> IO [(Server, Maybe StatResults)]
stats Client
c Maybe Key
key = Client
-> (Server -> IO (Maybe StatResults))
-> IO [(Server, Maybe StatResults)]
forall a. Client -> (Server -> IO a) -> IO [(Server, a)]
allOp' Client
c Server -> IO (Maybe StatResults)
serverStats
where
msg :: Request
msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = Maybe Key -> OpRequest
ReqStat Maybe Key
key }
serverStats :: Server -> IO (Maybe StatResults)
serverStats :: Server -> IO (Maybe StatResults)
serverStats Server
s = Server
-> (Socket -> IO (Maybe StatResults)) -> IO (Maybe StatResults)
forall a. Server -> (Socket -> IO a) -> IO a
withSocket Server
s ((Socket -> IO (Maybe StatResults)) -> IO (Maybe StatResults))
-> (Socket -> IO (Maybe StatResults)) -> IO (Maybe StatResults)
forall a b. (a -> b) -> a -> b
$ \Socket
sock -> do
Socket -> Request -> IO ()
send Socket
sock Request
msg
Socket -> StatResults -> IO (Maybe StatResults)
recvAllStats Socket
sock []
recvAllStats :: Socket -> StatResults -> IO (Maybe StatResults)
recvAllStats :: Socket -> StatResults -> IO (Maybe StatResults)
recvAllStats Socket
s StatResults
xs = do
Response
r <- Socket -> IO Response
recv Socket
s
(Key
k, Key
v) <- case Response -> OpResponse
resOp Response
r of
ResStat Key
k Key
v -> (Key, Key) -> IO (Key, Key)
forall (m :: * -> *) a. Monad m => a -> m a
return (Key
k, Key
v)
OpResponse
_ -> MemcacheError -> IO (Key, Key)
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO (Key, Key)) -> MemcacheError -> IO (Key, Key)
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"STATS"
case Response -> Status
resStatus Response
r of
Status
NoError | Key -> Bool
B.null Key
k Bool -> Bool -> Bool
&& Key -> Bool
B.null Key
v -> Maybe StatResults -> IO (Maybe StatResults)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe StatResults -> IO (Maybe StatResults))
-> Maybe StatResults -> IO (Maybe StatResults)
forall a b. (a -> b) -> a -> b
$ StatResults -> Maybe StatResults
forall a. a -> Maybe a
Just StatResults
xs
| Bool
otherwise -> Socket -> StatResults -> IO (Maybe StatResults)
recvAllStats Socket
s (StatResults -> IO (Maybe StatResults))
-> StatResults -> IO (Maybe StatResults)
forall a b. (a -> b) -> a -> b
$ (Key
k, Key
v)(Key, Key) -> StatResults -> StatResults
forall a. a -> [a] -> [a]
:StatResults
xs
Status
ErrKeyNotFound -> Maybe StatResults -> IO (Maybe StatResults)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe StatResults
forall a. Maybe a
Nothing
Status
rs -> Status -> IO (Maybe StatResults)
forall a. Status -> IO a
throwStatus Status
rs
version :: Cluster -> IO ByteString
version :: Client -> IO Key
version Client
c = do
let msg :: Request
msg = Request
emptyReq { reqOp :: OpRequest
reqOp = OpRequest
ReqVersion }
Response
r <- Client -> Request -> IO Response
anyOp Client
c Request
msg
Key
v <- case Response -> OpResponse
resOp Response
r of
ResVersion Key
v -> Key -> IO Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
v
OpResponse
_ -> MemcacheError -> IO Key
forall e a. Exception e => e -> IO a
throwIO (MemcacheError -> IO Key) -> MemcacheError -> IO Key
forall a b. (a -> b) -> a -> b
$ Response -> String -> MemcacheError
wrongOp Response
r String
"VERSION"
case Response -> Status
resStatus Response
r of
Status
NoError -> Key -> IO Key
forall (m :: * -> *) a. Monad m => a -> m a
return Key
v
Status
rs -> Status -> IO Key
forall a. Status -> IO a
throwStatus Status
rs