-- Copyright (C) 2009-2012 John Millikin <john@john-millikin.com>
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--     http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

-- | Basic types, useful to every D-Bus application.
--
-- Authors of client applications should import "DBus.Client", which provides
-- an easy RPC-oriented interface to D-Bus methods and signals.
module DBus
    (
    -- * Messages
      Message

    -- ** Method calls
    , MethodCall
    , methodCall
    , methodCallPath
    , methodCallInterface
    , methodCallMember
    , methodCallSender
    , methodCallDestination
    , methodCallAutoStart
    , methodCallReplyExpected
    , methodCallBody

    -- ** Method returns
    , MethodReturn
    , methodReturn
    , methodReturnSerial
    , methodReturnSender
    , methodReturnDestination
    , methodReturnBody

    -- ** Method errors
    , MethodError
    , methodError
    , methodErrorName
    , methodErrorSerial
    , methodErrorSender
    , methodErrorDestination
    , methodErrorBody
    , methodErrorMessage

    -- ** Signals
    , Signal
    , signal
    , signalPath
    , signalMember
    , signalInterface
    , signalSender
    , signalDestination
    , signalBody

    -- ** Received messages
    , ReceivedMessage(ReceivedMethodCall, ReceivedMethodReturn, ReceivedMethodError, ReceivedSignal)
    , receivedMessageSerial
    , receivedMessageSender
    , receivedMessageBody

    -- * Variants
    , Variant
    , IsVariant(..)
    , variantType

    , IsAtom
    , IsValue
    , typeOf
    , typeOf'

    -- * Signatures
    , Signature
    , Type(..)
    , signature
    , signature_
    , signatureTypes
    , formatSignature
    , parseSignature

    -- * Object paths
    , ObjectPath
    , objectPath_
    , formatObjectPath
    , parseObjectPath

    -- * Names

    -- ** Interface names
    , InterfaceName
    , interfaceName_
    , formatInterfaceName
    , parseInterfaceName

    -- ** Member names
    , MemberName
    , memberName_
    , formatMemberName
    , parseMemberName

    -- ** Error names
    , ErrorName
    , errorName_
    , formatErrorName
    , parseErrorName

    -- ** Bus names
    , BusName
    , busName_
    , formatBusName
    , parseBusName

    -- * Non-native containers

    -- ** Structures
    , Structure
    , structureItems

    -- ** Arrays
    , Array
    , arrayItems

    -- ** Dictionaries
    , Dictionary
    , dictionaryItems

    -- * Addresses
    , Address
    , addressMethod
    , addressParameters
    , address
    , formatAddress
    , formatAddresses
    , parseAddress
    , parseAddresses
    , getSystemAddress
    , getSessionAddress
    , getStarterAddress

    -- * Message marshaling
    , Endianness (..)

    -- ** Marshal
    , marshal
    , MarshalError
    , marshalErrorMessage

    -- ** Unmarshal
    , unmarshal
    , UnmarshalError
    , unmarshalErrorMessage

    -- ** Message serials
    , Serial
    , serialValue
    , firstSerial
    , nextSerial

    -- * D-Bus UUIDs
    , UUID
    , formatUUID
    , randomUUID
    ) where

import           Control.Monad (replicateM)
import qualified Data.ByteString.Char8 as Char8
import           Data.Proxy (Proxy(..))
import           Data.Word (Word16)
import           System.Random (randomRIO)
import           Text.Printf (printf)

import           DBus.Internal.Address
import           DBus.Internal.Message
import qualified DBus.Internal.Types
import           DBus.Internal.Types hiding (typeOf)
import           DBus.Internal.Wire

-- | Deprecated. Get the D-Bus type corresponding to the given Haskell value. The value
-- may be @undefined@.
typeOf :: IsValue a => a -> Type
typeOf :: a -> Type
typeOf = a -> Type
forall a. IsValue a => a -> Type
DBus.Internal.Types.typeOf

-- | Get the D-Bus type corresponding to the given Haskell type 'a'.
typeOf' :: IsValue a => Proxy a -> Type
typeOf' :: Proxy a -> Type
typeOf' = Proxy a -> Type
forall a. IsValue a => Proxy a -> Type
DBus.Internal.Types.typeOf_

