memcache 0.2.0.1 → 0.3.0.0
raw patch · 8 files changed
+160/−34 lines, 8 filesdep ~network
Dependency ranges changed: network
Files
- CHANGELOG.md +5/−0
- Database/Memcache/Client.hs +4/−1
- Database/Memcache/Cluster.hs +3/−3
- Database/Memcache/SASL.hs +0/−1
- Database/Memcache/Server.hs +10/−9
- Database/Memcache/Socket.hs +7/−17
- memcache.cabal +5/−3
- test/MockServer.hs +126/−0
CHANGELOG.md view
@@ -1,3 +1,8 @@+# 0.3.0.0 - January 17th, 2021++* Bump package dependencies for newer GHC/back/network.+* Update code to work with newer dependencies.+ # 0.2.0.1 - November 2nd, 2016 * Fix compatability with latest `data-default-class`
Database/Memcache/Client.hs view
@@ -126,7 +126,10 @@ -- | Establish a new connection to a group of Memcached servers. newClient :: [ServerSpec] -> Options -> IO Client-newClient = newCluster+newClient scs = do+ case scs of+ [] -> newCluster [def]+ _ -> newCluster scs -- | Gracefully close a connection to a Memcached cluster. quit :: Cluster -> IO ()
Database/Memcache/Cluster.hs view
@@ -42,7 +42,7 @@ import Data.Time.Clock (NominalDiffTime) import Data.Time.Clock.POSIX (getPOSIXTime) import qualified Data.Vector as V-import Network.Socket (HostName, PortNumber)+import Network.Socket (HostName, ServiceName) import System.Timeout -- | Number of times to retry an operation before considering it failed.@@ -53,14 +53,14 @@ -- | Hostname of server to connect to. ssHost :: HostName, -- | Port number server is running on.- ssPort :: PortNumber,+ ssPort :: ServiceName, -- | Authentication values to use for SASL authentication with this -- server. ssAuth :: Authentication } deriving (Eq, Show) instance Default ServerSpec where- def = ServerSpec "localhost" 11211 NoAuth+ def = ServerSpec "127.0.0.1" "11211" NoAuth -- | Options specifies how a Memcached cluster should be configured. data Options = Options {
Database/Memcache/SASL.hs view
@@ -26,7 +26,6 @@ import Control.Exception (throwIO) import Control.Monad import Data.ByteString.Char8 as B8 (ByteString, pack, singleton)-import Data.Monoid -- | Perform SASL authentication with the server. authenticate :: Socket -> Authentication -> IO ()
Database/Memcache/Server.hs view
@@ -31,8 +31,7 @@ import Data.Time.Clock (NominalDiffTime) import Data.Time.Clock.POSIX (POSIXTime) -import Network.BSD (getProtocolNumber, getHostByName, hostAddress)-import Network.Socket (HostName, PortNumber(..))+import Network.Socket (getAddrInfo, HostName, ServiceName) import qualified Network.Socket as S -- Connection pool constants.@@ -52,7 +51,7 @@ -- | Hostname of server. addr :: !HostName, -- | Port number of server.- port :: !PortNumber,+ port :: !ServiceName, -- | Credentials for server. auth :: !Authentication, -- | When did the server fail? 0 if it is alive.@@ -76,7 +75,7 @@ compare x y = compare (sid x) (sid y) -- | Create a new Memcached server connection.-newServer :: HostName -> PortNumber -> Authentication -> IO Server+newServer :: HostName -> ServiceName -> Authentication -> IO Server newServer host port auth = do fat <- newIORef 0 pSock <- createPool connectSocket releaseSocket@@ -90,16 +89,18 @@ , failed = fat } where- serverHash = hash (host, fromEnum port)+ serverHash = hash (host, port) connectSocket = do- proto <- getProtocolNumber "tcp"+ let hints = S.defaultHints {+ S.addrSocketType = S.Stream+ }+ addr:_ <- getAddrInfo (Just hints) (Just host) (Just port) bracketOnError- (S.socket S.AF_INET S.Stream proto)+ (S.socket (S.addrFamily addr) (S.addrSocketType addr) (S.addrProtocol addr)) releaseSocket (\s -> do- h <- getHostByName host- S.connect s (S.SockAddrInet port $ hostAddress h)+ S.connect s $ S.addrAddress addr S.setSocketOption s S.KeepAlive 1 S.setSocketOption s S.NoDelay 1 authenticate s auth
Database/Memcache/Socket.hs view
@@ -39,9 +39,8 @@ import Data.Binary.Get import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as L-import Data.Monoid import Data.Word-import Network.Socket (Socket, isConnected, isReadable)+import Network.Socket (Socket) import qualified Network.Socket.ByteString as N -- | Send a request to the Memcached server.@@ -66,24 +65,15 @@ recvAll :: Int -> Builder -> IO B.ByteString recvAll 0 !acc = return $! toByteString acc recvAll !n !acc = do- canRead <- isSocketActive s- if canRead- then do- buf <- N.recv s n- case B.length buf of- 0 -> throwIO errEOF- bl | bl == n ->- return $! (toByteString $! acc <> fromByteString buf)- bl -> recvAll (n - bl) (acc <> fromByteString buf)- else throwIO errEOF+ buf <- N.recv s n+ case B.length buf of+ 0 -> throwIO errEOF+ bl | bl == n ->+ return $! (toByteString $! acc <> fromByteString buf)+ bl -> recvAll (n - bl) (acc <> fromByteString buf) errEOF :: MemcacheError errEOF = ProtocolError UnexpectedEOF { protocolError = "" }---- | Check whether we can still operate on this socket or not.-isSocketActive :: Socket -> IO Bool-{-# INLINE isSocketActive #-}-isSocketActive s = (&&) <$> isConnected s <*> isReadable s -- | Serialize a response to a ByteString Builder. szResponse :: Response -> Builder
memcache.cabal view
@@ -1,5 +1,5 @@ name: memcache-version: 0.2.0.1+version: 0.3.0.0 homepage: https://github.com/dterei/memcache-hs bug-reports: https://github.com/dterei/memcache-hs/issues synopsis: A memcached client library.@@ -22,7 +22,7 @@ . > import qualified Database.Memcache.Client as M > - > mc <- M.newClient [M.ServerSpec "localhost" 11211 M.NoAuth] M.def+ > mc <- M.newClient [M.ServerSpec "localhost" "11211" M.NoAuth] M.def > M.set mc "key" "value" 0 0 > v <- M.get mc "key" .@@ -64,7 +64,7 @@ bytestring >= 0.9.2.1, data-default-class >= 0.1.0, hashable >= 1.2.0.3,- network >= 2.4,+ network >= 3.1.0.0, resource-pool >= 0.2.1.0, vector >= 0.7, time >= 1.4@@ -111,6 +111,8 @@ bytestring >= 0.9.2.1, memcache, network >= 2.4+ other-modules:+ MockServer default-language: Haskell2010 other-extensions: BangPatterns,
+ test/MockServer.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Mock Memcached server - just enough for testing client.+module MockServer (+ MockResponse(..), mockMCServer, withMCServer+ ) where++import qualified Database.Memcache.Client as M+import Database.Memcache.Socket+import Database.Memcache.Types++import Blaze.ByteString.Builder+#if __GLASGOW_HASKELL__ < 710+import Control.Applicative+#endif+import Control.Concurrent+import Control.Exception (bracket, handle, throwIO, SomeException)+import Control.Monad+import Data.Binary.Get+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Lazy as L+import Data.IORef+import Data.Monoid+import Data.Word+import qualified Network.Socket as N hiding (recv)+import qualified Network.Socket.ByteString as N+import System.Exit+import System.IO++import Database.Memcache.Errors+import Database.Memcache.Types+++-- | Actions the mock server can take to a request.+data MockResponse+ = MR Response+ | CloseConnection+ | DelayMS Int MockResponse+ | Noop++-- | Run an IO action with a mock Memcached server running in the background,+-- killing it once done.+withMCServer :: Bool -> [MockResponse] -> IO () -> IO ()+withMCServer loop res m = bracket+ (mockMCServer loop res)+ (\tid -> killThread tid >> threadDelay 100000)+ (const m)++-- | New mock Memcached server that responds to each request with the specified+-- list of responses.+mockMCServer :: Bool -> [MockResponse] -> IO ThreadId+mockMCServer loop resp' = forkIO $ bracket + (N.socket N.AF_INET N.Stream N.defaultProtocol)+ (N.close)+ $ \sock -> do+ N.setSocketOption sock N.ReuseAddr 1+ let hints = N.defaultHints {+ N.addrFlags = [N.AI_PASSIVE]+ , N.addrSocketType = N.Stream+ }+ addr:_ <- N.getAddrInfo (Just hints) Nothing (Just "11211")+ N.bind sock $ N.addrAddress addr+ N.listen sock 10+ ref <- newIORef resp'+ acceptHandler sock ref+ when loop $ forever $ threadDelay 1000000+ + where+ acceptHandler sock ref = do+ client <- fst <$> N.accept sock+ resp <- readIORef ref+ cont <- handle allErrors $ clientHandler client ref resp+ if cont+ then acceptHandler sock ref+ else return ()++ allErrors :: SomeException -> IO Bool+ allErrors = const $ return True++ clientHandler client ref [] = N.close client >> return False+ clientHandler client ref (r':resp) = do+ void $ recvReq client+ mrHandler r'+ where+ mrHandler r = case r of+ Noop -> clientHandler client ref resp+ (MR mr) -> sendRes client mr >> clientHandler client ref resp+ (DelayMS ms mr) -> do+ writeIORef ref resp -- client may reset connection+ threadDelay (ms * 1000)+ mrHandler mr+ CloseConnection -> do+ N.close client+ writeIORef ref resp+ return $ not $ null resp++++sendRes :: N.Socket -> Response -> IO ()+sendRes s m = N.sendAll s (toByteString $ szResponse m)++recvReq :: N.Socket -> IO ()+recvReq s = do+ header <- recvAll s mEMCACHE_HEADER_SIZE mempty+ let h = runGet (dzHeader PktRequest) (L.fromChunks [header])+ bytesToRead = fromIntegral $ bodyLen h+ when (bytesToRead > 0) $+ void $ recvAll s bytesToRead mempty++recvAll :: N.Socket -> Int -> Builder -> IO B.ByteString+recvAll s 0 !acc = return $! toByteString acc+recvAll s !n !acc = do+ buf <- N.recv s n+ case B.length buf of+ 0 -> throwIO errEOF+ bl | bl == n ->+ return $! (toByteString $! acc <> fromByteString buf)+ bl -> recvAll s (n - bl) (acc <> fromByteString buf)+ + where+ errEOF :: MemcacheError+ errEOF = ProtocolError UnexpectedEOF { protocolError = "" }+