{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-|
Module:      SignalDBus.Interface
Description: Low-Level IO with DBus
Copyright:   (c) Lia Lenckowski, 2022
License:     AGPL
Maintainer:  lialenck@protonmail.com
Stability:   experimental
Portability: GNU/Linux, MacOS

Except for things reexported elsewhere, this module is mainly meant for internal usage.
However, if you require APIs not implemented by the main module, you may use these functions
to implement them.
-}

module SignalDBus.Interface (
    withConn,
    withConnNum,
    withReceiveMessages,

    callSC,
    callSC_,
    callControl,
    callControl_,

    getGroupProp,
    setGroupProp,
    callGroup_,
) where

import Data.String (fromString)
import DBus hiding (ReceivedMessage(..))
import DBus.Client
import UnliftIO.Chan
import UnliftIO.Exception (bracket, catch)
import UnliftIO (MonadIO, MonadUnliftIO, liftIO, toIO, throwIO)

import SignalDBus.Types

withConnS :: MonadUnliftIO m => String -> (SignalConn -> m a) -> m a
withConnS :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (SignalConn -> m a) -> m a
withConnS String
s = forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
    (ObjectPath -> Client -> SignalConn
SignalConn (forall a. IsString a => String -> a
fromString forall a b. (a -> b) -> a -> b
$ String
"/org/asamk/Signal" forall a. [a] -> [a] -> [a]
++ String
s) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Client
connectSession)
    forall a b. (a -> b) -> a -> b
$ \(SignalConn ObjectPath
_ Client
c) -> forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> IO ()
disconnect Client
c

-- |Run an action that requires a signal connection, and return its result
withConn :: MonadUnliftIO m => (SignalConn -> m a) -> m a
withConn :: forall (m :: * -> *) a.
MonadUnliftIO m =>
(SignalConn -> m a) -> m a
withConn = forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (SignalConn -> m a) -> m a
withConnS String
""

-- |Like 'withConn', but you have to manually specify a phone number to use, which is
-- useful if the signal daemon doesn't have a default number.
-- This may not be used with a signal-cli daemon that has a default number configured.
withConnNum :: MonadUnliftIO m => String -> (SignalConn -> m a) -> m a
withConnNum :: forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (SignalConn -> m a) -> m a
withConnNum String
n = forall (m :: * -> *) a.
MonadUnliftIO m =>
String -> (SignalConn -> m a) -> m a
withConnS forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
"/_" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [a]
tail String
n
-- above usage of 'tail' because signal-cli doesn't want a '+' in front

-- |Run an action that receives a callback to receive new messages, and return its
-- result. This will /not/ yield messages that were received prior to calling this.
withReceiveMessages :: MonadUnliftIO m
    => SignalConn
    -> (m ReceivedMessage -> m a)
    -> m a
withReceiveMessages :: forall (m :: * -> *) a.
MonadUnliftIO m =>
SignalConn -> (m ReceivedMessage -> m a) -> m a
withReceiveMessages sc :: SignalConn
sc@(SignalConn ObjectPath
_ Client
c) m ReceivedMessage -> m a
cb = do
    Chan ReceivedMessage
ch <- forall (m :: * -> *) a. MonadIO m => m (Chan a)
newChan
    IO a
action <- forall (m :: * -> *) a. MonadUnliftIO m => m a -> m (IO a)
toIO forall a b. (a -> b) -> a -> b
$ m ReceivedMessage -> m a
cb forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Chan a -> m a
readChan Chan ReceivedMessage
ch
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
bracket
        (Client -> MatchRule -> (Signal -> IO ()) -> IO SignalHandler
addMatch Client
c MatchRule
match forall a b. (a -> b) -> a -> b
$ forall {m :: * -> *}.
MonadUnliftIO m =>
(ReceivedMessage -> m ()) -> Signal -> m ()
processSig forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. MonadIO m => Chan a -> a -> m ()
writeChan Chan ReceivedMessage
ch)
        (Client -> SignalHandler -> IO ()
removeMatch Client
c)
        forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const IO a
action

  where match :: MatchRule
match = MatchRule
matchAny { matchInterface :: Maybe InterfaceName
matchInterface = forall a. a -> Maybe a
Just InterfaceName
"org.asamk.Signal" }

        getGroup :: MonadUnliftIO m => Variant -> m (Maybe Group)
        getGroup :: forall (m :: * -> *). MonadUnliftIO m => Variant -> m (Maybe Group)
