packages feed

memcache 0.0.1 → 0.1.0.0

raw patch · 13 files changed

+290/−180 lines, 13 files

Files

+ CHANGELOG.md view
@@ -0,0 +1,17 @@+# 0.1.0.0++* First proper release (although still lots of rough edges!)+* Filled out `Data.Memcache.Client` to a complete API.+* Integrated cluster and authentication handling.+* Better error and exception handling.+* Fix compilation under GHC 7.10.++# 0.0.1++* Initial (incomplete) support for a cluster of memcached servers.+* Fixed compilation under GHC 7.4.++# 0.0.0++* Initial release. Support for a single server.+
Database/Memcache/Client.hs view
@@ -1,14 +1,38 @@--- | A memcache client.+-- | A memcache client. Supports the binary protocol (only) and SASL+-- authentication.+--+-- A client can connect to a single memcache server or a cluster of them. In+-- the later case, consistent hashing is used to route requests to the+-- appropriate server.+--+-- Expected return values (like misses) are returned as part of+-- the return type, while unexpected errors are thrown as exceptions. module Database.Memcache.Client (+        -- * Cluster and connection handling+        newClient, Client, ServerSpec(..), defaultServerSpec, Options(..),+        defaultOptions, Authentication(..), Username, Password,++        -- * Get operations         get, gat, touch,++        -- * Set operations         set, set', add, replace,-        delete,-        increment, decrement,-        append, prepend,-        flush, version, stats, quit+        +        -- * Delete operations+        delete, flush,+        +        -- * Modify operations+        increment, decrement, append, prepend,++        -- * Information operations+        version, stats, P.StatResults, quit,++        -- * Error handling+        MemcacheError(..), ClientError(..)     ) where  import Database.Memcache.Cluster+import Database.Memcache.Errors import qualified Database.Memcache.Protocol as P import Database.Memcache.Server import Database.Memcache.Types@@ -17,6 +41,11 @@ import Data.Word import Data.ByteString (ByteString) +type Client = Cluster++newClient :: [ServerSpec] -> Options -> IO Client+newClient = newCluster+ keyedOp' :: Cluster -> Key -> (Server -> IO (Maybe a)) -> IO (Maybe a) keyedOp' = keyedOp (Just Nothing) @@ -59,9 +88,8 @@ flush :: Cluster -> Maybe Expiration -> IO () flush c e = void $ allOp (Just ()) c $ \s -> P.flush s e -stats :: Cluster -> Maybe Key -> IO ([(Server, Maybe P.StatResults)])-stats c key = do-    allOp Nothing c $ \s -> P.stats s key+stats :: Cluster -> Maybe Key -> IO [(Server, Maybe P.StatResults)]+stats c key = allOp Nothing c $ \s -> P.stats s key  quit :: Cluster -> IO () quit c = void $ allOp (Just ()) c $ \s -> P.quit s
Database/Memcache/Cluster.hs view
@@ -3,13 +3,15 @@  -- | Handles a group of connections to different memcache servers. module Database.Memcache.Cluster (-        Cluster, newMemcacheCluster, Options(..), defaultOptions, keyedOp,-        anyOp, allOp+        Cluster, newCluster,+        ServerSpec(..), defaultServerSpec,+        Options(..), defaultOptions,+        keyedOp, anyOp, allOp     ) where  import Database.Memcache.Errors import Database.Memcache.Server (Server(..), newServer)-import Database.Memcache.Types (Key)+import Database.Memcache.Types (Authentication(..), Key)  import qualified Control.Exception as E @@ -17,16 +19,33 @@ import Data.Maybe (fromMaybe) import Data.List (sort) import qualified Data.Vector as V-import qualified Data.Vector.Mutable as MV+-- import qualified Data.Vector.Mutable as MV  import Network.Socket (HostName, PortNumber) +-- | ServerSpec specifies a server configuration to connect to.+data ServerSpec = ServerSpec {+        ssHost :: HostName,+        ssPort :: PortNumber,+        ssAuth :: Authentication+    }++-- | Provides a default value for a server cconnection config.+defaultServerSpec :: ServerSpec+defaultServerSpec = ServerSpec {+        ssHost = "localhost",+        ssPort = 11211,+        ssAuth = NoAuth+    }++-- | Options specifies how a memcache cluster should be configured. data Options = Options {         optsCmdFailure    :: !FailureMode,         optsServerFailure :: !FailureMode,         optsServerRetries :: !Int     } +-- | Provides recommended default for a cluster Options. defaultOptions :: Options defaultOptions = Options {         optsCmdFailure    = FailToError,@@ -34,7 +53,7 @@         optsServerRetries = 2     } --- | A memcached cluster.+-- | A memcached cluster client. data Cluster = Cluster {         servers            :: V.Vector Server,         cmdFailureMode     :: !FailureMode,@@ -43,9 +62,9 @@     } deriving Show  -- | Establish a new connection to a group of memcached servers.-newMemcacheCluster :: [(HostName, PortNumber)] -> Options -> IO Cluster-newMemcacheCluster hosts Options{..} = do-    s <- mapM (uncurry newServer) hosts+newCluster :: [ServerSpec] -> Options -> IO Cluster+newCluster hosts Options{..} = do+    s <- mapM (\ServerSpec{..} -> newServer ssHost ssPort ssAuth) hosts     return $ Cluster (V.fromList $ sort s) optsCmdFailure optsServerFailure       optsServerRetries
Database/Memcache/Errors.hs view
@@ -28,6 +28,7 @@     | MemErrValueNonNumeric     | MemErrUnknownCmd     | MemErrOutOfMemory+    | MemErrAuthFail     deriving (Eq, Show, Typeable)  instance Exception MemcacheError@@ -35,6 +36,7 @@ -- | Convert a status to an error. Note, not all status's are errors and so -- this is a partial function! statusToError :: Status -> MemcacheError+{-# INLINE statusToError #-} statusToError NoError            = error "statusToError: called on NoError" statusToError ErrKeyNotFound     = MemErrNoKey statusToError ErrKeyExists       = MemErrKeyExists@@ -44,17 +46,19 @@ statusToError ErrValueNonNumeric = MemErrValueNonNumeric statusToError ErrUnknownCommand  = MemErrUnknownCmd statusToError ErrOutOfMemory     = MemErrOutOfMemory-statusToError SaslAuthFail       = error "statusToError: called on SaslAuthFail"+statusToError SaslAuthFail       = MemErrAuthFail statusToError SaslAuthContinue   = error "statusToError: called on SaslAuthContinue"  -- | Convert a status to an exception. Note, not all status's are errors and so -- this is not a complete function!-throwStatus :: Response -> IO a-throwStatus = throwIO . statusToError . resStatus+throwStatus :: Status -> IO a+{-# INLINE throwStatus #-}+throwStatus = throwIO . statusToError  -- | Throw an IncorrectResponse exception for a wrong received response. throwIncorrectRes :: Response -> String -> IO a-throwIncorrectRes r msg = throwIO $+{-# INLINE throwIncorrectRes #-}+throwIncorrectRes r msg = throwIO     IncorrectResponse {         increspMessage = "Expected " ++ msg ++ " response! Got: " ++ show (resOp r),         increspActual  = r
Database/Memcache/Protocol.hs view
@@ -20,6 +20,7 @@ import Database.Memcache.Errors import Database.Memcache.Server import Database.Memcache.Types+import Database.Memcache.Wire  import qualified Control.Exception as E import Control.Monad@@ -55,7 +56,7 @@     case resStatus r of         NoError        -> return $ Just (v, f, resCas r)         ErrKeyNotFound -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  gat :: Server -> Key -> Expiration -> IO (Maybe (Value, Flags, Version)) gat c k e = do@@ -67,7 +68,7 @@     case resStatus r of         NoError        -> return $ Just (v, f, resCas r)         ErrKeyNotFound -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  touch :: Server -> Key -> Expiration -> IO (Maybe Version) touch c k e = do@@ -77,7 +78,7 @@     case resStatus r of         NoError        -> return $ Just (resCas r)         ErrKeyNotFound -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  set :: Server -> Key -> Value -> Flags -> Expiration -> IO Version set c k v f e = do@@ -86,7 +87,7 @@     when (resOp r /= ResSet Loud) $ throwIncorrectRes r "SET"     case resStatus r of         NoError -> return $ resCas r-        _       -> throwStatus r+        rs      -> throwStatus rs  -- XXX: Use a return type like: Return = OK Version | NotFound | NotVersion? set' :: Server -> Key -> Value -> Flags -> Expiration -> Version -> IO (Maybe Version)@@ -100,7 +101,7 @@         ErrKeyNotFound -> return Nothing         -- version specified and doesn't match key...         ErrKeyExists   -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  add :: Server -> Key -> Value -> Flags -> Expiration -> IO (Maybe Version) add c k v f e = do@@ -110,7 +111,7 @@     case resStatus r of         NoError      -> return $ Just (resCas r)         ErrKeyExists -> return Nothing-        _            -> throwStatus r+        rs           -> throwStatus rs  replace :: Server -> Key -> Value -> Flags -> Expiration -> Version -> IO (Maybe Version) replace c k v f e ver = do@@ -123,7 +124,7 @@         ErrKeyNotFound -> return Nothing         -- version specified and doesn't match key...         ErrKeyExists   -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  delete :: Server -> Key -> Version -> IO Bool delete c k ver = do@@ -136,7 +137,7 @@         ErrKeyNotFound -> return False         -- version specified and doesn't match key...         ErrKeyExists   -> return False-        _              -> throwStatus r+        rs             -> throwStatus rs  increment :: Server -> Key -> Initial -> Delta -> Expiration -> Version -> IO (Maybe (Word64, Version)) increment c k i d e ver = do@@ -149,7 +150,7 @@         NoError        -> return $ Just (n, resCas r)         ErrKeyNotFound -> return Nothing         ErrKeyExists   -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  decrement :: Server -> Key -> Initial -> Delta -> Expiration -> Version -> IO (Maybe (Word64, Version)) decrement c k i d e ver = do@@ -162,7 +163,7 @@         NoError        -> return $ Just (n, resCas r)         ErrKeyNotFound -> return Nothing         ErrKeyExists   -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  append :: Server -> Key -> Value -> Version -> IO (Maybe Version) append c k v ver = do@@ -172,7 +173,7 @@     case resStatus r of         NoError        -> return $ Just (resCas r)         ErrKeyNotFound -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  prepend :: Server -> Key -> Value -> Version -> IO (Maybe Version) prepend c k v ver = do@@ -182,17 +183,17 @@     case resStatus r of         NoError        -> return $ Just (resCas r)         ErrKeyNotFound -> return Nothing-        _              -> throwStatus r+        rs             -> throwStatus rs  flush :: Server -> Maybe Expiration -> IO () flush c e = do-    let e'  = maybe Nothing (\xp -> Just (SETouch xp)) e+    let e'  = SETouch `fmap` e         msg = emptyReq { reqOp = ReqFlush Loud e' }     r <- sendRecv c msg     when (resOp r /= ResFlush Loud) $ throwIncorrectRes r "FLUSH"     case resStatus r of         NoError -> return ()-        _       -> throwStatus r+        rs      -> throwStatus rs  noop :: Server -> IO () noop c = do@@ -201,7 +202,7 @@     when (resOp r /= ResNoop) $ throwIncorrectRes r "NOOP"     case resStatus r of         NoError -> return ()-        _       -> throwStatus r+        rs      -> throwStatus rs  version :: Server -> IO ByteString version c = do@@ -212,7 +213,7 @@         _            -> throwIncorrectRes r "VERSION"     case resStatus r of         NoError -> return v-        _       -> throwStatus r+        rs      -> throwStatus rs  -- | StatResults are a list of key-value pairs. type StatResults = [(ByteString, ByteString)]@@ -234,7 +235,7 @@             NoError | B.null k && B.null v -> return $ Just xs                     | otherwise            -> getAllStats s $ (k, v):xs             ErrKeyNotFound                 -> return Nothing-            _                              -> throwStatus r+            rs                             -> throwStatus rs  quit :: Server -> IO () quit c = do@@ -242,7 +243,7 @@     withSocket c $ \s -> sendClose s `E.catch` consumeError     close c   where-    consumeError = \(_::E.SomeException) -> return ()+    consumeError (_ ::E.SomeException) = return ()     sendClose s = do         let msg = emptyReq { reqOp = ReqQuit Loud }         send s msg@@ -251,5 +252,5 @@         when (resOp r /= ResQuit Loud) $ throwIncorrectRes r "QUIT"         case resStatus r of             NoError -> return ()-            _       -> throwStatus r+            rs      -> throwStatus rs
Database/Memcache/SASL.hs view
@@ -2,53 +2,52 @@  -- | SASL authentication support for memcached. module Database.Memcache.SASL (-        authenticate, Username, Password+        authenticate, Authentication(..), Username, Password     ) where  import Database.Memcache.Errors-import Database.Memcache.Server import Database.Memcache.Types+import Database.Memcache.Wire +import qualified Control.Exception as E (onException) import Control.Monad import Data.ByteString.Char8 as B8 (ByteString, pack, singleton) import Data.Monoid---- | Username for authentication.-type Username = B8.ByteString---- | Password for authentication.-type Password = B8.ByteString+import Network.Socket (Socket)  -- | Perform SASL authentication with the server.-authenticate :: Server -> Username -> Password -> IO Bool+authenticate :: Socket -> Authentication -> IO () -- NOTE: For correctness really should check that PLAIN auth is supported first -- but we'll just assume it is as that's all mainline and other implementations -- support and one exception is nearly as good as another.-authenticate = saslAuthPlain+authenticate _ NoAuth     = return ()+authenticate s (Auth u p) = saslAuthPlain s u p + -- | Perform SASL PLAIN authentication.-saslAuthPlain :: Server -> Username -> Password -> IO Bool-saslAuthPlain c u p = do+saslAuthPlain :: Socket -> Username -> Password -> IO ()+saslAuthPlain s u p = do     let credentials = singleton '\0' <> u <> singleton '\0' <> p         msg = emptyReq { reqOp = ReqSASLStart (B8.pack "PLAIN") credentials }-    r <- sendRecv c msg+    send s msg+    r <- recv s `E.onException` throwStatus SaslAuthFail     when (resOp r /= ResSASLStart) $ throwIncorrectRes r "SASL_START"     case resStatus r of-        NoError      -> return True-        SaslAuthFail -> return False-        _            -> throwStatus r+        NoError -> return ()+        rs      -> throwStatus rs  -- | List available SASL authentication methods. We could call this but as we -- only support PLAIN as does the memcached server, we simply assume PLAIN -- authentication is supprted and try that.-saslListMechs :: Server -> IO B8.ByteString-saslListMechs c = do+saslListMechs :: Socket -> IO B8.ByteString+saslListMechs s = do     let msg = emptyReq { reqOp = ReqSASLList }-    r <- sendRecv c msg+    send s msg+    r <- recv s     v <- case resOp r of         ResSASLList v -> return v         _             -> throwIncorrectRes r "SASL_LIST"     case resStatus r of         NoError        -> return v-        _              -> throwStatus r+        rs             -> throwStatus rs
Database/Memcache/Server.hs view
@@ -1,18 +1,13 @@ -- | Handles the connections between a memcache client and a single server.- module Database.Memcache.Server (-        Server(sid, failed), newServer, sendRecv,-        withSocket, send, recv, close+        Server(sid), newServer, sendRecv, withSocket, close     ) where -import Database.Memcache.Errors+import Database.Memcache.SASL import Database.Memcache.Types import Database.Memcache.Wire -import Blaze.ByteString.Builder import Control.Exception-import qualified Data.ByteString as B-import qualified Data.ByteString.Lazy as L import Data.Hashable import Data.Pool import Data.Time.Clock (NominalDiffTime)@@ -20,7 +15,6 @@ import Network.BSD (getProtocolNumber, getHostByName, hostAddress) import Network.Socket (HostName, PortNumber(..), Socket) import qualified Network.Socket as S-import qualified Network.Socket.ByteString as N  -- Connection pool constants. -- TODO: make configurable@@ -34,12 +28,13 @@ data Server = Server {         sid    :: {-# UNPACK #-} !Int,         pool   :: Pool Socket,-        _addr  :: HostName,-        _port  :: PortNumber,-        failed :: Bool+        _addr  :: !HostName,+        _port  :: !PortNumber,+        _auth  :: !Authentication,+        failed :: !Bool+         -- TODO:          -- weight   :: Double-        -- auth     :: Authentication         -- tansport :: Transport (UDP vs. TCP)         -- poolLim  :: Int (pooled connection limit)         -- cnxnBuf   :: IORef ByteString@@ -47,39 +42,42 @@   instance Eq Server where-    (==) x y = (sid x) == (sid y)+    (==) x y = sid x == sid y  instance Ord Server where     compare x y = compare (sid x) (sid y)  -- | Create a new memcached connection.-newServer :: HostName -> PortNumber -> IO Server-newServer host port = do+newServer :: HostName -> PortNumber -> Authentication -> IO Server+newServer host port auth = do     pSock <- createPool connectSocket releaseSocket                 sSTRIPES sKEEPALIVE sCONNECTIONS-    return $ Server+    return Server         { sid = serverHash         , pool = pSock         , _addr = host         , _port = port+        , _auth = auth         , failed = False         }   where-    serverHash = hash (host, let PortNum p = port in p)+    serverHash = hash (host, fromEnum port)+     connectSocket = do         proto <- getProtocolNumber "tcp"         bracketOnError             (S.socket S.AF_INET S.Stream proto)-            (releaseSocket)+            releaseSocket             (\s -> do                 h <- getHostByName host                 S.connect s (S.SockAddrInet port $ hostAddress h)                 S.setSocketOption s S.KeepAlive 1                 S.setSocketOption s S.NoDelay 1+                authenticate s auth                 return s             ) -    releaseSocket s = S.close s+    releaseSocket = S.close  -- | Send and receive a single request/response pair to the memcached server. sendRecv :: Server -> Request -> IO Response@@ -90,31 +88,10 @@ -- | Run a function with access to an server socket for using 'send' and -- 'recv'. withSocket :: Server -> (Socket -> IO a) -> IO a-withSocket svr = withResource (pool svr)---- | Send a request to the memcached server.-send :: Socket -> Request -> IO ()-send s m = N.sendAll s (toByteString $ szRequest m)---- | Retrieve a single response from the memcached server.--- TODO: read into buffer to minimize read syscalls-recv :: Socket -> IO Response-recv s = do-    header <- recvAll mEMCACHE_HEADER_SIZE-    let h = dzHeader' (L.fromChunks [header])-    if (bodyLen h > 0)-        then do body <- recvAll (fromIntegral $ bodyLen h)-                return $ dzBody' h (L.fromChunks [body])-        else return $ dzBody' h L.empty-  where-    recvAll n = do-        buf <- N.recv s n-        if B.length buf == n-          then return buf-          else throwIO NotEnoughBytes+withSocket svr = withResource $ pool svr  -- | Close the server connection. If you perform another operation after this, -- the connection will be re-established. close :: Server -> IO ()-close srv = destroyAllResources (pool srv)+close srv = destroyAllResources $ pool srv
Database/Memcache/Types.hs view
@@ -3,6 +3,7 @@ -- | Stores the various types needed by memcache. Mostly concerned with the -- representation of the protocol. module Database.Memcache.Types (+        Authentication(..), Username, Password,         Q(..), K(..), Key, Value, Extras, Initial, Delta, Expiration, Flags, Version,         mEMCACHE_HEADER_SIZE, Header(..),         Request(..), OpRequest(..), SESet(..), SEIncr(..), SETouch(..), emptyReq,@@ -14,6 +15,18 @@ import Data.ByteString (ByteString) import Data.Typeable import Data.Word++-- | SASL Authentication information for a server.+data Authentication+    = Auth { username :: !Username, password :: !Password }+    | NoAuth+    deriving (Show, Eq)++-- | Username for authentication.+type Username = ByteString++-- | Password for authentication.+type Password = ByteString  {- MEMCACHE MESSAGE:
Database/Memcache/Wire.hs view
@@ -1,5 +1,6 @@ -- | Deals with serializing and parsing memcached requests and responses. module Database.Memcache.Wire (+        send, recv,         szRequest, szRequest',         dzResponse, dzResponse', dzHeader, dzHeader', dzBody, dzBody'     ) where@@ -7,6 +8,7 @@ -- XXX: Wire works with lazy bytestrings but we receive strict bytestrings from -- the network... +import Database.Memcache.Errors import Database.Memcache.Types  import Control.Exception@@ -17,7 +19,30 @@ import qualified Data.ByteString.Lazy as L import Data.Monoid import Data.Word+import Network.Socket (Socket)+import qualified Network.Socket.ByteString as N +-- | Send a request to the memcached server.+send :: Socket -> Request -> IO ()+send s m = N.sendAll s (toByteString $ szRequest m)++-- | Retrieve a single response from the memcached server.+-- TODO: read into buffer to minimize read syscalls+recv :: Socket -> IO Response+recv s = do+    header <- recvAll mEMCACHE_HEADER_SIZE+    let h = dzHeader' (L.fromChunks [header])+    if bodyLen h > 0+        then do body <- recvAll (fromIntegral $ bodyLen h)+                return $ dzBody' h (L.fromChunks [body])+        else return $ dzBody' h L.empty+  where+    recvAll n = do+        buf <- N.recv s n+        if B.length buf == n+          then return buf+          else throwIO NotEnoughBytes+ -- | Serialize a request to a ByteString. szRequest' :: Request -> L.ByteString szRequest' = toLazyByteString . szRequest@@ -131,7 +156,7 @@         ProtocolError {             protocolMessage = "Bad magic value for a response packet",             protocolHeader  = Nothing,-            protocolParams  = [show $ m]+            protocolParams  = [show m]         }     o   <- getWord8     kl  <- getWord16be@@ -157,7 +182,7 @@  -- | Deserialize a Response body. dzBody :: Header -> Get Response-dzBody h = do+dzBody h =     case op h of         0x00 -> dzGetResponse h $ ResGet Loud         0x09 -> dzGetResponse h $ ResGet Quiet@@ -183,7 +208,7 @@         0x19 -> dzGenericResponse h $ ResAppend Quiet         0x0F -> dzGenericResponse h $ ResPrepend Loud         0x1A -> dzGenericResponse h $ ResPrepend Quiet-        0x1C -> dzGenericResponse h $ ResTouch+        0x1C -> dzGenericResponse h ResTouch         0x07 -> dzGenericResponse h $ ResQuit Loud         0x17 -> dzGenericResponse h $ ResQuit Quiet         0x08 -> dzGenericResponse h $ ResFlush Loud@@ -196,7 +221,7 @@         0x21 -> dzGenericResponse h ResSASLStart         0x22 -> dzGenericResponse h ResSASLStep -        _    -> throw $ ProtocolError {+        _    -> throw ProtocolError {                     protocolMessage = "Unknown operation type",                     protocolHeader  = Just h,                     protocolParams  = [show $ op h]@@ -319,7 +344,7 @@         0x82 -> ErrOutOfMemory         0x20 -> SaslAuthFail         0x21 -> SaslAuthContinue-        _    -> throw $ ProtocolError {+        _    -> throw ProtocolError {                     protocolMessage = "Unknown status type",                     protocolHeader  = Nothing,                     protocolParams  = [show st]
README.md view
@@ -2,9 +2,16 @@  [![Hackage version](https://img.shields.io/hackage/v/memcache.svg?style=flat)](https://hackage.haskell.org/package/memcache) [![Build Status](https://img.shields.io/travis/dterei/memcache-hs.svg?style=flat)](https://travis-ci.org/dterei/memcache-hs) -This library provides a client interface to a Memcache cluster. It is-aimed at full binary protocol support, ease of use and speed.+A client library for a memcached cluster. +It supports the binary memcached protocol and SASL authentication. No support+for the ASCII protocol is provided. It supports connecting to a single, or a+cluster of memcached servers. When connecting to a cluser, consistent hashing+is used for routing requests to the appropriate server.++Complete coverage of the memcached protocol is provided except for multi-get+and other pipelined operations.+ ## Licensing  This library is BSD-licensed.@@ -36,32 +43,6 @@  Either way, a pool is fine for now. -## ToDo--Required:-* Connection error handling-* SASL -- tie in with cluster management-* Timeouts-* Pull cluster and server creation into client--Optional:-* Multi-get-* Generic multi operation support-* Customizable server sharding -- mod & virtual servers--Nice-to-have:-* Asynchronous support-* Customizable -- timeout, max connection retries, hash algorithm-* Max value validation-* Optimizations --  http://code.google.com/p/spymemcached/wiki/Optimizations-* UDP-* ASCII-* Server error handling mode where we return misses and ignore sets--Maybe:-* Typeclass for serialization-* Monad / Typeclass for memcache- ## Other clients  * [C: libmemcached](http://libmemcached.org/libMemcached.html)@@ -74,11 +55,11 @@ and other improvements.  Please report bugs via the-[github issue tracker](http://github.com/dterei/mc-hs/issues).+[github issue tracker](http://github.com/dterei/memcache-hs/issues). -Master [git repository](http://github.com/dterei/mc-hs):+Master [git repository](http://github.com/dterei/memcache-hs): -* `git clone git://github.com/dterei/mc-hs.git`+* `git clone https://github.com/dterei/memcache-hs.git`  ## Authors
+ TODO.md view
@@ -0,0 +1,24 @@+## ToDo++Required:+* Connection error handling+* Timeouts++Optional:+* Multi-get+* Generic multi operation support+* Customizable server sharding -- mod & virtual servers++Nice-to-have:+* Asynchronous support+* Customizable -- timeout, max connection retries, hash algorithm+* Max value validation+* Optimizations --  http://code.google.com/p/spymemcached/wiki/Optimizations+* UDP+* ASCII+* Server error handling mode where we return misses and ignore sets++Maybe:+* Typeclass for serialization+* Monad / Typeclass for memcache+
memcache.cabal view
@@ -1,11 +1,28 @@ name:           memcache-version:        0.0.1+version:        0.1.0.0 homepage:       https://github.com/dterei/memcache-hs bug-reports:    https://github.com/dterei/memcache-hs/issues synopsis:       A memcached client library. description:    -  A client library for a memcached cluster. It is aimed at full binary protocol-  support, ease of use and speed.+  A client library for a memcached cluster.+  .+  It supports the binary memcached protocol and SASL authentication. No support+  for the ASCII protocol is provided. It supports connecting to a single, or a+  cluster of memcached servers. When connecting to a cluser, consistent hashing+  is used for routing requests to the appropriate server.+  .+  Complete coverage of the memcached protocol is provided except for multi-get+  and other pipelined operations.+  .+  Basic usage is:+  > import qualified Database.Memcache.Client as M+  > +  > mc <- M.newClient [M.ServerSpec "localhost" 11211 M.NoAuth] M.defaultOptions+  > M.set mc "key" "value" 0 0+  > v <- M.get mc "key"+  .+  You should only need to import 'Database.Memcache.Client', but for now other+  modules are exposed. license:        BSD3 license-file:   LICENSE author:         David Terei <code@davidterei.com>@@ -13,10 +30,19 @@ copyright:      2015 David Terei. category:       Database build-type:     Simple-cabal-version:  >= 1.8+cabal-version:  >= 1.10 extra-source-files:-  README.md+  README.md, CHANGELOG.md, TODO.md +Source-repository this+  type: git+  location: https://github.com/dterei/memcache-hs.git+  tag: 0.1.0.0++source-repository head+  type:     git+  location: https://github.com/dterei/memcache-hs.git+ library   exposed-modules:     Database.Memcache.Client@@ -27,22 +53,25 @@     Database.Memcache.Server     Database.Memcache.Types     Database.Memcache.Wire-   build-depends:-    base < 5,-    binary >= 0.6.2.0,-    blaze-builder >= 0.3.1.0,-    bytestring >= 0.9.2.1,-    hashable >= 1.2.0.3,-    network >= 2.4,-    resource-pool >= 0.2.1.0,-    vector >= 0.7,+    base              <  5,+    binary            >= 0.6.2.0,+    blaze-builder     >= 0.3.1.0,+    bytestring        >= 0.9.2.1,+    hashable          >= 1.2.0.3,+    network           >= 2.4,+    resource-pool     >= 0.2.1.0,+    vector            >= 0.7,     vector-algorithms >= 0.5,-    time >= 1.4--  ghc-options: -Wall-  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs+    time              >= 1.4+  default-language: Haskell2010+  other-extensions:+    RecordWildCards,+    ScopedTypeVariables,+    DeriveDataTypeable,+    FlexibleInstances,+    OverloadedStrings+  ghc-options: -Wall -fwarn-tabs  -- executable opgen --   hs-source-dirs: tools@@ -70,30 +99,26 @@   type:           exitcode-stdio-1.0   hs-source-dirs: test   main-is:        Full.hs-   build-depends:-    base < 5,+    base       <  5,     bytestring >= 0.9.2.1,     memcache--  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs+  default-language: Haskell2010+  other-extensions:+    OverloadedStrings+  ghc-options: -fwarn-tabs  benchmark parser   type:           exitcode-stdio-1.0   hs-source-dirs: bench   main-is:        Parser.hs-   build-depends:-    base < 5,+    base       <  5,     bytestring >= 0.9.2.1,-    criterion > 0.6.0.0,+    criterion  >  0.6.0.0,     memcache--  if impl(ghc >= 6.8)-    ghc-options: -fwarn-tabs--source-repository head-  type:     git-  location: http://github.com/dterei/memcache-hs+  default-language: Haskell2010+  other-extensions:+    OverloadedStrings+  ghc-options: -fwarn-tabs
test/Full.hs view
@@ -4,9 +4,7 @@ -- running on `localhost:11211`. module Main where -import qualified Database.Memcache.Protocol as M-import qualified Database.Memcache.Server as M-import qualified Database.Memcache.SASL as M+import qualified Database.Memcache.Client as M  import Control.Monad import qualified Data.ByteString.Char8 as BC@@ -14,20 +12,19 @@  main :: IO () main = do-    c <- M.newServer "localhost" 11211-    -- M.authenticate c "user" "pass"+    c <- M.newClient [M.ServerSpec "localhost" 11211 M.NoAuth] M.defaultOptions     getTest c     exitSuccess -getTest :: M.Server -> IO ()+getTest :: M.Client -> IO () getTest c = do-    v <- M.set c (BC.pack "key") (BC.pack "world") 0 0+    void $ M.set c (BC.pack "key") (BC.pack "world") 0 0     Just (v', _, _) <- M.get c "key"     when (v' /= "world") $ do         putStrLn $ "bad value returned! " ++ show v'         exitFailure  -deleteTest :: M.Server -> IO ()+deleteTest :: M.Client -> IO () deleteTest c = do     v1 <- M.set c "key" "world" 0 0     v2 <- M.set c "key" "world22" 0 0@@ -35,7 +32,7 @@         putStrLn $ "bad versions! " ++ show v1 ++ ", " ++ show v2         exitFailure     r <- M.delete c "key" 0-    when (not r) $ do+    unless r $ do         putStrLn "delete failed!"         exitFailure