haskellservernotificationsdbusnotify-send

Why do I get "Unexpected reply type" from notify-send when using this Haskell notification server?

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

  1. I make sure my "official" notification server is not running (e.g. kill $(pidof dunst) from terminal),
  2. I execute the code below from terminal, which will print NamePrimaryOwner and wait,
  3. from another terminal, I'll execute 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

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).

Solution

  • 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)