getGroup Variant
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall (m :: * -> *) a.
(MonadIO m, IsVariant a) =>
MemberName -> [Variant] -> SignalConn -> m a
callSC MemberName
"getGroup" [Variant
g] SignalConn
sc)
            forall (m :: * -> *) e a.
(MonadUnliftIO m, Exception e) =>
m a -> (e -> m a) -> m a
`catch` \ClientError
e -> forall a b. a -> b -> a
const (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (ClientError
e :: ClientError)

        processSig :: (ReceivedMessage -> m ()) -> Signal -> m ()
processSig ReceivedMessage -> m ()
fwd Signal
s = do
            let memb :: MemberName
memb = Signal -> MemberName
signalMember Signal
s
                body :: [Variant]
body = Signal -> [Variant]
signalBody Signal
s

            Maybe ReceivedMessage
m <- case (MemberName
memb, [Variant]
body) of
                (MemberName
"SyncMessageReceived", [Variant
ts, Variant
n, Variant
_, Variant
g, Variant
msg, Variant
as]) -> do
                    Maybe Group
may_g <- forall (m :: * -> *). MonadUnliftIO m => Variant -> m (Maybe Group)
getGroup Variant
g
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Timestamp
-> String -> Maybe Group -> String -> [String] -> ReceivedMessage
SyncMessage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
n
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Group
may_g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
msg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
as

                (MemberName
"ReceiptReceived", [Variant
ts, Variant
n]) ->
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Timestamp -> String -> ReceivedMessage
Receipt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
n

                (MemberName
"MessageReceived", [Variant
ts, Variant
n, Variant
g, Variant
msg, Variant
as]) -> do
                    Maybe Group
may_g <- forall (m :: * -> *). MonadUnliftIO m => Variant -> m (Maybe Group)
getGroup Variant
g
                    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! Timestamp
-> String -> Maybe Group -> String -> [String] -> ReceivedMessage
Message forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
ts forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
n
                        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Group
may_g forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
msg forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. IsVariant a => Variant -> Maybe a
fromVariant Variant
as

                (MemberName, [Variant])
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$! forall a. Maybe a
Nothing

            case Maybe ReceivedMessage
m of
                Just ReceivedMessage
x -> ReceivedMessage -> m ()
fwd ReceivedMessage
x
                Maybe ReceivedMessage
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |INTERNAL. Call method from the Signal.Control interface, and return its result.
callControl :: (MonadIO m, IsVariant a) => MemberName -> [Variant] -> SignalConn -> m a
callControl :: forall (m :: * -> *) a.
(MonadIO m, IsVariant a) =>
MemberName -> [Variant] -> SignalConn -> m a
callControl MemberName
meth [Variant]
args (SignalConn ObjectPath
_ Client
c) = forall (m :: * -> *) a.
(MonadIO m, IsVariant a) =>
MemberName -> [Variant] -> SignalConn -> m a
callSC MemberName
meth [Variant]
args
    forall a b. (a -> b) -> a -> b
$ ObjectPath -> Client -> SignalConn
SignalConn ObjectPath
"/org/asamk/Signal" Client
c

-- |INTERNAL. Call method from the Signal.Control interface, expecting no return value.
callControl_ :: MonadIO m => MemberName -> [Variant] -> SignalConn -> m ()
callControl_ :: forall (m :: * -> *).
MonadIO m =>
MemberName -> [Variant] -> SignalConn -> m ()
callControl_ MemberName
meth [Variant]
args (SignalConn ObjectPath
_ Client
c) = forall (m :: * -> *).
MonadIO m =>
MemberName -> [Variant] -> SignalConn -> m ()
callSC_ MemberName
meth [Variant]
args
    forall a b. (a -> b) -> a -> b
$ ObjectPath -> Client -> SignalConn
SignalConn ObjectPath
"/org/asamk/Signal" Client
c

-- |INTERNAL. Call method from the main Signal interface, and return its result.
callSC :: (MonadIO m, IsVariant a) => MemberName -> [Variant] -> SignalConn -> m a
callSC :: forall (m :: * -> *) a.
(MonadIO m, IsVariant a) =>
MemberName -> [Variant] -> SignalConn -> m a
callSC MemberName
meth [Variant]
args (SignalConn ObjectPath
p Client
c) = do
    MethodReturn
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
c
        (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal" MemberName
meth)
        { methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal",
          methodCallBody :: [Variant]
methodCallBody = [Variant]
args }

    case forall a b. (a -> b) -> [a] -> [b]
map forall a. IsVariant a => Variant -> Maybe a
fromVariant forall a b. (a -> b) -> a -> b
$ MethodReturn -> [Variant]
methodReturnBody MethodReturn
r of
        [Just a
x] -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        [Maybe a]
_ -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> ClientError
clientError forall a b. (a -> b) -> a -> b
$ String
"Unexpected reply: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MethodReturn
r

-- |INTERNAL. Call method from the main Signal interface, expecting no return value.
callSC_ :: MonadIO m => MemberName -> [Variant] -> SignalConn -> m ()
callSC_ :: forall (m :: * -> *).
MonadIO m =>
MemberName -> [Variant] -> SignalConn -> m ()
callSC_ MemberName
meth [Variant]
args (SignalConn ObjectPath
p Client
c) = do
    MethodReturn
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
c
        (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal" MemberName
meth)
        { methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal",
          methodCallBody :: [Variant]
methodCallBody = [Variant]
args }
    forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- |INTERNAL. Get group proptery
getGroupProp :: (MonadIO m, IsValue a) => MemberName -> Group -> SignalConn -> m a
getGroupProp :: forall (m :: * -> *) a.
(MonadIO m, IsValue a) =>
MemberName -> Group -> SignalConn -> m a
getGroupProp MemberName
prop (Group ObjectPath
p) (SignalConn ObjectPath
_ Client
c) = do
    Either MethodError a
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
IsValue a =>
Client -> MethodCall -> IO (Either MethodError a)
getPropertyValue Client
c
        (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal.Group" MemberName
prop)
        { methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal" }

    case Either MethodError a
r of
        Right a
x -> forall (m :: * -> *) a. Monad m => a -> m a
return a
x
        Left MethodError
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> ClientError
clientError forall a b. (a -> b) -> a -> b
$ String
"Error getting property: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MethodError
e

-- |INTERNAL. Set group proptery
setGroupProp :: (MonadIO m, IsValue a) => MemberName -> a -> Group -> SignalConn -> m ()
setGroupProp :: forall (m :: * -> *) a.
(MonadIO m, IsValue a) =>
MemberName -> a -> Group -> SignalConn -> m ()
setGroupProp MemberName
prop a
x (Group ObjectPath
p) (SignalConn ObjectPath
_ Client
c) = do
    Maybe MethodError
r <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a.
IsValue a =>
Client -> MethodCall -> a -> IO (Maybe MethodError)
setPropertyValue Client
c
        (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal.Group" MemberName
prop)
        { methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal" }
        forall a b. (a -> b) -> a -> b
$ forall a. IsVariant a => a -> Variant
toVariant a
x

    case Maybe MethodError
r of
        Maybe MethodError
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just MethodError
e -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
throwIO forall a b. (a -> b) -> a -> b
$ String -> ClientError
clientError forall a b. (a -> b) -> a -> b
$ String
"Error setting property: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show MethodError
e

-- |INTERNAL. Call method from the Signal.Group interface, expecting no return value.
callGroup_ :: MonadIO m => MemberName -> [Variant] -> Group -> SignalConn -> m ()
callGroup_ :: forall (m :: * -> *).
MonadIO m =>
MemberName -> [Variant] -> Group -> SignalConn -> m ()
callGroup_ MemberName
meth [Variant]
args (Group ObjectPath
p) (SignalConn ObjectPath
_ Client
c) = do
    MethodReturn
_ <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Client -> MethodCall -> IO MethodReturn
call_ Client
c
        (ObjectPath -> InterfaceName -> MemberName -> MethodCall
methodCall ObjectPath
p InterfaceName
"org.asamk.Signal.Group" MemberName
meth)
        { methodCallDestination :: Maybe BusName
methodCallDestination = forall a. a -> Maybe a
Just BusName
"org.asamk.Signal",
          methodCallBody :: [Variant]
methodCallBody = [Variant]
args }
    forall (m :: * -> *) a. Monad m => a -> m a
return ()