-- | Construct a new 'MethodCall' for the given object, interface, and method.
--
-- Use fields such as 'methodCallDestination' and 'methodCallBody' to populate
-- a 'MethodCall'.
--
-- @
--{-\# LANGUAGE OverloadedStrings \#-}
--
--methodCall \"/\" \"org.example.Math\" \"Add\"
--    { 'methodCallDestination' = Just \"org.example.Calculator\"
--    , 'methodCallBody' = ['toVariant' (1 :: Int32), 'toVariant' (2 :: Int32)]
--    }
-- @
methodCall :: ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall :: ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
path InterfaceName
iface MemberName
member = ObjectPath
-> Maybe InterfaceName
-> MemberName
-> Maybe BusName
-> Maybe BusName
-> Bool
-> Bool
-> [Variant]
-> MethodCall
MethodCall ObjectPath
path (InterfaceName -> Maybe InterfaceName
forall a. a -> Maybe a
Just InterfaceName
iface) MemberName
member Maybe BusName
forall a. Maybe a
Nothing Maybe BusName
forall a. Maybe a
Nothing Bool
True Bool
True []

-- | Construct a new 'MethodReturn', in reply to a method call with the given
-- serial.
--
-- Use fields such as 'methodReturnBody' to populate a 'MethodReturn'.
methodReturn :: Serial -> MethodReturn
methodReturn :: Serial -> MethodReturn
methodReturn Serial
s = Serial
-> Maybe BusName -> Maybe BusName -> [Variant] -> MethodReturn
MethodReturn Serial
s Maybe BusName
forall a. Maybe a
Nothing Maybe BusName
forall a. Maybe a
Nothing []

-- | Construct a new 'MethodError', in reply to a method call with the given
-- serial.
--
-- Use fields such as 'methodErrorBody' to populate a 'MethodError'.
methodError :: Serial -> ErrorName -> MethodError
methodError :: Serial -> ErrorName -> MethodError
methodError Serial
s ErrorName
name = ErrorName
-> Serial
-> Maybe BusName
-> Maybe BusName
-> [Variant]
-> MethodError
MethodError ErrorName
name Serial
s Maybe BusName
forall a. Maybe a
Nothing Maybe BusName
forall a. Maybe a
Nothing []

-- | Construct a new 'Signal' for the given object, interface, and signal name.
--
-- Use fields such as 'signalBody' to populate a 'Signal'.
signal :: ObjectPath -> InterfaceName -> MemberName -> Signal
signal :: ObjectPath -> InterfaceName -> MemberName -> Signal
signal ObjectPath
path InterfaceName
iface MemberName
member = ObjectPath
-> InterfaceName
-> MemberName
-> Maybe BusName
-> Maybe BusName
-> [Variant]
-> Signal
Signal ObjectPath
path InterfaceName
iface MemberName
member Maybe BusName
forall a. Maybe a
Nothing Maybe BusName
forall a. Maybe a
Nothing []

-- | No matter what sort of message was received, get its serial.
receivedMessageSerial :: ReceivedMessage -> Serial
receivedMessageSerial :: ReceivedMessage -> Serial
receivedMessageSerial (ReceivedMethodCall Serial
s MethodCall
_) = Serial
s
receivedMessageSerial (ReceivedMethodReturn Serial
s MethodReturn
_) = Serial
s
receivedMessageSerial (ReceivedMethodError Serial
s MethodError
_) = Serial
s
receivedMessageSerial (ReceivedSignal Serial
s Signal
_) = Serial
s
receivedMessageSerial (ReceivedUnknown Serial
s UnknownMessage
_) = Serial
s

-- | No matter what sort of message was received, get its sender (if provided).
receivedMessageSender :: ReceivedMessage -> Maybe BusName
receivedMessageSender :: ReceivedMessage -> Maybe BusName
receivedMessageSender (ReceivedMethodCall Serial
_ MethodCall
msg) = MethodCall -> Maybe BusName
methodCallSender MethodCall
msg
receivedMessageSender (ReceivedMethodReturn Serial
_ MethodReturn
msg) = MethodReturn -> Maybe BusName
methodReturnSender MethodReturn
msg
receivedMessageSender (ReceivedMethodError Serial
_ MethodError
msg) = MethodError -> Maybe BusName
methodErrorSender MethodError
msg
receivedMessageSender (ReceivedSignal Serial
_ Signal
msg) = Signal -> Maybe BusName
signalSender Signal
msg
receivedMessageSender (ReceivedUnknown Serial
_ UnknownMessage
msg) = UnknownMessage -> Maybe BusName
unknownMessageSender UnknownMessage
msg

-- | No matter what sort of message was received, get its body (if provided).
receivedMessageBody :: ReceivedMessage -> [Variant]
receivedMessageBody :: ReceivedMessage -> [Variant]
receivedMessageBody (ReceivedMethodCall Serial
_ MethodCall
msg) = MethodCall -> [Variant]
methodCallBody MethodCall
msg
receivedMessageBody (ReceivedMethodReturn Serial
_ MethodReturn
msg) = MethodReturn -> [Variant]
methodReturnBody MethodReturn
msg
receivedMessageBody (ReceivedMethodError Serial
_ MethodError
msg) = MethodError -> [Variant]
methodErrorBody MethodError
msg
receivedMessageBody (ReceivedSignal Serial
_ Signal
msg) = Signal -> [Variant]
signalBody Signal
msg
receivedMessageBody (ReceivedUnknown Serial
_ UnknownMessage
msg) = UnknownMessage -> [Variant]
unknownMessageBody UnknownMessage
msg

-- | Convert a 'Message' into a 'Char8.ByteString'. Although unusual, it is
-- possible for marshaling to fail; if this occurs, an error will be
-- returned instead.
marshal :: Message msg => Endianness -> Serial -> msg -> Either MarshalError Char8.ByteString
marshal :: Endianness -> Serial -> msg -> Either MarshalError ByteString
marshal = Endianness -> Serial -> msg -> Either MarshalError ByteString
forall a.
Message a =>
Endianness -> Serial -> a -> Either MarshalError ByteString
marshalMessage

-- | Parse a 'Char8.ByteString' into a 'ReceivedMessage'. The result can be
-- inspected to see what type of message was parsed. Unknown message types
-- can still be parsed successfully, as long as they otherwise conform to
-- the D-Bus standard.
unmarshal :: Char8.ByteString -> Either UnmarshalError ReceivedMessage
unmarshal :: ByteString -> Either UnmarshalError ReceivedMessage
unmarshal = ByteString -> Either UnmarshalError ReceivedMessage
unmarshalMessage

-- | A D-Bus UUID is 128 bits of data, usually randomly generated. They are
-- used for identifying unique server instances to clients.
--
-- Older versions of the D-Bus spec also called these values /GUIDs/.
--
-- D-Bus UUIDs are not the same as the RFC-standardized UUIDs or GUIDs.
newtype UUID = UUID Char8.ByteString
    deriving (UUID -> UUID -> Bool
(UUID -> UUID -> Bool) -> (UUID -> UUID -> Bool) -> Eq UUID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UUID -> UUID -> Bool
$c/= :: UUID -> UUID -> Bool
== :: UUID -> UUID -> Bool
$c== :: UUID -> UUID -> Bool
Eq, Eq UUID
Eq UUID
-> (UUID -> UUID -> Ordering)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> Bool)
-> (UUID -> UUID -> UUID)
-> (UUID -> UUID -> UUID)
-> Ord UUID
UUID -> UUID -> Bool
UUID -> UUID -> Ordering
UUID -> UUID -> UUID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: UUID -> UUID -> UUID
$cmin :: UUID -> UUID -> UUID
max :: UUID -> UUID -> UUID
$cmax :: UUID -> UUID -> UUID
>= :: UUID -> UUID -> Bool
$c>= :: UUID -> UUID -> Bool
> :: UUID -> UUID -> Bool
$c> :: UUID -> UUID -> Bool
<= :: UUID -> UUID -> Bool
$c<= :: UUID -> UUID -> Bool
< :: UUID -> UUID -> Bool
$c< :: UUID -> UUID -> Bool
compare :: UUID -> UUID -> Ordering
$ccompare :: UUID -> UUID -> Ordering
$cp1Ord :: Eq UUID
Ord, Int -> UUID -> ShowS
[UUID] -> ShowS
UUID -> String
(Int -> UUID -> ShowS)
-> (UUID -> String) -> ([UUID] -> ShowS) -> Show UUID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UUID] -> ShowS
$cshowList :: [UUID] -> ShowS
show :: UUID -> String
$cshow :: UUID -> String
showsPrec :: Int -> UUID -> ShowS
$cshowsPrec :: Int -> UUID -> ShowS
Show)

