module DBus.Connection
( Connection
, ConnectionError
, connect
, disconnect
, send
, receive
, Mechanism
, mechanism
, external
, Transport
, Socket
, transport
, socket
, socketPut
, socketGet
, unix
, tcp
) where
import Control.Concurrent
import Control.Monad (when)
import Data.IORef
import DBus.Address
import DBus.Connection.Authentication
import DBus.Connection.Error
import DBus.Connection.Transport
import DBus.Message.Internal
import DBus.Wire
import DBus.Wire.Internal (unmarshalMessageM)
data Connection = Connection
{ connectionAddress :: Address
, connectionSocket :: Socket
, connectionSerial :: IORef Serial
, connectionReadLock :: MVar ()
, connectionWriteLock :: MVar ()
}
connect :: [Transport] -> [Mechanism] -> Address -> IO Connection
connect transports mechanisms addr = do
msock <- connectTransport transports addr
sock <- case msock of
Just s -> return s
Nothing -> connectionError (concat
[ "Unknown address method: "
, show (addressMethod addr)
])
authed <- authenticate sock mechanisms
when (not authed)
(connectionError "Authentication failed")
serial <- newIORef (Serial 1)
readLock <- newMVar ()
writeLock <- newMVar ()
return (Connection addr sock serial
readLock writeLock)
disconnect :: Connection -> IO ()
disconnect = socketClose . connectionSocket
instance Show Connection where
showsPrec _ x =
showString "<Connection " .
shows (connectionAddress x) .
showString ">"
send :: Message msg => Connection -> msg -> (Serial -> IO a) -> IO (Either MarshalError a)
send connection msg io = do
serial <- nextSerial connection
case marshalMessage LittleEndian serial msg of
Right bytes -> do
let sock = connectionSocket connection
let lock = connectionWriteLock connection
result <- io serial
withMVar lock (\_ -> socketPut sock bytes)
return (Right result)
Left err -> return (Left err)
nextSerial :: Connection -> IO Serial
nextSerial connection = atomicModifyIORef
(connectionSerial connection)
(\serial@(Serial x) -> (Serial (x + 1), serial))
receive :: Connection -> IO (Either UnmarshalError ReceivedMessage)
receive connection = do
let sock = connectionSocket connection
let lock = connectionReadLock connection
withMVar lock (\_ -> unmarshalMessageM (socketGet sock))