memcached-binary 0.1.2 → 0.2.0

raw patch · 8 files changed

+48/−35 lines, 8 filesdep ~HUnitdep ~basedep ~bytestring

Dependency ranges changed: HUnit, base, bytestring, data-default-class, hspec, time

Files

• memcached-binary.cabal +1/−1
• src/Database/Memcached/Binary/Common.hs +1/−1
• src/Database/Memcached/Binary/Either.hs +2/−3
• src/Database/Memcached/Binary/IO.hs +2/−2
• src/Database/Memcached/Binary/Internal.hs +31/−22
• src/Database/Memcached/Binary/Maybe.hs +2/−2
• src/Database/Memcached/Binary/Types/Exception.hs +6/−3
• test/test.hs +3/−1

@@ -1,5 +1,5 @@ name:                memcached-binary-version:             0.1.2+version:             0.2.0 synopsis:            memcached client using binary protocol. description:         memcached client using binary protocol. license:             MIT

@@ -77,7 +77,7 @@  version :: I.Connection -> IO (HasReturn Version) version = I.useConnection $ I.version (\s -> case readVersion s of-    Nothing -> failureHasReturn (-1) "version parse failed"+    Nothing -> failureHasReturn VersionParseFailed     Just v  -> successHasReturn v) failureHasReturn   where     readVersion s0 = do

