Reputation: 28510
In my intentions, the code below is a work-in-progress¹ Haskell notification server.
However, even with respect to these unpretentious intentions, the program has a bug that I don't understand.
Here's what I do and observe
kill $(pidof dunst)
from terminal),NamePrimaryOwner
and wait,notify-send 'sum' 'body 1' -t 1234
The result is that where I executed step 2, the following is printed
Variant "notify-send"
Variant 0
Variant ""
Variant "sum"
Variant "body 1"
Variant []
Variant {"sender-pid": Variant 2106341, "urgency": Variant 1}
Variant 1234
which is precisely what I expect, but in the terminal of step 3, this error is shown:
Unexpected reply type
Which I think has to do with one of
(signature_ [TypeInt32])
, but that seems ok, because consistent with the protocol, no?notify
, DBusR Reply
, but that's the only thing I could put there for the code to compilenotify
, ReplyReturn [toVariant (0::Int32)]
, but again I have no clue what could be wrong with it.But most importantly, what is erroring is not the Haskell program, but the notify-send
!
As far as the other two methods go, everything seems to work:
$ dbus-send --session --print-reply --dest="org.freedesktop.Notifications" /org/freedesktop/Notifications org.freedesktop.Notifications.GetServerInformation
method return time=1709151751.802870 sender=:1.161522 -> destination=:1.161528 serial=3 reply_serial=2
string "name"
string "vendor"
string "version"
string "spec version"
$ dbus-send --session --print-reply --dest="org.freedesktop.Notifications" /org/freedesktop/Notifications org.freedesktop.Notifications.GetCapabilities
method return time=1709151753.997828 sender=:1.161522 -> destination=:1.161531 serial=4 reply_serial=2
array [
string "body"
]
But I can't use dbus-send
to test Notify
because it's just not possible, so I tried with notify-send
.
The complete code, which I came up with thanks to comments and answers to my previous questions (1, 2, 3) and this implementation that was linked by one of those answers.
{-# LANGUAGE OverloadedStrings #-}
import DBus
import DBus.Client
import Data.Int
import Control.Monad
import Control.Monad.IO.Class
import Control.Concurrent
notifyInSignature = [
TypeString,
TypeInt32,
TypeString,
TypeString,
TypeString,
TypeArray TypeString,
TypeDictionary TypeString TypeString,
TypeInt32
]
notify :: MethodCall -> DBusR Reply
notify mCall = do
liftIO $ mapM_ print [name, rid, icon, summary, body, actions, hints, expire]
return reply
where reply = ReplyReturn [toVariant (0::Int32)]
[name, rid, icon, summary, body, actions, hints, expire] = methodCallBody mCall
getServerInformation :: IO (String, String, String, String)
getServerInformation = return ("name", "vendor", "version", "spec version")
getCapabilities :: IO [String]
getCapabilities = return ["body"]
main :: IO ()
main = do
client <- connectSession
export client "/org/freedesktop/Notifications" defaultInterface {
interfaceName = "org.freedesktop.Notifications",
interfaceMethods = [
autoMethod "GetServerInformation" getServerInformation,
autoMethod "GetCapabilities" getCapabilities,
makeMethod "Notify" (signature_ notifyInSignature) (signature_ [TypeInt32]) notify
]
}
reply <- requestName client "org.freedesktop.Notifications" []
print reply
forever (threadDelay 1000000)
(¹) In the sense that it prints to stdout the insides of a notification upon receiving it but doesn't do any thing else (like deleting it upon expiration, or whatever an actual notification server should do, such as checking if a notification server is already running, thus erroring accordingly, for instance).
Upvotes: 2
Views: 107
Reputation: 51224
The issue seems to be the difference between the unsigned and signed integer types. If you look at the protocol spec, you'll see that both the input parameter replaces_id
and the reply type are UINT32
, not INT32
. The Haskell dbus
library calls the unsigned versions Word32
, so the following modified version (with just a few Int32
->Word32
changes) should work:
{-# LANGUAGE OverloadedStrings #-}
module Main (main) where
import DBus
import DBus.Client
import Data.Word -- import Word32 type
import Control.Monad
import Control.Monad.IO.Class
import Control.Concurrent
notifyInSignature = [
TypeString,
TypeWord32, -- fix type of replaces_id
TypeString,
TypeString,
TypeString,
TypeArray TypeString,
TypeDictionary TypeString TypeString,
TypeInt32
]
notify :: MethodCall -> DBusR Reply
notify mCall = do
liftIO $ mapM_ print [name, rid, icon, summary, body, actions, hints, expire]
return reply
-- *** reply should be Word32 ***
where reply = ReplyReturn [toVariant (0::Word32)]
[name, rid, icon, summary, body, actions, hints, expire] = methodCallBody mCall
getServerInformation :: IO (String, String, String, String)
getServerInformation = return ("name", "vendor", "version", "spec version")
getCapabilities :: IO [String]
getCapabilities = return ["body"]
main :: IO ()
main = do
client <- connectSession
export client "/org/freedesktop/Notifications" defaultInterface {
interfaceName = "org.freedesktop.Notifications",
interfaceMethods = [
autoMethod "GetServerInformation" getServerInformation,
autoMethod "GetCapabilities" getCapabilities,
-- *** reply should be Word32 ***
makeMethod "Notify" (signature_ notifyInSignature) (signature_ [TypeWord32]) notify
]
}
reply <- requestName client "org.freedesktop.Notifications" []
print reply
forever (threadDelay 1000000)
Upvotes: 2