为什么我在使用 Haskell 通知服务器时从通知发送中收到“意外回复类型”？

Question

按照我的意图，下面的代码是一个正在开发中的 Haskell 通知服务器。

然而，即使考虑到这些朴实无华的意图，该程序还是有一个我不明白的错误。

这是我所做和观察的事情

1. 我确保我的“官方”通知服务器没有运行（例如来自终端的

   kill $(pidof dunst)

   ），
2. 我从终端执行下面的代码，它将打印

   NamePrimaryOwner

   并等待，
3. 从另一个终端，我将执行

   notify-send 'sum' 'body 1' -t 1234

结果是我执行步骤2的地方，打印了以下内容

Variant "notify-send"
Variant 0
Variant ""
Variant "sum"
Variant "body 1"
Variant []
Variant {"sender-pid": Variant 2106341, "urgency": Variant 1}
Variant 1234

这正是我所期望的，但是在步骤3的终端中，显示了这个错误：

Unexpected reply type

我认为这与其中之一有关

• (signature_ [TypeInt32])

  ，但这似乎没问题，因为符合协议，不是吗？

• notify

  、

  DBusR Reply

  的返回类型，但这是我可以放在那里供代码编译的唯一内容
• notify、

  ReplyReturn [toVariant (0::Int32)]

  返回的

  值

  ，但我再次不知道它可能出了什么问题。

但最重要的是，出错的不是Haskell程序，而是

notify-send

！

---

就其他两种方法而言，一切似乎都有效：

$ 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"
   ]

但是我无法使用

dbus-send

来测试

Notify

因为这是不可能的，所以我尝试使用

notify-send

。

---

完整的代码，感谢我之前问题（1、2、3）的评论和答案以及由这些答案之一链接的此实现。

{-# 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)

---

(1) 从某种意义上说，它在收到通知后将其内部打印到标准输出，但不执行任何其他操作（例如在过期时删除它，或者任何实际的通知服务器应该执行的操作，例如检查通知是否例如，服务器已经在运行，因此会相应地出错）。

Answer 1

问题似乎是无符号和有符号整数类型之间的差异。如果您查看协议规范，您会发现输入参数

replaces_id

和回复类型都是

UINT32

，而不是

INT32

。 Haskell

dbus

库调用未签名版本

Word32

，因此以下修改版本（仅进行一些

Int32

->

Word32

更改）应该可以工作：

{-# 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)