How to write stateful dbus methods in haskell?

Question

I'm working with dbus in haskell, and I'm having difficulties figuring out how to export dbus methods that perform stateful operations. Below is a fully fleshed out example to illustrate where I'm stuck.

---

Let's say you're writing a counter service with dbus. When the service starts, the counter is initially at 0. The service defines a dbus API that exposes a count method, which returns the current value of the counter, and an update method, which increments that counter, and returns the new value.

Here's a pseudocodey implementation of the behavior I just described, using a message-passing-style of communication:

-- | Updates the given integer. 
update :: Int -> Int
update = (+1)

-- | main function with message-passing-style communication
mainLoop :: Int -> IO Int
mainLoop state = do
  case receiveMessage of
    "update" -> do -- increment / update counter
      sendReply $ update state
      mainLoop $ update state -- recurse
    "count" -> do -- return counter value
      sendReply state
      mainLoop state
    "stop" -> do -- stop the counting service
      exitSuccess

main :: IO ()
main = do
  mainLoop 0

However, dbus uses method-calls, not message passing. So, I need to be able to export a count and update method that behaves the same way as in my message-passing example.

The stub we'll work with is something like this:

-- | Updates the given integer. 
update :: Int -> Int
update = (+1)

main :: IO ()
main = do
  let initialState = 0
  dbus <- connectSession
  export dbus "/org/counter/CounterService"
    [ autoMethod "org.counter.CounterService" "update" ({-- call update? --})
    , autoMethod "org.counter.CounterService" "count" ({-- return state? --}) ]

And here lies my question: How should I encode the missing {-- call update? --} and {-- return state? --} functions?

I know I can use an MVar to create global mutable state, and then just make the functions read from that, but I want to avoid mutability as much as possible here. I think I can do this with the Reader/State monad somehow, maybe by sneaking a get/ask into the functions, but I don't know how to handle the types with respect to DBus.

Answer 1

Ultimately, the dbus package only allows you to export methods of type Method, which has a methodHandler field that returns the monadic value:

DBusR Reply === ReaderT Client IO Reply

and there's no room in there for you to squeeze in your own StateT monad. You could export a Property instead, but that doesn't help you, since the fields of that type also involve IO actions to get and set the property.

So, maintaining your state in IO, most likely as an MVar, is going to be pretty much unavoidable.

You could try to separate your pure-ish "core" from the IO shell. One way to do it (as per @HTNW's comment) is to write the core in State:

type Counter = Int

update :: State Counter ()
update = modify (+1)

count :: State Counter Int
count = get

and lift it to IO with something like:

import Data.Tuple (swap)

runStateIO :: State s a -> MVar s -> IO a
runStateIO act s = modifyMVar s (return . swap . runState act)

main = do
    ...
    s <- newMVar 0
    let run act = runStateIO act s

    export dbus "/com/example/CounterService"
      defaultInterface
      { interfaceName = "com.example.CounterService"
      , interfaceMethods =
        [ autoMethod "update" (run update)
        , autoMethod "count" (run count) ]
      }

(I think I'm using a newer version of dbus here than you, since the API is a little different -- I'm testing with dbus-1.2.16, FYI.)

One potential drawback is that this is going to lock the state MVar on every method call, even if the call doesn't need the state or needs only read-only access. DBus services are typically pretty low-traffic with method calls that are intended to complete quickly, so I don't think this is a problem in practice.

Anyway, a here's a full working program, which I tested with:

dbus-send --print-reply --session --dest=com.example /com/example/CounterService com.example.CounterService.update
dbus-send --print-reply --session --dest=com.example /com/example/CounterService com.example.CounterService.count

The program:

{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wall #-}

import System.IO
import System.Exit
import Data.Int
import DBus.Client
import Data.Tuple
import Control.Concurrent
import Control.Monad.State

type Counter = Int32

update :: State Counter ()
update = modify (+1)

count :: State Counter Int32
count = get

runStateIO :: State s a -> MVar s -> IO a
runStateIO act s = modifyMVar s (return . swap . runState act)

main :: IO ()
main = do
  dbus <- connectSession

  requestResult <- requestName dbus "com.example" []
  when (requestResult /= NamePrimaryOwner) $ do
    hPutStrLn stderr "Name "com.example" not available"
    exitFailure

  s <- newMVar 0
  let run act = runStateIO act s

  export dbus "/com/example/CounterService"
    defaultInterface
    { interfaceName = "com.example.CounterService"
    , interfaceMethods =
      [ autoMethod "update" (run update)
      , autoMethod "count" (run count) ]
    }

  forever $ threadDelay 60000000