-- | Format a D-Bus UUID as hex-encoded ASCII.
formatUUID :: UUID -> String
formatUUID :: UUID -> String
formatUUID (UUID ByteString
bytes) = ByteString -> String
Char8.unpack ByteString
bytes

-- | Generate a random D-Bus UUID. This value is suitable for use in a
-- randomly-allocated address, or as a listener's socket address
-- @\"guid\"@ parameter.
randomUUID :: IO UUID
randomUUID :: IO UUID
randomUUID = do
    -- The version of System.Random bundled with ghc < 7.2 doesn't define
    -- instances for any of the fixed-length word types, so we imitate
    -- them using the instance for Int.
    --
    -- 128 bits is 8 16-bit integers. We use chunks of 16 instead of 32
    -- because Int is not guaranteed to be able to store a Word32.
    let hexInt16 :: Int -> t
hexInt16 Int
i = String -> Int -> t
forall r. PrintfType r => String -> r
printf String
"%04x" (Int
i :: Int)
    [Int]
int16s <- Int -> IO Int -> IO [Int]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
8 ((Int, Int) -> IO Int
forall a (m :: * -> *). (Random a, MonadIO m) => (a, a) -> m a
randomRIO (Int
0, Word16 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16
forall a. Bounded a => a
maxBound :: Word16)))
    UUID -> IO UUID
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> UUID
UUID (String -> ByteString
Char8.pack ((Int -> String) -> [Int] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int -> String
forall t. PrintfType t => Int -> t
hexInt16 [Int]
int16s)))