@@ -18,12 +18,11 @@ {-# INLINE successNoReturn #-}  failureHasReturn :: I.Failure (HasReturn a)-failureHasReturn i m = return . Left $ MemcachedException i m+failureHasReturn = return . Left {-# INLINE failureHasReturn #-}  failureNoReturn :: I.Failure NoReturn-failureNoReturn i m = return . Just $ MemcachedException i m+failureNoReturn = return . Just {-# INLINE failureNoReturn #-}- #include "Common.hs" 

@@ -20,11 +20,11 @@ {-# INLINE successNoReturn #-}  failureHasReturn :: I.Failure (HasReturn a)-failureHasReturn i m = throwIO $ MemcachedException i m+failureHasReturn = throwIO {-# INLINE failureHasReturn #-}  failureNoReturn :: I.Failure NoReturn-failureNoReturn i m = throwIO $ MemcachedException i m+failureNoReturn = throwIO {-# INLINE failureNoReturn #-}  #include "Common.hs"

@@ -47,12 +47,12 @@      loop [a] = do         h <- connectTo (connectHost i) (connectPort i)-        auth a (\_ -> return h) (\w m -> throwIO $ MemcachedException w m) h+        auth a (\_ -> return h) throwIO h      loop (a:as) = do         h <- connectTo (connectHost i) (connectPort i)         handle (\(_::IOError) -> loop as) $-            auth a (\_ -> return h) (\_ _ -> loop as) h+            auth a (\_ -> return h) (\_ -> loop as) h  close :: Connection -> IO () close (Connection p) = destroyAllResources p@@ -127,16 +127,20 @@         hFlush h {-# INLINE sendRequest #-} -type Failure a = Word16 -> S.ByteString -> IO a+type Failure a = MemcachedException -> IO a  peekResponse :: (Ptr Header -> IO a) -> Failure a -> Handle -> IO a-peekResponse success failure h = allocaBytes 24 $ \p ->-    hGetBuf h p 24 >> peekWord16be (plusPtr p 6) >>= \st ->-    if st == 0-        then success p+peekResponse success failure h = allocaBytes 24 $ \p -> do+    len <- hGetBuf h p 24+    if len /= 24+        then failure DataReadFailed         else do-            bl <- peekWord32be (plusPtr p 8)-            failure st =<< S.hGet h (fromIntegral bl)+            peekWord16be (plusPtr p 6) >>= \st ->+                if st == 0+                    then success p+                    else do+                        bl <- peekWord32be (plusPtr p 8)+                        failure . MemcachedException st =<< S.hGet h (fromIntegral bl) {-# INLINE peekResponse #-}  withRequest :: OpCode -> Key -> Word8 -> (Ptr Request -> IO ())@@ -175,27 +179,30 @@     v <- L.hGet h $ fromIntegral tl - fromIntegral el - fromIntegral kl     return (e,k,v) -getSuccessCallback :: (Flags -> Value -> IO a)+getSuccessCallback :: (Flags -> Value -> IO a) -> Failure a                    -> Handle -> Ptr Header -> IO a-getSuccessCallback success h p = do+getSuccessCallback success failure h p = do     elen <- getExtraLength p     tlen <- getTotalLength p-    void $ hGetBuf h p 4-    flags <- peekWord32be p-    value <- L.hGet h (fromIntegral tlen - fromIntegral elen)-    success flags value+    len  <- hGetBuf h p 4+    if len /= 4+        then failure DataReadFailed+        else do+            flags <- peekWord32be p+            value <- L.hGet h (fromIntegral tlen - fromIntegral elen)+            success flags value  get :: (Flags -> Value -> IO a) -> Failure a     -> Key -> Handle -> IO a get success failure key =      withRequest opGet key 0 nop 0 nop (CAS 0)-    (getSuccessCallback success) failure+    (getSuccessCallback success failure) failure  getWithCAS :: (CAS -> Flags -> Value -> IO a) -> Failure a            -> Key -> Handle -> IO a getWithCAS success failure key =     withRequest opGet key 0 nop 0 nop (CAS 0)-    (\h p -> getCAS p >>= \c -> getSuccessCallback (success c) h p) failure+    (\h p -> getCAS p >>= \c -> getSuccessCallback (success c) failure h p) failure  setAddReplace :: IO a -> Failure a -> OpCode -> CAS               -> Key -> Value -> Flags -> Expiry -> Handle -> IO a@@ -224,13 +231,15 @@         pokeWord32be (plusPtr p 16) expiry      success' h p = do-        void $ hGetBuf h p 8-        peekWord64be p >>= success+        len <- hGetBuf h p 8+        if len /= 8+            then failure DataReadFailed+            else peekWord64be p >>= success  quit :: Handle -> IO () quit h = do     sendRequest  opQuit "" 0 nop 0 nop 0 (CAS 0) h-    peekResponse (\_ -> return ()) (\_ _ -> return ()) h+    peekResponse (\_ -> return ()) (\_ -> return ()) h  flushAll :: IO a -> Failure a -> Handle -> IO a flushAll success =@@ -261,7 +270,7 @@   where     loop m = do         sendRequest opStat "" 0 nop 0 nop 0 (CAS 0) h-        peekResponse (success m) (\w s -> throwIO $ MemcachedException w s) h+        peekResponse (success m) throwIO h      success m p = getTotalLength p >>= \tl ->         if tl == 0@@ -280,7 +289,7 @@       -> Key -> Expiry -> Handle -> IO a touch success failure op key e =     withRequest op key 4 (flip pokeWord32be e) 0 nop (CAS 0)-    (getSuccessCallback success) failure+    (getSuccessCallback success failure) failure  saslListMechs :: (S.ByteString -> IO a) -> Failure a               -> Handle -> IO a

@@ -18,11 +18,11 @@ {-# INLINE successNoReturn #-}  failureHasReturn :: I.Failure (HasReturn a)-failureHasReturn _ _ = return Nothing+failureHasReturn _ = return Nothing {-# INLINE failureHasReturn #-}  failureNoReturn :: I.Failure NoReturn-failureNoReturn _ _ = return False+failureNoReturn _ = return False {-# INLINE failureNoReturn #-}  #include "Common.hs"

@@ -8,14 +8,17 @@ import Data.Typeable import qualified Data.ByteString as S -data MemcachedException = MemcachedException-    {-# UNPACK #-} !Word16 {-# UNPACK #-} !S.ByteString+data MemcachedException+    = MemcachedException {-# UNPACK #-} !Word16 {-# UNPACK #-} !S.ByteString+    | DataReadFailed+    | VersionParseFailed     deriving (Show, Typeable)  instance Exception MemcachedException  #define defExceptionP(n,w) n :: MemcachedException -> Bool;\-n (MemcachedException i _) = i == w+n (MemcachedException i _) = i == w;\+n _ = False  defExceptionP(isKeyNotFound                   , 0x01) defExceptionP(isKeyExists                     , 0x02)

@@ -55,7 +55,9 @@     (m >> throwIO (ByPassException "exception not occured.")) `catch`     (\e -> case fromException e :: Maybe MemcachedException of         Nothing -> assertFn e-        Just e'@(MemcachedException i _) -> unless (i == ex) (assertFn e'))+        Just e'@(MemcachedException i _) -> unless (i == ex) (assertFn e')+        Just e' -> assertFn e'+        )   where     assertFn e = assertFailure $ unlines         [ "not expected exception occured:"