module Database.Memcache.Server (
Connection(..), newMemcacheClient, send, sendRecv, recv
) where
import Control.Concurrent.MVar
import Database.Memcache.Types
import Database.Memcache.Wire
import Blaze.ByteString.Builder
import Control.Exception
import qualified Data.ByteString.Lazy as L
import Network.BSD (getProtocolNumber, getHostByName, hostAddress)
import Network.Socket hiding (send, recv)
import qualified Network.Socket.ByteString as N
data Connection = Conn {
conn :: MVar Socket
}
newMemcacheClient :: HostName -> PortNumber -> IO Connection
newMemcacheClient h p = do
s <- connectTo h p
m <- newMVar s
setSocketOption s KeepAlive 1
setSocketOption s NoDelay 1
return (Conn m)
connectTo :: HostName -> PortNumber -> IO Socket
connectTo host port = do
proto <- getProtocolNumber "tcp"
bracketOnError
(socket AF_INET Stream proto)
(close)
(\sock -> do
h <- getHostByName host
connect sock (SockAddrInet port (hostAddress h))
return sock
)
send :: Socket -> Request -> IO ()
send s m = N.sendAll s (toByteString $ szRequest m)
sendRecv :: Connection -> Request -> IO Response
sendRecv c m = withMVar (conn c) $ \s -> do
send s m
recv s
recv :: Socket -> IO Response
recv s = do
header <- N.recv s mEMCACHE_HEADER_SIZE
let h = dzHeader' (L.fromChunks [header])
if (bodyLen h > 0) then do
body <- N.recv s (fromIntegral $ bodyLen h)
return $ dzBody' h (L.fromChunks [body])
else
return $ dzBody' h L.empty