module DBus.NameReservation
( RequestNameFlag (..)
, RequestNameReply (..)
, ReleaseNameReply (..)
, requestName
, releaseName
, mkRequestNameReply
, mkReleaseNameReply
) where
import Data.Word (Word32)
import Data.Bits ((.|.))
import qualified Data.Set as Set
import qualified DBus.Types as T
import qualified DBus.Message as M
import qualified DBus.Constants as C
import DBus.Util (maybeIndex)
data RequestNameFlag
= AllowReplacement
| ReplaceExisting
| DoNotQueue
deriving (Show)
encodeFlags :: [RequestNameFlag] -> Word32
encodeFlags = foldr (.|.) 0 . map flagValue where
flagValue AllowReplacement = 0x1
flagValue ReplaceExisting = 0x2
flagValue DoNotQueue = 0x4
requestName :: T.BusName -> [RequestNameFlag] -> M.MethodCall
requestName name flags = M.MethodCall
{ M.methodCallPath = C.dbusPath
, M.methodCallInterface = Just C.dbusInterface
, M.methodCallDestination = Just C.dbusName
, M.methodCallFlags = Set.empty
, M.methodCallMember = "RequestName"
, M.methodCallBody =
[ T.toVariant name
, T.toVariant . encodeFlags $ flags]
}
data RequestNameReply
= PrimaryOwner
| InQueue
| Exists
| AlreadyOwner
deriving (Show)
mkRequestNameReply :: M.MethodReturn -> Maybe RequestNameReply
mkRequestNameReply msg =
maybeIndex (M.messageBody msg) 0 >>=
T.fromVariant >>=
decodeRequestReply
decodeRequestReply :: Word32 -> Maybe RequestNameReply
decodeRequestReply 1 = Just PrimaryOwner
decodeRequestReply 2 = Just InQueue
decodeRequestReply 3 = Just Exists
decodeRequestReply 4 = Just AlreadyOwner
decodeRequestReply _ = Nothing
releaseName :: T.BusName -> M.MethodCall
releaseName name = M.MethodCall
{ M.methodCallPath = C.dbusPath
, M.methodCallInterface = Just C.dbusInterface
, M.methodCallDestination = Just C.dbusName
, M.methodCallFlags = Set.empty
, M.methodCallMember = "ReleaseName"
, M.methodCallBody = [T.toVariant name]
}
data ReleaseNameReply
= Released
| NonExistent
| NotOwner
deriving (Show)
mkReleaseNameReply :: M.MethodReturn -> Maybe ReleaseNameReply
mkReleaseNameReply msg =
maybeIndex (M.messageBody msg) 0 >>=
T.fromVariant >>=
decodeReleaseReply
decodeReleaseReply :: Word32 -> Maybe ReleaseNameReply
decodeReleaseReply 1 = Just Released
decodeReleaseReply 2 = Just NonExistent
decodeReleaseReply 3 = Just NotOwner
decodeReleaseReply _ = Nothing