module Database.Memcache.Server (
Server(sid, failed), newServer, sendRecv, withSocket, close
) where
import Database.Memcache.SASL
import Database.Memcache.Socket
import Control.Exception
import Data.Hashable
import Data.IORef
import Data.Pool
import Data.Time.Clock (NominalDiffTime)
import Data.Time.Clock.POSIX (POSIXTime)
import Network.BSD (getProtocolNumber, getHostByName, hostAddress)
import Network.Socket (HostName, PortNumber(..))
import qualified Network.Socket as S
sSTRIPES, sCONNECTIONS :: Int
sKEEPALIVE :: NominalDiffTime
sSTRIPES = 1
sCONNECTIONS = 1
sKEEPALIVE = 300
data Server = Server {
sid :: !Int,
pool :: Pool Socket,
addr :: !HostName,
port :: !PortNumber,
auth :: !Authentication,
failed :: IORef POSIXTime
}
instance Show Server where
show Server{..} =
"Server [" ++ show sid ++ "] " ++ addr ++ ":" ++ show port
instance Eq Server where
(==) x y = sid x == sid y
instance Ord Server where
compare x y = compare (sid x) (sid y)
newServer :: HostName -> PortNumber -> Authentication -> IO Server
newServer host port auth = do
fat <- newIORef 0
pSock <- createPool connectSocket releaseSocket
sSTRIPES sKEEPALIVE sCONNECTIONS
return Server
{ sid = serverHash
, pool = pSock
, addr = host
, port = port
, auth = auth
, failed = fat
}
where
serverHash = hash (host, fromEnum port)
connectSocket = do
proto <- getProtocolNumber "tcp"
bracketOnError
(S.socket S.AF_INET S.Stream proto)
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.close
sendRecv :: Server -> Request -> IO Response
sendRecv svr msg = withSocket svr $ \s -> do
send s msg
recv s
withSocket :: Server -> (Socket -> IO a) -> IO a
withSocket svr = withResource $ pool svr
close :: Server -> IO ()
close srv = destroyAllResources $ pool srv