module Database.EventStore.Internal.Connection
( Connection
, ConnectionException(..)
, connUUID
, connClose
, connFlush
, connSend
, connRecv
, newConnection
) where
import Control.Concurrent
import Control.Exception
import qualified Data.ByteString as B
import Data.Typeable
import System.IO
import Text.Printf
import Data.UUID
import Network
import System.Random
import Database.EventStore.Internal.Types
data ConnectionException =
MaxAttempt HostName Int Int
deriving (Show, Typeable)
instance Exception ConnectionException
data Connection =
Connection
{ connUUID :: UUID
, connClose :: IO ()
, connFlush :: IO ()
, connSend :: B.ByteString -> IO ()
, connRecv :: Int -> IO B.ByteString
}
newConnection :: Settings -> HostName -> Int -> IO Connection
newConnection sett host port =
case s_retry sett of
AtMost n ->
let loop i = do
printf "Connecting...Attempt %d\n" i
catch (connect sett host port) $ \(_ :: SomeException) -> do
threadDelay delay
if n <= i then throwIO $ MaxAttempt host port n
else loop (i + 1) in
loop 1
KeepRetrying ->
let endlessly i = do
printf "Connecting...Attempt %d\n" i
catch (connect sett host port) $ \(_ :: SomeException) -> do
threadDelay delay >> endlessly (i + 1) in
endlessly (1 :: Int)
where
delay = (s_reconnect_delay_secs sett) * secs
secs :: Int
secs = 1000000
connect :: Settings -> HostName -> Int -> IO Connection
connect _ host port = do
hdl <- connectTo host (PortNumber $ fromIntegral port)
hSetBuffering hdl NoBuffering
uuid <- randomIO
return $ regularConnection hdl uuid
regularConnection :: Handle -> UUID -> Connection
regularConnection h uuid =
Connection
{ connUUID = uuid
, connClose = hClose h
, connFlush = hFlush h
, connSend = B.hPut h
, connRecv = B.hGet h
}