49 changed files with 941 additions and 993 deletions
--- a/bin/vbox-start.hs
+++ b/bin/vbox-start.hs
@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 -- | Start a VirtualBox instance with a sentinel wrapper process.
 --
 -- The only reason why this is needed is because I want to manage virtualboxes
--- a/bin/xmobar.hs
+++ b/bin/xmobar.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 -- | Xmobar binary
 --
 -- Features:
@ -11,14 +13,14 @@ module Main (main) where

 import Data.Internal.DBus
 import Data.Internal.XIO
-import GHC.Enum (enumFrom)
 import Options.Applicative
 import RIO hiding (hFlush)
-import RIO.FilePath
+import qualified RIO.ByteString.Lazy as BL
 import RIO.List
-import qualified RIO.NonEmpty as NE
+import RIO.Process
 import qualified RIO.Text as T
 import XMonad.Core hiding (config)
+import XMonad.Internal.Command.Desktop
 import XMonad.Internal.Command.Power
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import XMonad.Internal.DBus.Brightness.IntelBacklight
@ -29,12 +31,13 @@ import Xmobar hiding
  ( iconOffset
  , run
  )
-import Xmobar.Plugins.ActiveConnection
 import Xmobar.Plugins.Bluetooth
 import Xmobar.Plugins.ClevoKeyboard
 import Xmobar.Plugins.Common
+import Xmobar.Plugins.Device
 import Xmobar.Plugins.IntelBacklight
 import Xmobar.Plugins.Screensaver
+import Xmobar.Plugins.VPN

 main :: IO ()
 main = parse >>= xio
@ -64,7 +67,7 @@ parseTest =
 xio :: XOpts -> IO ()
 xio o = case o of
  XDeps -> hRunXIO False stderr printDeps
-  XTest -> hRunXIO False stderr $ withDBus_ Nothing Nothing evalConfig
+  XTest -> hRunXIO False stderr $ withDBus_ evalConfig
  XRun -> runXIO "xmobar.log" run

 run :: XIO ()
@ -76,8 +79,8 @@ run = do
  -- linebuffering it usually only prints the first few characters (even then
  -- it only prints 10-20% of the time)
  liftIO $ hSetBuffering stderr LineBuffering
-  -- TODO do these dbus things really need to remain connected?
-  c <- withDBus Nothing Nothing evalConfig
+  withDBus_ $ \db -> do
+    c <- evalConfig db
    liftIO $ xmobar c

 evalConfig :: DBusState -> XIO Config
@ -89,7 +92,7 @@ evalConfig db = do
  return $ config bf ifs ios cs d

 printDeps :: XIO ()
-printDeps = withDBus_ Nothing Nothing $ \db ->
+printDeps = withDBus_ $ \db ->
  mapM_ logInfo $
    fmap showFulfillment $
      sort $
@ -118,7 +121,7 @@ iconFont =
  fontSometimes
    "XMobar Icon Font"
    "Symbols Nerd Font"
-    [Package Official "ttf-nerd-fonts-symbols"]
+    [Package Official "ttf-nerd-fonts-symbols-2048-em"]

 -- | Offsets for the icons in the bar (relative to the text offset)
 iconOffset :: BarFont -> Int
@ -164,7 +167,7 @@ config bf ifs ios br confDir =
    , pickBroadest = False
    , persistent = True
    , -- store the icons with the xmonad/xmobar stack project
-      iconRoot = confDir </> "assets" </> "icons"
+      iconRoot = confDir ++ "/icons"
    , commands = csRunnable <$> concatRegions br
    }

@ -219,11 +222,11 @@ getWireless =
    xpfWireless
    [Subfeature (IORoot wirelessCmd $ Only readWireless) "sysfs path"]

-getEthernet :: Maybe NamedSysConnection -> BarFeature
-getEthernet cl = iconDBus_ "ethernet status indicator" xpfEthernet root (Only_ devDep)
+getEthernet :: Maybe SysClient -> BarFeature
+getEthernet cl = iconDBus "ethernet status indicator" xpfEthernet root tree
  where
-    root useIcon tree' =
-      DBusRoot_ (const $ ethernetCmd useIcon) tree' cl
+    root useIcon tree' = DBusRoot (const . ethernetCmd useIcon) tree' cl
+    tree = And1 (Only readEthernet) (Only_ devDep)

 getBattery :: BarFeature
 getBattery = iconIO_ "battery level indicator" xpfBattery root tree
@ -235,12 +238,18 @@ getBattery = iconIO_ "battery level indicator" xpfBattery root tree
          io $
            fmap (Msg LevelError) <$> hasBattery

-getVPN :: Maybe NamedSysConnection -> BarFeature
-getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root (Only_ devDep)
+getVPN :: Maybe SysClient -> BarFeature
+getVPN cl = iconDBus_ "VPN status indicator" xpfVPN root $ toAnd_ vpnDep test
  where
    root useIcon tree = DBusRoot_ (const $ vpnCmd useIcon) tree cl
+    test =
+      DBusIO $
+        IOTest_
+          "Use nmcli to test if VPN is present"
+          networkManagerPkgs
+          vpnPresent

-getBt :: Maybe NamedSysConnection -> BarFeature
+getBt :: Maybe SysClient -> BarFeature
 getBt = xmobarDBus "bluetooth status indicator" xpfBluetooth btDep btCmd

 getAlsa :: BarFeature
@ -251,7 +260,7 @@ getAlsa =
  where
    root useIcon = IORoot_ (alsaCmd useIcon)

-getBl :: Maybe NamedSesConnection -> BarFeature
+getBl :: Maybe SesClient -> BarFeature
 getBl =
  xmobarDBus
    "Intel backlight indicator"
@ -259,7 +268,7 @@ getBl =
    intelBacklightSignalDep
    blCmd

-getCk :: Maybe NamedSesConnection -> BarFeature
+getCk :: Maybe SesClient -> BarFeature
 getCk =
  xmobarDBus
    "Clevo keyboard indicator"
@ -267,7 +276,7 @@ getCk =
    clevoKeyboardSignalDep
    ckCmd

-getSs :: Maybe NamedSesConnection -> BarFeature
+getSs :: Maybe SesClient -> BarFeature
 getSs = xmobarDBus "screensaver indicator" (const True) ssSignalDep ssCmd

 getLock :: Always CmdSpec
@ -284,7 +293,7 @@ xmobarDBus
  -> XPQuery
  -> DBusDependency_ c
  -> (Fontifier -> CmdSpec)
-  -> Maybe (NamedConnection c)
+  -> Maybe c
  -> BarFeature
 xmobarDBus n q dep cmd cl = iconDBus_ n q root (Only_ dep)
  where
@ -298,16 +307,18 @@ iconIO_
  -> BarFeature
 iconIO_ = iconSometimes' And_ Only_

-- iconDBus
--   :: T.Text
--   -> XPQuery
--   -> (Fontifier -> DBusTree c p -> Root CmdSpec)
--   -> DBusTree c p
--   -> BarFeature
-- iconDBus = iconSometimes' And1 $ Only_ . DBusIO
+iconDBus
+  :: SafeClient c
+  => T.Text
+  -> XPQuery
+  -> (Fontifier -> DBusTree c p -> Root CmdSpec)
+  -> DBusTree c p
+  -> BarFeature
+iconDBus = iconSometimes' And1 $ Only_ . DBusIO

 iconDBus_
-  :: T.Text
+  :: SafeClient c
+  => T.Text
  -> XPQuery
  -> (Fontifier -> DBusTree_ c -> Root CmdSpec)
  -> DBusTree_ c
@ -369,19 +380,13 @@ wirelessCmd iface =
        , "<icon=wifi_%%.xpm/>"
        ]

-ethernetCmd :: Fontifier -> CmdSpec
-ethernetCmd = connCmd "\xf0e8" "ETH" ("vlan" :| ["802-3-ethernet"])
-
-vpnCmd :: Fontifier -> CmdSpec
-vpnCmd = connCmd "\xf023" "VPN" ("tun" :| [])
-
-connCmd :: T.Text -> T.Text -> NE.NonEmpty T.Text -> Fontifier -> CmdSpec
-connCmd icon abbr contypes fontify =
+ethernetCmd :: Fontifier -> T.Text -> CmdSpec
+ethernetCmd fontify iface =
  CmdSpec
-    { csAlias = connAlias contypes
+    { csAlias = iface
    , csRunnable =
        Run $
-          ActiveConnection (contypes, fontify IconMedium icon abbr, colors)
+          Device (iface, fontify IconMedium "\xf0e8" "ETH", colors)
    }

 batteryCmd :: Fontifier -> CmdSpec
@ -417,13 +422,20 @@ batteryCmd fontify =
        , fontify' "\xf1e6" "AC"
        ]

+vpnCmd :: Fontifier -> CmdSpec
+vpnCmd fontify =
+  CmdSpec
+    { csAlias = vpnAlias
+    , csRunnable = Run $ VPN (fontify IconMedium "\xf023" "VPN", colors)
+    }
+
 btCmd :: Fontifier -> CmdSpec
 btCmd fontify =
  CmdSpec
    { csAlias = btAlias
    , csRunnable =
        Run $
-          Bluetooth (fontify' "\x0f00b1" "+", fontify' "\x0f00af" "-") colors
+          Bluetooth (fontify' "\xf5b0" "+", fontify' "\xf5ae" "-") colors
    }
  where
    fontify' i = fontify IconLarge i . T.append "BT"
@ -464,7 +476,7 @@ ckCmd :: Fontifier -> CmdSpec
 ckCmd fontify =
  CmdSpec
    { csAlias = ckAlias
-    , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf11c" "KB: "
+    , csRunnable = Run $ ClevoKeyboard $ fontify IconSmall "\xf40b" "KB: "
    }

 ssCmd :: Fontifier -> CmdSpec
@ -500,8 +512,8 @@ lockCmd fontify =
              ]
    }
  where
-    numIcon = fontify' "\x0f03a6" "N"
-    capIcon = fontify' "\x0f0bf1" "C"
+    numIcon = fontify' "\xf8a5" "N"
+    capIcon = fontify' "\xf657" "C"
    fontify' = fontify IconXLarge
    disabledColor = xmobarFGColor XT.backdropFgColor

@ -512,6 +524,29 @@ dateCmd =
    , csRunnable = Run $ Date "%Y-%m-%d %H:%M:%S " "date" 10
    }

+--------------------------------------------------------------------------------
+-- low-level testing functions
+
+vpnPresent :: XIO (Maybe Msg)
+vpnPresent = do
+  res <- proc "nmcli" args readProcess
+  return $ case res of
+    (ExitSuccess, out, _)
+      | "vpn" `elem` BL.split 10 out -> Nothing
+      | otherwise -> Just $ Msg LevelError "vpn not found"
+    (ExitFailure c, _, err) ->
+      Just $
+        Msg LevelError $
+          T.concat
+            [ "vpn search exited with code "
+            , T.pack $ show c
+            , ": "
+            , T.decodeUtf8With T.lenientDecode $
+                BL.toStrict err
+            ]
+  where
+    args = ["-c", "no", "-t", "-f", "TYPE", "c", "show"]
+
 --------------------------------------------------------------------------------
 -- text font
 --
--- a/bin/xmonad.hs
+++ b/bin/xmonad.hs
@ -1,3 +1,9 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+
 --------------------------------------------------------------------------------
 --  XMonad binary

@ -21,7 +27,7 @@ import System.Process
  ( getPid
  , getProcessExitCode
  )
-import XMonad hiding (display)
+import XMonad
 import XMonad.Actions.CopyWindow
 import XMonad.Actions.CycleWS
 import XMonad.Actions.PhysicalScreens
@ -45,7 +51,6 @@ import XMonad.Internal.DBus.Removable
 import XMonad.Internal.DBus.Screensaver
 import XMonad.Internal.Shell hiding (proc)
 import qualified XMonad.Internal.Theme as XT
-import XMonad.Layout.Decoration
 import XMonad.Layout.MultiToggle
 import XMonad.Layout.NoBorders
 import XMonad.Layout.NoFrillsDecoration
@ -139,21 +144,21 @@ run = do
                        , normalBorderColor = T.unpack XT.bordersColor
                        , focusedBorderColor = T.unpack XT.selectedBordersColor
                        }
-          runXMonad conf
+          io $ runXMonad conf
  where
    startDynWorkspaces fs = do
      dws <- catMaybes <$> mapM evalSometimes (fsDynWorkspaces fs)
      void $ async $ runWorkspaceMon dws
      return dws

-runXMonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> XIO ()
+runXMonad :: (LayoutClass l Window, Read (l Window)) => XConfig l -> IO ()
 runXMonad conf = do
  dirs <- getCreateDirectories
-  liftIO $ launch conf dirs
+  launch conf dirs

-getCreateDirectories :: XIO Directories
+getCreateDirectories :: IO Directories
 getCreateDirectories = do
-  ds <- liftIO getDirectories
+  ds <- getDirectories
  mapM_ (createIfMissing ds) [dataDir, cfgDir, cacheDir]
  return ds
  where
@ -161,14 +166,14 @@ getCreateDirectories = do
      let d = f ds
      r <- tryIO $ createDirectoryIfMissing True d
      case r of
-        (Left e) -> logError $ display e
+        (Left e) -> print e
        _ -> return ()

 data FeatureSet = FeatureSet
  { fsKeys :: (XIO () -> IO ()) -> X () -> DBusState -> [KeyGroup FeatureX]
-  , fsDBusExporters :: [Maybe NamedSesConnection -> Sometimes (XIO (), XIO ())]
+  , fsDBusExporters :: [Maybe SesClient -> Sometimes (XIO (), XIO ())]
  , fsPowerMon :: SometimesIO
-  , fsRemovableMon :: Maybe NamedSysConnection -> SometimesIO
+  , fsRemovableMon :: Maybe SysClient -> SometimesIO
  , fsDaemons :: [Sometimes (XIO (Process () () ()))]
  , fsACPIHandler :: Always (String -> X ())
  , fsTabbedTheme :: Always Theme
@ -183,7 +188,7 @@ tabbedFeature = Always "theme for tabbed windows" $ Option sf fallback
    niceTheme = IORoot XT.tabbedTheme $ fontTree XT.defFontFamily defFontPkgs
    fallback = Always_ $ FallbackAlone $ XT.tabbedTheme XT.fallbackFont

-features :: Maybe NamedSysConnection -> FeatureSet
+features :: Maybe SysClient -> FeatureSet
 features cl =
  FeatureSet
    { fsKeys = externalBindings
@ -251,7 +256,7 @@ stopChildDaemons = mapM_ stop
      liftIO $ killNoWait p

 printDeps :: XIO ()
-printDeps = withDBus_ Nothing Nothing $ \db -> do
+printDeps = withDBus_ $ \db -> do
  runIO <- askRunInIO
  let mockCleanup = runCleanup runIO mockClean db
  let bfs =
@ -292,7 +297,7 @@ runCleanup runIO ts db = liftIO $ runIO $ do
  mapM_ stopXmobar $ clXmobar ts
  stopChildDaemons $ clChildren ts
  sequence_ $ clDBusUnexporters ts
-  disconnectDBus db
+  disconnectDBusX db

 -- | Kill a process (group) after xmonad has already started
 -- This is necessary (as opposed to 'stopProcess' from rio) because a) xmonad
@ -345,6 +350,9 @@ vmTag = "VM"
 xsaneTag :: String
 xsaneTag = "XSANE"

+f5Tag :: String
+f5Tag = "F5VPN"
+
 gimpDynamicWorkspace :: Sometimes DynWorkspace
 gimpDynamicWorkspace = sometimesIO_ "gimp workspace" "gimp" tree dw
  where
@ -417,11 +425,31 @@ xsaneDynamicWorkspace =
        }
    c = "Xsane"

+f5vpnDynamicWorkspace :: Sometimes DynWorkspace
+f5vpnDynamicWorkspace =
+  Sometimes
+    "F5 VPN workspace"
+    xpfF5VPN
+    [Subfeature (IORoot_ dw tree) "f5vpn"]
+  where
+    tree = Only_ $ sysExe [Package AUR "f5vpn"] "f5vpn"
+    dw =
+      DynWorkspace
+        { dwName = "F5Vpn"
+        , dwTag = f5Tag
+        , dwClass = c
+        , dwHook = [className =? c -?> appendShift f5Tag]
+        , dwKey = 'i'
+        , dwCmd = Just skip
+        }
+    c = "F5 VPN"
+
 allDWs' :: [Sometimes DynWorkspace]
 allDWs' =
  [ xsaneDynamicWorkspace
  , vmDynamicWorkspace
  , gimpDynamicWorkspace
+  , f5vpnDynamicWorkspace
  ]

 --------------------------------------------------------------------------------
@ -436,10 +464,6 @@ myLayouts tt =
      mkToggle (single HIDE) $
        tall ||| fulltab ||| full
  where
-    addTopBar
-      :: (Eq a)
-      => l a
-      -> ModifiedLayout (Decoration NoFrillsDecoration DefaultShrinker) l a
    addTopBar = noFrillsDeco shrinkText tt
    tall =
      renamed [Replace "Tall"] $
@ -832,9 +856,8 @@ externalBindings runIO cleanup db =
      , -- M-<F1> reserved for showing the keymap
        KeyBinding "M-<F2>" "restart xmonad" restartf
      , KeyBinding "M-<F3>" "recompile xmonad" recompilef
-      , KeyBinding "M-<F7>" "select autorandr profile" $ Left $ toX runAutorandrMenu
-      , KeyBinding "M-<F8>" "toggle wifi" $ Left $ toX runToggleWifi
-      , KeyBinding "M-<F9>" "toggle network" $ Left $ toX runToggleNetworking
+      , KeyBinding "M-<F8>" "select autorandr profile" $ Left $ toX runAutorandrMenu
+      , KeyBinding "M-<F9>" "toggle ethernet" $ Left $ toX runToggleEthernet
      , KeyBinding "M-<F10>" "toggle bluetooth" $ Left $ toX $ runToggleBluetooth sys
      , KeyBinding "M-<F11>" "toggle screensaver" $ Left $ toX $ callToggle ses
      , KeyBinding "M-<F12>" "switch gpu" $ Left runOptimusPrompt
--- a/assets/icons/wifi_0.xpm
+++ b/assets/icons/wifi_0.xpm
--- a/assets/icons/wifi_1.xpm
+++ b/assets/icons/wifi_1.xpm
--- a/assets/icons/wifi_2.xpm
+++ b/assets/icons/wifi_2.xpm
--- a/assets/icons/wifi_3.xpm
+++ b/assets/icons/wifi_3.xpm
--- a/assets/icons/wifi_4.xpm
+++ b/assets/icons/wifi_4.xpm
--- a/assets/icons/wifi_5.xpm
+++ b/assets/icons/wifi_5.xpm
--- a/assets/icons/wifi_6.xpm
+++ b/assets/icons/wifi_6.xpm
--- a/assets/icons/wifi_7.xpm
+++ b/assets/icons/wifi_7.xpm
--- a/assets/icons/wifi_8.xpm
+++ b/assets/icons/wifi_8.xpm
--- a/lib/Data/Internal/DBus.hs
+++ b/lib/Data/Internal/DBus.hs
@ -1,3 +1,7 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Common internal DBus functions

@ -5,17 +9,11 @@ module Data.Internal.DBus
  ( SafeClient (..)
  , SysClient (..)
  , SesClient (..)
-  , NamedConnection (..)
-  , NamedSesConnection
-  , NamedSysConnection
  , DBusEnv (..)
  , DIO
  , HasClient (..)
-  , releaseBusName
  , withDIO
  , addMatchCallback
-  , addMatchCallbackSignal
-  , matchSignalFull
  , matchProperty
  , matchPropertyFull
  , matchPropertyChanged
@ -41,10 +39,6 @@ module Data.Internal.DBus
  , displayMemberName
  , displayInterfaceName
  , displayWrapQuote
-  , busNameT
-  , interfaceNameT
-  , memberNameT
-  , objectPathT
  )
 where

@ -59,129 +53,48 @@ import qualified RIO.Text as T
 --------------------------------------------------------------------------------
 -- Type-safe client

-data NamedConnection c = NamedConnection
-  { ncClient :: !Client
-  , ncHumanName :: !(Maybe BusName)
-  --, ncUniqueName :: !BusName
-  , ncType :: !c
-  }
-
-type NamedSesConnection = NamedConnection SesClient
-
-type NamedSysConnection = NamedConnection SysClient
-
 class SafeClient c where
+  toClient :: c -> Client
+
  getDBusClient
    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => Maybe BusName
-    -> m (Maybe (NamedConnection c))
+    => m (Maybe c)

-  disconnectDBusClient
-    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => NamedConnection c
-    -> m ()
-  disconnectDBusClient c = do
-    releaseBusName c
-    liftIO $ disconnect $ ncClient c
+  disconnectDBusClient :: MonadUnliftIO m => c -> m ()
+  disconnectDBusClient = liftIO . disconnect . toClient

  withDBusClient
    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => Maybe BusName
-    -> (NamedConnection c -> m a)
+    => (c -> m a)
    -> m (Maybe a)
-  withDBusClient n f =
-    bracket (getDBusClient n) (mapM (liftIO . disconnect . ncClient)) $ mapM f
+  withDBusClient f =
+    bracket getDBusClient (mapM (liftIO . disconnect . toClient)) $ mapM f

  withDBusClient_
    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => Maybe BusName
-    -> (NamedConnection c -> m ())
+    => (c -> m ())
    -> m ()
-  withDBusClient_ n = void . withDBusClient n
+  withDBusClient_ = void . withDBusClient

  fromDBusClient
    :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-    => Maybe BusName
-    -> (NamedConnection c -> a)
+    => (c -> a)
    -> m (Maybe a)
-  fromDBusClient n f = withDBusClient n (return . f)
+  fromDBusClient f = withDBusClient (return . f)

-data SysClient = SysClient
+newtype SysClient = SysClient Client

 instance SafeClient SysClient where
-  getDBusClient = connectToDBusWithName True SysClient
+  toClient (SysClient cl) = cl

-data SesClient = SesClient
+  getDBusClient = fmap SysClient <$> getDBusClient' True
+
+newtype SesClient = SesClient Client

 instance SafeClient SesClient where
-  -- TODO wet
-  getDBusClient = connectToDBusWithName False SesClient
+  toClient (SesClient cl) = cl

-connectToDBusWithName
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Bool
-  -> c
-  -> Maybe BusName
-  -> m (Maybe (NamedConnection c))
-connectToDBusWithName sys t n = do
-  clRes <- getDBusClient' sys
-  case clRes of
-    Nothing -> do
-      logError "could not get client"
-      return Nothing
-    Just cl -> do
-      --helloRes <- liftIO $ callHello cl
-      --case helloRes of
-      --  Nothing -> do
-      --    logError "count not get unique name"
-      --    return Nothing
-      --  Just unique -> do
-          n' <- maybe (return Nothing) (`requestBusName` cl) n
-          return $
-            Just $
-              NamedConnection
-                { ncClient = cl
-                , ncHumanName = n'
-      --          , ncUniqueName = unique
-                , ncType = t
-                }
-
-releaseBusName
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => NamedConnection c
-  -> m ()
-releaseBusName NamedConnection {ncClient, ncHumanName} = do
-  -- TODO this might error?
-  case ncHumanName of
-    Just n -> do
-      liftIO $ void $ releaseName ncClient n
-      logInfo $ "released bus name: " <> displayBusName n
-    Nothing -> return ()
-
-requestBusName
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => BusName
-  -> Client
-  -> m (Maybe BusName)
-requestBusName n cl = do
-  res <- try $ liftIO $ requestName cl n []
-  case res of
-    Left e -> do
-      logError $ displayBytesUtf8 $ BC.pack $ clientErrorMessage e
-      return Nothing
-    Right r -> do
-      let msg
-            | r == NamePrimaryOwner = "registering name"
-            | r == NameAlreadyOwner = "this process already owns name"
-            | r == NameInQueue
-                || r == NameExists =
-                "another process owns name"
-            -- this should never happen
-            | otherwise = "unknown error when requesting name"
-      logInfo $ msg <> ": " <> displayBusName n
-      case r of
-        NamePrimaryOwner -> return $ Just n
-        _ -> return Nothing
+  getDBusClient = fmap SesClient <$> getDBusClient' False

 getDBusClient'
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
@ -195,28 +108,19 @@ getDBusClient' sys = do
      return Nothing
    Right c -> return $ Just c

--callHello :: Client -> IO (Maybe BusName)
--callHello cl = do
--  reply <- call_ cl $ methodCallBus dbusName dbusPath dbusInterface "Hello"
--  case methodReturnBody reply of
--    [name] | Just nameStr <- fromVariant name -> do
--      busName <- parseBusName nameStr
--      return $ Just busName
--    _ -> return Nothing
--
-data DBusEnv env c = DBusEnv {dClient :: !(NamedConnection c), dEnv :: !env}
+data DBusEnv env c = DBusEnv {dClient :: !c, dEnv :: !env}

 type DIO env c = RIO (DBusEnv env c)

 instance HasClient (DBusEnv SimpleApp) where
  clientL = lens dClient (\x y -> x {dClient = y})

-instance HasLogFunc (DBusEnv SimpleApp c) where
+instance SafeClient c => HasLogFunc (DBusEnv SimpleApp c) where
  logFuncL = lens dEnv (\x y -> x {dEnv = y}) . logFuncL

 withDIO
-  :: (MonadUnliftIO m, MonadReader env m)
-  => NamedConnection c
+  :: (MonadUnliftIO m, MonadReader env m, SafeClient c)
+  => c
  -> DIO env c a
  -> m a
 withDIO cl x = do
@ -224,7 +128,7 @@ withDIO cl x = do
  runRIO (DBusEnv cl env) x

 class HasClient env where
-  clientL :: SafeClient c => Lens' (env c) (NamedConnection c)
+  clientL :: SafeClient c => Lens' (env c) c

 --------------------------------------------------------------------------------
 -- Methods
@ -236,7 +140,7 @@ callMethod'
  => MethodCall
  -> m MethodBody
 callMethod' mc = do
-  cl <- ncClient <$> view clientL
+  cl <- toClient <$> view clientL
  liftIO $ bimap (T.pack . methodErrorMessage) methodReturnBody <$> call cl mc

 callMethod
@ -298,21 +202,9 @@ bodyToMaybe = either (const Nothing) fromSingletonVariant

 type SignalCallback m = [Variant] -> m ()

-addMatchCallbackSignal
-  :: ( MonadReader (env c) m
-     , MonadUnliftIO m
-     , SafeClient c
-     , HasClient env
-     )
-  => MatchRule
-  -> (Signal -> m ())
-  -> m SignalHandler
-addMatchCallbackSignal rule cb = do
-  cl <- ncClient <$> view clientL
-  withRunInIO $ \run -> addMatch cl rule $ run . cb
-
 addMatchCallback
  :: ( MonadReader (env c) m
+     , HasLogFunc (env c)
     , MonadUnliftIO m
     , SafeClient c
     , HasClient env
@ -320,7 +212,10 @@ addMatchCallback
  => MatchRule
  -> SignalCallback m
  -> m SignalHandler
-addMatchCallback rule cb = addMatchCallbackSignal rule (cb . signalBody)
+addMatchCallback rule cb = do
+  cl <- toClient <$> view clientL
+  withRunInIO $ \run -> do
+    addMatch cl rule $ run . cb . signalBody

 matchSignal
  :: Maybe BusName
@ -389,7 +284,7 @@ callPropertyGet
  -> MemberName
  -> m [Variant]
 callPropertyGet bus path iface property = do
-  cl <- ncClient <$> view clientL
+  cl <- toClient <$> view clientL
  res <- liftIO $ getProperty cl $ methodCallBus bus path iface property
  case res of
    Left err -> do
@ -424,26 +319,26 @@ withSignalMatch _ NoMatch = return ()
 matchPropertyChanged
  :: IsVariant a
  => InterfaceName
-  -> MemberName
+  -> T.Text
  -> [Variant]
  -> SignalMatch a
-matchPropertyChanged iface property [sigIface, sigValues, _] =
-  let i = fromVariant sigIface :: Maybe T.Text
-      v = fromVariant sigValues :: Maybe (M.Map T.Text Variant)
-   in case (i, v) of
-        (Just i', Just v') ->
-          if i' == interfaceNameT iface
-            then
-              maybe NoMatch Match $
-                fromVariant =<< M.lookup (memberNameT property) v'
+matchPropertyChanged iface property [i, body, _] =
+  let i' = (fromVariant i :: Maybe T.Text)
+      b = toMap body
+   in case (i', b) of
+        (Just i'', Just b') ->
+          if i'' == T.pack (formatInterfaceName iface)
+            then maybe NoMatch Match $ fromVariant =<< M.lookup property b'
            else NoMatch
        _ -> Failure
+  where
+    toMap v = fromVariant v :: Maybe (M.Map T.Text Variant)
 matchPropertyChanged _ _ _ = Failure

 --------------------------------------------------------------------------------
 -- Object Manager

-type ObjectTree = M.Map ObjectPath (M.Map InterfaceName (M.Map T.Text Variant))
+type ObjectTree = M.Map ObjectPath (M.Map T.Text (M.Map T.Text Variant))

 omInterface :: InterfaceName
 omInterface = interfaceName_ "org.freedesktop.DBus.ObjectManager"
@ -473,11 +368,7 @@ callGetManagedObjects bus path = do
    Left err -> do
      logError $ Utf8Builder $ encodeUtf8Builder err
      return M.empty
-    Right v ->
-      return $
-        fmap (M.mapKeys interfaceName_) $
-          fromMaybe M.empty $
-            fromSingletonVariant v
+    Right v -> return $ fromMaybe M.empty $ fromSingletonVariant v

 addInterfaceChangedListener
  :: ( MonadReader (env c) m
@ -541,14 +432,14 @@ addInterfaceRemovedListener bus =
 -- Interface export/unexport

 exportPair
-  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
  => ObjectPath
  -> (Client -> m Interface)
-  -> NamedConnection c
+  -> c
  -> (m (), m ())
 exportPair path toIface cl = (up, down)
  where
-    cl_ = ncClient cl
+    cl_ = toClient cl
    up = do
      logInfo $ "adding interface: " <> path_
      i <- toIface cl_
@ -561,18 +452,6 @@ exportPair path toIface cl = (up, down)
 --------------------------------------------------------------------------------
 -- logging helpers

-busNameT :: BusName -> T.Text
-busNameT = T.pack . formatBusName
-
-objectPathT :: ObjectPath -> T.Text
-objectPathT = T.pack . formatObjectPath
-
-interfaceNameT :: InterfaceName -> T.Text
-interfaceNameT = T.pack . formatInterfaceName
-
-memberNameT :: MemberName -> T.Text
-memberNameT = T.pack . formatMemberName
-
 displayBusName :: BusName -> Utf8Builder
 displayBusName = displayBytesUtf8 . BC.pack . formatBusName

--- a/lib/Data/Internal/XIO.hs
+++ b/lib/Data/Internal/XIO.hs
@ -1,3 +1,12 @@
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 --------------------------------------------------------------------------------
 -- Functions for handling dependencies

@ -100,7 +109,6 @@ import qualified DBus.Introspection as I
 import Data.Aeson hiding (Error, Result)
 import Data.Aeson.Key
 import Data.Internal.DBus
-import qualified Data.Text.IO as TI
 import Data.Yaml
 import GHC.IO.Exception (ioe_description)
 import RIO hiding (bracket, fromString)
@ -132,9 +140,9 @@ runXIO logfile x = withLogFile logfile $ \h -> hRunXIO True h x
 withLogFile :: MonadUnliftIO m => FilePath -> (Handle -> m a) -> m a
 withLogFile logfile f = do
  p <- (</> logfile) . dataDir <$> liftIO getDirectories
-  catchIO (withBinaryFile p AppendMode f) $ \e -> do
-    liftIO $ TI.putStrLn $ T.pack $ show e
-    liftIO $ TI.putStrLn "could not open log file, falling back to stderr"
+  catchIO (withFile p AppendMode f) $ \e -> do
+    liftIO $ print e
+    liftIO $ putStrLn "could not open log file, falling back to stderr"
    f stderr

 hRunXIO :: Bool -> Handle -> XIO a -> IO a
@ -288,18 +296,8 @@ type SubfeatureRoot a = Subfeature (Root a)
 data Root a
  = forall p. IORoot (p -> a) (IOTree p)
  | IORoot_ a IOTree_
-  | forall c p.
-    SafeClient c =>
-    DBusRoot
-      (p -> NamedConnection c -> a)
-      (DBusTree c p)
-      (Maybe (NamedConnection c))
-  | forall c.
-    SafeClient c =>
-    DBusRoot_
-      (NamedConnection c -> a)
-      (DBusTree_ c)
-      (Maybe (NamedConnection c))
+  | forall c p. SafeClient c => DBusRoot (p -> c -> a) (DBusTree c p) (Maybe c)
+  | forall c. SafeClient c => DBusRoot_ (c -> a) (DBusTree_ c) (Maybe c)

 instance Functor Root where
  fmap f (IORoot a t) = IORoot (f . a) t
@ -427,7 +425,7 @@ data XEnv = XEnv
 instance HasLogFunc XEnv where
  logFuncL = lens xLogFun (\x y -> x {xLogFun = y})

-instance HasLogFunc (DBusEnv XEnv c) where
+instance SafeClient c => HasLogFunc (DBusEnv XEnv c) where
  logFuncL = lens dEnv (\x y -> x {dEnv = y}) . logFuncL

 instance HasProcessContext XEnv where
@ -468,8 +466,7 @@ data XPFeatures = XPFeatures
  , xpfIntelBacklight :: Bool
  , xpfClevoBacklight :: Bool
  , xpfBattery :: Bool
-  , xpfEthPrefix :: Maybe Text
-  , xpfWifiPrefix :: Maybe Text
+  , xpfF5VPN :: Bool
  }

 instance FromJSON XPFeatures where
@ -496,9 +493,7 @@ instance FromJSON XPFeatures where
      <*> o
      .:+ "battery"
      <*> o
-      .:? "ethPrefix"
-      <*> o
-      .:? "wifiPrefix"
+      .:+ "f5vpn"

 defParams :: XParams
 defParams =
@ -521,8 +516,7 @@ defXPFeatures =
    , xpfIntelBacklight = False
    , xpfClevoBacklight = False
    , xpfBattery = False
-    , xpfEthPrefix = Nothing
-    , xpfWifiPrefix = Nothing
+    , xpfF5VPN = False
    }

 type XPQuery = XPFeatures -> Bool
@ -533,7 +527,7 @@ getParams = do
  maybe (return defParams) (liftIO . decodeYaml) p
  where
    decodeYaml p =
-      either (\e -> TI.putStrLn (T.pack $ show e) >> return defParams) return
+      either (\e -> print e >> return defParams) return
        =<< decodeFileEither p

 getParamFile :: MonadIO m => m (Maybe FilePath)
@ -833,16 +827,16 @@ testFont fam = maybe pass (Left . (: [])) <$> shellTest "fc-list" args msg
 -- start with "en" and wireless interfaces always start with "wl"

 readEthernet :: IODependency T.Text
-readEthernet = readInterface "get ethernet interface" (fromMaybe "en" . xpfEthPrefix)
+readEthernet = readInterface "get ethernet interface" isEthernet

 readWireless :: IODependency T.Text
-readWireless = readInterface "get wireless interface" (fromMaybe "wl" . xpfWifiPrefix)
+readWireless = readInterface "get wireless interface" isWireless

-- isWireless :: T.Text -> Bool
-- isWireless = T.isPrefixOf "wl"
+isWireless :: T.Text -> Bool
+isWireless = T.isPrefixOf "wl"

-- isEthernet :: T.Text -> Bool
-- isEthernet = T.isPrefixOf "en"
+isEthernet :: T.Text -> Bool
+isEthernet = T.isPrefixOf "en"

 listInterfaces :: MonadUnliftIO m => m [T.Text]
 listInterfaces =
@ -854,12 +848,11 @@ sysfsNet = "/sys/class/net"

 -- ASSUME there are no (non-base) packages required to make these interfaces
 -- work (all at the kernel level)
-readInterface :: T.Text -> (XPFeatures -> Text) -> IODependency T.Text
+readInterface :: T.Text -> (T.Text -> Bool) -> IODependency T.Text
 readInterface n f = IORead n [] go
  where
-    go = do
-      p <- asks (f . xpFeatures . xParams)
-      ns <- filter (T.isPrefixOf p) <$> listInterfaces
+    go = io $ do
+      ns <- filter f <$> listInterfaces
      case ns of
        [] -> return $ Left [Msg LevelError "no interfaces found"]
        (x : xs) -> do
@ -895,10 +888,10 @@ introspectInterface = interfaceName_ "org.freedesktop.DBus.Introspectable"
 introspectMethod :: MemberName
 introspectMethod = memberName_ "Introspect"

-testDBusDep_ :: SafeClient c => NamedConnection c -> DBusDependency_ c -> XIO MResult_
+testDBusDep_ :: SafeClient c => c -> DBusDependency_ c -> XIO MResult_
 testDBusDep_ c d = memoizeMVar $ testDBusDepNoCache_ c d

-testDBusDepNoCache_ :: SafeClient c => NamedConnection c -> DBusDependency_ c -> XIO Result_
+testDBusDepNoCache_ :: SafeClient c => c -> DBusDependency_ c -> XIO Result_
 testDBusDepNoCache_ cl (Bus _ bus) = do
  ret <- withDIO cl $ callMethod queryBus queryPath queryIface queryMem
  return $ case ret of
@ -1029,11 +1022,11 @@ sometimesExeArgs fn n ful sys path args =

 sometimesDBus
  :: SafeClient c
-  => Maybe (NamedConnection c)
+  => Maybe c
  -> T.Text
  -> T.Text
  -> Tree_ (DBusDependency_ c)
-  -> (NamedConnection c -> a)
+  -> (c -> a)
  -> Sometimes a
 sometimesDBus c fn n t x = sometimes1 fn n $ DBusRoot_ x t c

@ -1047,7 +1040,7 @@ sometimesEndpoint
  -> ObjectPath
  -> InterfaceName
  -> MemberName
-  -> Maybe (NamedConnection c)
+  -> Maybe c
  -> Sometimes (m ())
 sometimesEndpoint fn name ful busname path iface mem cl =
  sometimesDBus cl fn name deps cmd
--- a/lib/XMonad/Internal/Command/DMenu.hs
+++ b/lib/XMonad/Internal/Command/DMenu.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Dmenu (Rofi) Commands

@ -146,7 +148,7 @@ runAppMenu = spawnDmenuCmd "app launcher" ["-show", "drun"]
 runWinMenu :: MonadUnliftIO m => Sometimes (m ())
 runWinMenu = spawnDmenuCmd "window switcher" ["-show", "window"]

-runNetMenu :: MonadUnliftIO m => Maybe NamedSysConnection -> Sometimes (m ())
+runNetMenu :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
 runNetMenu cl =
  Sometimes
    "network control menu"
@ -171,7 +173,7 @@ runAutorandrMenu = sometimesIO_ "autorandr menu" "rofi autorandr" tree cmd
 --------------------------------------------------------------------------------
 -- Password manager

-runBwMenu :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runBwMenu :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runBwMenu cl = sometimesDBus cl "password manager" "rofi bitwarden" tree cmd
  where
    cmd _ =
@ -208,7 +210,7 @@ runClipMenu = sometimesIO_ "clipboard manager" "rofi greenclip" tree act
 -- Shortcut menu

 runShowKeys
-  :: (MonadReader env m, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => Always ([((KeyMask, KeySym), NamedAction)] -> m ())
 runShowKeys =
  Always "keyboard menu" $
@ -223,7 +225,7 @@ runShowKeys =
          defNoteError {body = Just $ Text "could not display keymap"}

 showKeysDMenu
-  :: (MonadReader env m, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => SubfeatureRoot ([((KeyMask, KeySym), NamedAction)] -> m ())
 showKeysDMenu =
  Subfeature
@ -232,7 +234,7 @@ showKeysDMenu =
    }

 showKeys
-  :: (MonadReader env m, MonadUnliftIO m)
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => [((KeyMask, KeySym), NamedAction)]
  -> m ()
 showKeys kbs = do
--- a/lib/XMonad/Internal/Command/Desktop.hs
+++ b/lib/XMonad/Internal/Command/Desktop.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- General commands

@ -19,8 +21,7 @@ module XMonad.Internal.Command.Desktop
  , runVolumeUp
  , runVolumeMute
  , runToggleBluetooth
-  , runToggleNetworking
-  , runToggleWifi
+  , runToggleEthernet
  , runRestart
  , runRecompile
  , runAreaCapture
@ -59,13 +60,13 @@ import XMonad.Operations
 -- My Executables

 myTerm :: FilePath
-myTerm = "alacritty"
+myTerm = "urxvt"

 myCalc :: FilePath
 myCalc = "bc"

 myBrowser :: FilePath
-myBrowser = "firefox"
+myBrowser = "brave"

 myEditor :: FilePath
 myEditor = "emacsclient"
@ -93,7 +94,8 @@ myNotificationCtrl = "dunstctl"

 myTermPkgs :: [Fulfillment]
 myTermPkgs =
-  [ Package Official "alacritty"
+  [ Package Official "rxvt-unicode"
+  , Package Official "urxvt-perls"
  ]

 myEditorPkgs :: [Fulfillment]
@ -108,9 +110,6 @@ bluetoothPkgs = [Package Official "bluez-utils"]
 networkManagerPkgs :: [Fulfillment]
 networkManagerPkgs = [Package Official "networkmanager"]

-nmcli :: IODependency_
-nmcli = sysExe networkManagerPkgs "nmcli"
-
 --------------------------------------------------------------------------------
 -- Misc constants

@ -121,7 +120,7 @@ volumeChangeSound = "smb_fireball.wav"
 -- Some nice apps

 runTerm :: MonadUnliftIO m => Sometimes (m ())
-runTerm = sometimesExe "terminal" "alacritty" myTermPkgs True myTerm
+runTerm = sometimesExe "terminal" "urxvt" myTermPkgs True myTerm

 runTMux :: MonadUnliftIO m => Sometimes (m ())
 runTMux = sometimesIO_ "terminal multiplexer" "tmux" deps act
@ -209,7 +208,7 @@ runStopPlay = runMultimediaIfInstalled "stop playback" "stop"
 -- Volume Commands

 soundDir :: FilePath
-soundDir = "assets" </> "sound"
+soundDir = "sound"

 playSound :: MonadIO m => FilePath -> m ()
 playSound file = do
@ -249,7 +248,7 @@ runNotificationCmd
  :: MonadUnliftIO m
  => T.Text
  -> T.Text
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> Sometimes (m ())
 runNotificationCmd n arg cl =
  sometimesDBus cl (T.unwords [n, "control"]) "dunstctl" tree cmd
@ -261,37 +260,37 @@ runNotificationCmd n arg cl =
          Method_ $
            memberName_ "NotificationAction"

-runNotificationClose :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runNotificationClose :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationClose = runNotificationCmd "close notification" "close"

-runNotificationCloseAll :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runNotificationCloseAll :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationCloseAll =
  runNotificationCmd "close all notifications" "close-all"

-runNotificationHistory :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runNotificationHistory :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationHistory =
  runNotificationCmd "see notification history" "history-pop"

-runNotificationContext :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runNotificationContext :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runNotificationContext =
  runNotificationCmd "open notification context" "context"

 --------------------------------------------------------------------------------
 -- System commands

-- needed to lookup/prompt for passwords/keys for wifi connections and some VPNs
-runNetAppDaemon :: Maybe NamedSysConnection -> Sometimes (XIO (P.Process () () ()))
+-- this is required for some vpn's to work properly with network-manager
+runNetAppDaemon :: Maybe SysClient -> Sometimes (XIO (P.Process () () ()))
 runNetAppDaemon cl =
  Sometimes
    "network applet"
-    (\x -> xpfVPN x || xpfWireless x)
+    xpfVPN
    [Subfeature (DBusRoot_ cmd tree cl) "NM-applet"]
  where
    tree = toAnd_ app $ Bus networkManagerPkgs networkManagerBus
    app = DBusIO $ sysExe [Package Official "network-manager-applet"] "nm-applet"
    cmd _ = P.proc "nm-applet" [] (P.startProcess . P.setCreateGroup True)

-runToggleBluetooth :: MonadUnliftIO m => Maybe NamedSysConnection -> Sometimes (m ())
+runToggleBluetooth :: MonadUnliftIO m => Maybe SysClient -> Sometimes (m ())
 runToggleBluetooth cl =
  Sometimes
    "bluetooth toggle"
@ -308,35 +307,27 @@ runToggleBluetooth cl =
          #!>> fmtCmd myBluetooth ["power", "$a", ">", "/dev/null"]
          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "bluetooth powered $a"}

-runToggleNetworking :: MonadUnliftIO m => Sometimes (m ())
-runToggleNetworking =
+runToggleEthernet :: MonadUnliftIO m => Sometimes (m ())
+runToggleEthernet =
  Sometimes
-    "network toggle"
-    (\x -> xpfEthernet x || xpfWireless x)
+    "ethernet toggle"
+    xpfEthernet
    [Subfeature root "nmcli"]
  where
-    root = IORoot_ cmd $ Only_ nmcli
-    cmd =
+    root =
+      IORoot cmd $
+        And1 (Only readEthernet) $
+          Only_ $
+            sysExe networkManagerPkgs "nmcli"
+    -- TODO make this less noisy
+    cmd iface =
      S.spawn $
-        fmtCmd "nmcli" ["networking"]
-          #!| "grep -q enabled"
-          #!&& "a=off"
-          #!|| "a=on"
-          #!>> fmtCmd "nmcli" ["networking", "$a"]
-          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "networking switched $a"}
-
-runToggleWifi :: MonadUnliftIO m => Sometimes (m ())
-runToggleWifi = Sometimes "wifi toggle" xpfWireless [Subfeature root "nmcli"]
-  where
-    root = IORoot_ cmd $ Only_ nmcli
-    cmd =
-      S.spawn $
-        fmtCmd "nmcli" ["radio", "wifi"]
-          #!| "grep -q enabled"
-          #!&& "a=off"
-          #!|| "a=on"
-          #!>> fmtCmd "nmcli" ["radio", "wifi", "$a"]
-          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "wifi switched $a"}
+        fmtCmd "nmcli" ["-g", "GENERAL.STATE", "device", "show", iface]
+          #!| "grep -q disconnected"
+          #!&& "a=connect"
+          #!|| "a=disconnect"
+          #!>> fmtCmd "nmcli" ["device", "$a", iface]
+          #!&& fmtNotifyCmd defNoteInfo {body = Just $ Text "ethernet \"$a\"ed"}

 --------------------------------------------------------------------------------
 -- Configuration commands
@ -377,7 +368,7 @@ runFlameshot
  :: MonadUnliftIO m
  => T.Text
  -> T.Text
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> Sometimes (m ())
 runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd
  where
@ -389,15 +380,15 @@ runFlameshot n mode cl = sometimesDBus cl n (T.pack myCapture) tree cmd

 -- TODO this will steal focus from the current window (and puts it
 -- in the root window?) ...need to fix
-runAreaCapture :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runAreaCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runAreaCapture = runFlameshot "screen area capture" "gui"

 -- myWindowCap = "screencap -w" --external script

-runDesktopCapture :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runDesktopCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runDesktopCapture = runFlameshot "fullscreen capture" "full"

-runScreenCapture :: MonadUnliftIO m => Maybe NamedSesConnection -> Sometimes (m ())
+runScreenCapture :: MonadUnliftIO m => Maybe SesClient -> Sometimes (m ())
 runScreenCapture = runFlameshot "screen capture" "screen"

 runCaptureBrowser :: MonadUnliftIO m => Sometimes (m ())
--- a/lib/XMonad/Internal/Command/Power.hs
+++ b/lib/XMonad/Internal/Command/Power.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Commands for controlling power

@ -89,8 +91,7 @@ runAutolock = sometimesIO_ "automatic screen lock" "xss-lock" tree cmd
      And_ (Only_ $ sysExe [Package Official "xss-lock"] "xss-lock") $
        Only_ $
          IOSometimes_ runScreenLock
-    cmd = P.proc "xss-lock" args (P.startProcess . P.setCreateGroup True)
-    args = ["--ignore-sleep", "--", "screenlock", "true"]
+    cmd = P.proc "xss-lock" ["--ignore-sleep", "screenlock"] (P.startProcess . P.setCreateGroup True)

 --------------------------------------------------------------------------------
 -- Confirmation prompts
@ -179,20 +180,17 @@ data PowerMaybeAction
  | Reboot
  deriving (Eq)

-fromPMA :: PowerMaybeAction -> Int
-fromPMA a = case a of
-  Poweroff -> 0
-  Shutdown -> 1
-  Hibernate -> 2
-  Reboot -> 3
+instance Enum PowerMaybeAction where
+  toEnum 0 = Poweroff
+  toEnum 1 = Shutdown
+  toEnum 2 = Hibernate
+  toEnum 3 = Reboot
+  toEnum _ = errorWithoutStackTrace "Main.Enum.PowerMaybeAction.toEnum: bad argument"

-toPMA :: Int -> Maybe PowerMaybeAction
-toPMA x = case x of
-  0 -> Just Poweroff
-  1 -> Just Shutdown
-  2 -> Just Hibernate
-  3 -> Just Reboot
-  _ -> Nothing
+  fromEnum Poweroff = 0
+  fromEnum Shutdown = 1
+  fromEnum Hibernate = 2
+  fromEnum Reboot = 3

 data PowerPrompt = PowerPrompt

@ -224,11 +222,9 @@ powerPrompt lock fb = mkXPrompt PowerPrompt theme comp executeMaybeAction
            , (xK_Return, quit)
            , (xK_Escape, quit)
            ]
-    sendMaybeAction a = setInput (show $ fromPMA a) >> setSuccess True >> setDone True
-    executeMaybeAction a = case toPMA =<< readMaybe a of
-      Just Poweroff -> liftIO runPowerOff
-      Just Shutdown -> lock >> liftIO runSuspend
-      Just Hibernate -> lock >> liftIO runHibernate
-      Just Reboot -> liftIO runReboot
-      -- TODO log an error here since this should never happen
-      Nothing -> skip
+    sendMaybeAction a = setInput (show $ fromEnum a) >> setSuccess True >> setDone True
+    executeMaybeAction a = case toEnum $ read a of
+      Poweroff -> liftIO runPowerOff
+      Shutdown -> lock >> liftIO runSuspend
+      Hibernate -> lock >> liftIO runHibernate
+      Reboot -> liftIO runReboot
--- a/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
+++ b/lib/XMonad/Internal/Concurrent/ACPIEvent.hs
@ -1,3 +1,6 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Concurrent module to handle events from acpid

@ -30,18 +33,15 @@ data ACPIEvent
  | LidClose
  deriving (Eq)

-fromACPIEvent :: ACPIEvent -> Int
-fromACPIEvent x = case x of
-  Power -> 0
-  Sleep -> 1
-  LidClose -> 2
+instance Enum ACPIEvent where
+  toEnum 0 = Power
+  toEnum 1 = Sleep
+  toEnum 2 = LidClose
+  toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"

-toACPIEvent :: Int -> Maybe ACPIEvent
-toACPIEvent x = case x of
-  0 -> Just Power
-  1 -> Just Sleep
-  2 -> Just LidClose
-  _ -> Nothing
+  fromEnum Power = 0
+  fromEnum Sleep = 1
+  fromEnum LidClose = 2

 --------------------------------------------------------------------------------
 -- Internal functions
@ -64,7 +64,7 @@ parseLine line =

 -- | Send an ACPIEvent to the X server as a ClientMessage
 sendACPIEvent :: ACPIEvent -> IO ()
-sendACPIEvent = sendXMsg ACPI . show . fromACPIEvent
+sendACPIEvent = sendXMsg ACPI . show . fromEnum

 isDischarging :: IO (Maybe Bool)
 isDischarging = do
@ -91,7 +91,7 @@ socketDep = Only_ $ pathR acpiPath [Package Official "acpid"]
 -- Xmonad's event hook)
 handleACPI :: FontBuilder -> X () -> String -> X ()
 handleACPI fb lock tag = do
-  let acpiTag = toACPIEvent =<< readMaybe tag :: Maybe ACPIEvent
+  let acpiTag = toEnum <$> readMaybe tag :: Maybe ACPIEvent
  forM_ acpiTag $ \case
    Power -> powerPrompt lock fb
    Sleep -> suspendPrompt fb
--- a/lib/XMonad/Internal/Concurrent/ClientMessage.hs
+++ b/lib/XMonad/Internal/Concurrent/ClientMessage.hs
@ -28,7 +28,6 @@ import Graphics.X11.Xlib.Atom
 import Graphics.X11.Xlib.Display
 import Graphics.X11.Xlib.Event
 import Graphics.X11.Xlib.Extras
-import RIO
 import XMonad.Internal.IO

 --------------------------------------------------------------------------------
@ -43,18 +42,14 @@ data XMsgType
  | Unknown
  deriving (Eq, Show)

-fromXMsgType :: XMsgType -> Int
-fromXMsgType x = case x of
-  ACPI -> 0
-  Workspace -> 1
-  Unknown -> 2
+instance Enum XMsgType where
+  toEnum 0 = ACPI
+  toEnum 1 = Workspace
+  toEnum _ = errorWithoutStackTrace "ACPI.Enum.ACPIEvent.toEnum: bad argument"

-toXMsgType :: Int -> Maybe XMsgType
-toXMsgType x = case x of
-  0 -> Just ACPI
-  1 -> Just Workspace
-  2 -> Just Unknown
-  _ -> Nothing
+  fromEnum ACPI = 0
+  fromEnum Workspace = 1
+  fromEnum Unknown = 2

 --------------------------------------------------------------------------------
 -- Exported API
@ -63,9 +58,9 @@ toXMsgType x = case x of
 -- type and payload
 splitXMsg :: (Integral a) => [a] -> (XMsgType, String)
 splitXMsg [] = (Unknown, "")
-splitXMsg (x : xs) = (fromMaybe Unknown xtype, tag)
+splitXMsg (x : xs) = (xtype, tag)
  where
-    xtype = toXMsgType $ fromIntegral x
+    xtype = toEnum $ fromIntegral x
    tag = chr . fromIntegral <$> takeWhile (/= 0) xs

 -- | Emit a ClientMessage event to the X server with the given type and payloud
@ -91,5 +86,5 @@ sendXMsg xtype tag = withOpenDisplay $ \dpy -> do
    setClientMessageEvent' e root bITMAP 8 (x : t)
    sendEvent dpy root False substructureNotifyMask e
  where
-    x = fromIntegral $ fromXMsgType xtype
+    x = fromIntegral $ fromEnum xtype
    t = fmap (fromIntegral . fromEnum) tag
--- a/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
+++ b/lib/XMonad/Internal/Concurrent/DynamicWorkspaces.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Automatically Manage Dynamic Workspaces
 -- This is a somewhat convoluted wrapper for the Dymamic Workspaces module
--- a/lib/XMonad/Internal/Concurrent/VirtualBox.hs
+++ b/lib/XMonad/Internal/Concurrent/VirtualBox.hs
@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 --------------------------------------------------------------------------------
 -- VirtualBox-specific functions

@ -33,7 +36,7 @@ vmInstanceConfig vmName = do
 vmDirectory :: IO (Either String String)
 vmDirectory = do
  p <- vmConfig
-  s <- tryIO $ readFileUtf8 p
+  s <- tryIO $ readFile p
  return $ case s of
    (Left _) -> Left "could not read VirtualBox config file"
    (Right x) ->
--- a/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/ClevoKeyboard.hs
@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- DBus module for Clevo Keyboard control

@ -117,7 +120,7 @@ clevoKeyboardSignalDep =

 exportClevoKeyboard
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> Sometimes (m (), m ())
 exportClevoKeyboard =
  brightnessExporter
@ -128,7 +131,7 @@ exportClevoKeyboard =

 clevoKeyboardControls
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> BrightnessControls m
 clevoKeyboardControls = brightnessControls xpfClevoBacklight clevoKeyboardConfig

@ -139,6 +142,7 @@ callGetBrightnessCK = callGetBrightness clevoKeyboardConfig

 matchSignalCK
  :: ( SafeClient c
+     , HasLogFunc (env c)
     , HasClient env
     , MonadReader (env c) m
     , MonadUnliftIO m
--- a/lib/XMonad/Internal/DBus/Brightness/Common.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/Common.hs
@ -1,3 +1,7 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections #-}
+
 --------------------------------------------------------------------------------
 -- DBus module for DBus brightness controls

@ -53,7 +57,7 @@ brightnessControls
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
  => XPQuery
  -> BrightnessConfig m a b
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> BrightnessControls m
 brightnessControls q bc cl =
  BrightnessControls
@ -76,14 +80,15 @@ callGetBrightness
  -> m (Maybe n)
 callGetBrightness BrightnessConfig {bcPath = p, bcInterface = i} =
  either (const Nothing) bodyGetBrightness
-    <$> callMethod xmonadSesBusName p i memGet
+    <$> callMethod xmonadBusName p i memGet

-signalDep :: BrightnessConfig m a b -> DBusDependency_ c
+signalDep :: BrightnessConfig m a b -> DBusDependency_ SesClient
 signalDep BrightnessConfig {bcPath = p, bcInterface = i} =
-  Endpoint [] xmonadSesBusName p i $ Signal_ memCur
+  Endpoint [] xmonadBusName p i $ Signal_ memCur

 matchSignal
  :: ( HasClient env
+     , HasLogFunc (env c)
     , MonadReader (env c) m
     , MonadUnliftIO m
     , SafeClient c
@ -112,18 +117,18 @@ brightnessExporter
  -> [Fulfillment]
  -> [IODependency_]
  -> BrightnessConfig m a b
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> Sometimes (m (), m ())
 brightnessExporter q ful deps bc@BrightnessConfig {bcName = n} cl =
  Sometimes (T.append n " DBus Interface") q [Subfeature root "exporter"]
  where
    root = DBusRoot_ (exportBrightnessControlsInner bc) tree cl
-    tree = listToAnds (Bus ful xmonadSesBusName) $ fmap DBusIO deps
+    tree = listToAnds (Bus ful xmonadBusName) $ fmap DBusIO deps

 exportBrightnessControlsInner
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, RealFrac b)
  => BrightnessConfig m a b
-  -> NamedSesConnection
+  -> SesClient
  -> (m (), m ())
 exportBrightnessControlsInner bc = cmd
  where
@ -172,7 +177,7 @@ emitBrightness BrightnessConfig {bcPath = p, bcInterface = i} client cur =
 callBacklight
  :: (MonadReader env m, HasClient (DBusEnv env), MonadUnliftIO m)
  => XPQuery
-  -> Maybe NamedSesConnection
+  -> Maybe SesClient
  -> BrightnessConfig m a b
  -> T.Text
  -> MemberName
@ -180,8 +185,8 @@ callBacklight
 callBacklight q cl BrightnessConfig {bcPath = p, bcInterface = i, bcName = n} controlName m =
  Sometimes (T.unwords [n, controlName]) q [Subfeature root "method call"]
  where
-    root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadSesBusName p i $ Method_ m) cl
-    cmd c = void $ withDIO c $ callMethod xmonadSesBusName p i m
+    root = DBusRoot_ cmd (Only_ $ Endpoint [] xmonadBusName p i $ Method_ m) cl
+    cmd c = void $ withDIO c $ callMethod xmonadBusName p i m

 bodyGetBrightness :: Num a => [Variant] -> Maybe a
 bodyGetBrightness [b] = fromIntegral <$> (fromVariant b :: Maybe Int32)
--- a/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
+++ b/lib/XMonad/Internal/DBus/Brightness/IntelBacklight.hs
@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- DBus module for Intel Backlight control

@ -103,7 +106,7 @@ intelBacklightSignalDep =

 exportIntelBacklight
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> Sometimes (m (), m ())
 exportIntelBacklight =
  brightnessExporter
@ -114,7 +117,7 @@ exportIntelBacklight =

 intelBacklightControls
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> BrightnessControls m
 intelBacklightControls = brightnessControls xpfIntelBacklight intelBacklightConfig

@ -125,6 +128,7 @@ callGetBrightnessIB = callGetBrightness intelBacklightConfig

 matchSignalIB
  :: ( SafeClient c
+     , HasLogFunc (env c)
     , HasClient env
     , MonadReader (env c) m
     , MonadUnliftIO m
--- a/lib/XMonad/Internal/DBus/Common.hs
+++ b/lib/XMonad/Internal/DBus/Common.hs
@ -2,8 +2,7 @@
 -- High-level interface for managing XMonad's DBus

 module XMonad.Internal.DBus.Common
-  ( xmonadSesBusName
-  , xmonadSysBusName
+  ( xmonadBusName
  , btBus
  , notifyBus
  , notifyPath
@ -13,11 +12,8 @@ where

 import DBus

-xmonadSesBusName :: BusName
-xmonadSesBusName = busName_ "org.xmonad.session"
-
-xmonadSysBusName :: BusName
-xmonadSysBusName = busName_ "org.xmonad.system"
+xmonadBusName :: BusName
+xmonadBusName = busName_ "org.xmonad"

 btBus :: BusName
 btBus = busName_ "org.bluez"
--- a/lib/XMonad/Internal/DBus/Control.hs
+++ b/lib/XMonad/Internal/DBus/Control.hs
@ -1,3 +1,6 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
 --------------------------------------------------------------------------------
 -- High-level interface for managing XMonad's DBus

@ -10,8 +13,9 @@ module XMonad.Internal.DBus.Control
  , withDBus
  , withDBus_
  , connectDBus
+  , connectDBusX
  , disconnectDBus
-  -- , disconnectDBusX
+  , disconnectDBusX
  , getDBusClient
  , withDBusClient
  , withDBusClient_
@ -25,6 +29,7 @@ import DBus.Client
 import Data.Internal.DBus
 import Data.Internal.XIO
 import RIO
+import qualified RIO.Text as T
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import XMonad.Internal.DBus.Common
@ -32,8 +37,8 @@ import XMonad.Internal.DBus.Screensaver

 -- | Current connections to the DBus (session and system buses)
 data DBusState = DBusState
-  { dbSesClient :: Maybe NamedSesConnection
-  , dbSysClient :: Maybe NamedSysConnection
+  { dbSesClient :: Maybe SesClient
+  , dbSysClient :: Maybe SysClient
  }

 withDBusX_
@ -45,79 +50,59 @@ withDBusX_ = void . withDBusX
 withDBusX
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => (DBusState -> m a)
-  -> m a
-withDBusX = withDBus (Just xmonadSesBusName) Nothing
+  -> m (Maybe a)
+withDBusX f = withDBus $ \db -> do
+  forM (dbSesClient db) $ \ses -> do
+    bracket_ (requestXMonadName ses) (releaseXMonadName ses) $ f db

 withDBus_
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe BusName
-  -> Maybe BusName
-  -> (DBusState -> m a)
+  => (DBusState -> m a)
  -> m ()
-withDBus_ sesname sysname = void . withDBus sesname sysname
+withDBus_ = void . withDBus

 withDBus
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe BusName
-  -> Maybe BusName
-  -> (DBusState -> m a)
+  => (DBusState -> m a)
  -> m a
-withDBus sesname sysname = bracket (connectDBus sesname sysname) disconnectDBus
+withDBus = bracket connectDBus disconnectDBus

 -- | Connect to the DBus
 connectDBus
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe BusName
-  -> Maybe BusName
-  -> m DBusState
-connectDBus sesname sysname = do
-  ses <- getDBusClient sesname
-  sys <- getDBusClient sysname
+  => m DBusState
+connectDBus = do
+  ses <- getDBusClient
+  sys <- getDBusClient
  return DBusState {dbSesClient = ses, dbSysClient = sys}

 -- | Disconnect from the DBus
-disconnectDBus
+disconnectDBus :: MonadUnliftIO m => DBusState -> m ()
+disconnectDBus db = disc dbSesClient >> disc dbSysClient
+  where
+    disc f = maybe (return ()) disconnectDBusClient $ f db
+
+-- | Connect to the DBus and request the XMonad name
+connectDBusX
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => m DBusState
+connectDBusX = do
+  db <- connectDBus
+  forM_ (dbSesClient db) requestXMonadName
+  return db
+
+-- | Disconnect from DBus and release the XMonad name
+disconnectDBusX
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
  => DBusState
  -> m ()
-disconnectDBus db = disc dbSesClient >> disc dbSysClient
-  where
-    disc
-      :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m, SafeClient c)
-      => (DBusState -> Maybe (NamedConnection c))
-      -> m ()
-    disc f = maybe (return ()) disconnectDBusClient $ f db
-
-- -- | Connect to the DBus and request the XMonad name
-- connectDBusX
--   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => m DBusState
-- connectDBusX = do
--   db <- connectDBus
--   requestXMonadName2 db
--   return db
-
-- -- | Disconnect from DBus and release the XMonad name
-- disconnectDBusX
--   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => DBusState
--   -> m ()
-- disconnectDBusX db = do
--   forM_ (dbSesClient db) releaseBusName
--   forM_ (dbSysClient db) releaseBusName
--   disconnectDBus db
-
-- requestXMonadName2
--   :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => DBusState
--   -> m ()
-- requestXMonadName2 db = do
--   forM_ (dbSesClient db) requestXMonadName
--   forM_ (dbSysClient db) requestXMonadName
+disconnectDBusX db = do
+  forM_ (dbSesClient db) releaseXMonadName
+  disconnectDBus db

 withDBusInterfaces
  :: DBusState
-  -> [Maybe NamedSesConnection -> Sometimes (XIO (), XIO ())]
+  -> [Maybe SesClient -> Sometimes (XIO (), XIO ())]
  -> ([XIO ()] -> XIO a)
  -> XIO a
 withDBusInterfaces db interfaces = bracket up sequence
@ -130,59 +115,35 @@ withDBusInterfaces db interfaces = bracket up sequence
 -- | All exporter features to be assigned to the DBus
 dbusExporters
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => [Maybe NamedSesConnection -> Sometimes (m (), m ())]
+  => [Maybe SesClient -> Sometimes (m (), m ())]
 dbusExporters = [exportScreensaver, exportIntelBacklight, exportClevoKeyboard]

-- releaseXMonadName
--   :: (SafeClient c, MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => c
--   -> m ()
-- releaseXMonadName cl = do
--   -- TODO this might error?
--   liftIO $ void $ releaseName (toClient cl) xmonadBusName
--   logInfo "released xmonad name"
+releaseXMonadName
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SesClient
+  -> m ()
+releaseXMonadName ses = do
+  -- TODO this might error?
+  liftIO $ void $ releaseName (toClient ses) xmonadBusName
+  logInfo "released xmonad name"

-- releaseBusName
--   :: (SafeClient c, MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => BusName
--   -> c
--   -> m ()
-- releaseBusName n cl = do
--   -- TODO this might error?
--   liftIO $ void $ releaseName (toClient cl) n
--   logInfo $ "released bus name: " <> displayBusName n
-
-- requestBusName
--   :: (SafeClient c, MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => BusName
--   -> c
--   -> m ()
-- requestBusName n cl = do
--   res <- try $ liftIO $ requestName (toClient cl) n []
--   case res of
--     Left e -> logError $ displayBytesUtf8 $ BC.pack $ clientErrorMessage e
--     Right r -> do
--       let msg
--             | r == NamePrimaryOwner = "registering name"
--             | r == NameAlreadyOwner = "this process already owns name"
--             | r == NameInQueue
--                 || r == NameExists =
--                 "another process owns name"
--             -- this should never happen
--             | otherwise = "unknown error when requesting name"
--       logInfo $ msg <> ": " <> displayBusName n
-
-- requestXMonadName
--   :: (SafeClient c, MonadReader env m, HasLogFunc env, MonadUnliftIO m)
--   => c
--   -> m ()
-- requestXMonadName cl = do
--   res <- liftIO $ requestName (toClient cl) xmonadBusName []
--   let msg
--         | res == NamePrimaryOwner = "registering name"
--         | res == NameAlreadyOwner = "this process already owns name"
--         | res == NameInQueue
--             || res == NameExists =
--             "another process owns name"
--         | otherwise = "unknown error when requesting name"
--   logInfo $ msg <> ": " <> displayBusName xmonadBusName
+requestXMonadName
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => SesClient
+  -> m ()
+requestXMonadName ses = do
+  res <- liftIO $ requestName (toClient ses) xmonadBusName []
+  let msg
+        | res == NamePrimaryOwner = "registering name"
+        | res == NameAlreadyOwner = "this process already owns name"
+        | res == NameInQueue
+            || res == NameExists =
+            "another process owns name"
+        | otherwise = "unknown error when requesting name"
+  logInfo $ msg <> ": " <> xn
+  where
+    xn =
+      Utf8Builder $
+        encodeUtf8Builder $
+          T.pack $
+            formatBusName xmonadBusName
--- a/lib/XMonad/Internal/DBus/Removable.hs
+++ b/lib/XMonad/Internal/DBus/Removable.hs
@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Module for monitoring removable drive events
 --
@ -80,10 +83,11 @@ playSoundMaybe p b = when b $ io $ playSound p
 -- enable the udisks2 service at boot; however this is not default behavior.
 listenDevices
  :: ( HasClient (DBusEnv env)
+     , HasLogFunc (DBusEnv env SysClient)
     , MonadReader env m
     , MonadUnliftIO m
     )
-  => NamedSysConnection
+  => SysClient
  -> m ()
 listenDevices cl = do
  addMatch' memAdded driveInsertedSound addedHasDrive
@ -95,10 +99,11 @@ listenDevices cl = do

 runRemovableMon
  :: ( HasClient (DBusEnv env)
+     , HasLogFunc (DBusEnv env SysClient)
     , MonadReader env m
     , MonadUnliftIO m
     )
-  => Maybe NamedSysConnection
+  => Maybe SysClient
  -> Sometimes (m ())
 runRemovableMon cl =
  sometimesDBus cl "removeable device monitor" "dbus monitor" deps listenDevices
--- a/lib/XMonad/Internal/DBus/Screensaver.hs
+++ b/lib/XMonad/Internal/DBus/Screensaver.hs
@ -1,3 +1,6 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- DBus module for X11 screensave/DPMS control

@ -93,7 +96,7 @@ bodyGetCurrentState _ = Nothing

 exportScreensaver
  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> Sometimes (m (), m ())
 exportScreensaver ses =
  sometimesDBus ses "screensaver toggle" "xset" (toAnd_ bus ssx) cmd
@ -119,19 +122,19 @@ exportScreensaver ses =
                }
            ]
        }
-    bus = Bus [] xmonadSesBusName
+    bus = Bus [] xmonadBusName
    ssx = DBusIO $ sysExe [Package Official "xorg-xset"] ssExecutable

 callToggle
  :: (HasClient (DBusEnv env), MonadReader env m, MonadUnliftIO m)
-  => Maybe NamedSesConnection
+  => Maybe SesClient
  -> Sometimes (m ())
 callToggle =
  sometimesEndpoint
    "screensaver toggle"
    "dbus switch"
    []
-    xmonadSesBusName
+    xmonadBusName
    ssPath
    interface
    memToggle
@ -140,11 +143,12 @@ callQuery
  :: (HasClient env, MonadReader (env SesClient) m, MonadUnliftIO m)
  => m (Maybe SSState)
 callQuery = do
-  reply <- callMethod xmonadSesBusName ssPath interface memQuery
+  reply <- callMethod xmonadBusName ssPath interface memQuery
  return $ either (const Nothing) bodyGetCurrentState reply

 matchSignal
-  :: ( HasClient env
+  :: ( HasLogFunc (env SesClient)
+     , HasClient env
     , MonadReader (env SesClient) m
     , MonadUnliftIO m
     )
@ -157,4 +161,4 @@ matchSignal cb =
      (cb . bodyGetCurrentState)

 ssSignalDep :: DBusDependency_ SesClient
-ssSignalDep = Endpoint [] xmonadSesBusName ssPath interface $ Signal_ memState
+ssSignalDep = Endpoint [] xmonadBusName ssPath interface $ Signal_ memState
--- a/lib/XMonad/Internal/IO.hs
+++ b/lib/XMonad/Internal/IO.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE ViewPatterns #-}
+
 --------------------------------------------------------------------------------
 -- Random IO-ish functions used throughtout xmonad
 --
@ -39,7 +41,7 @@ import System.Process
 -- read

 readInt :: MonadIO m => (Read a, Integral a) => FilePath -> m a
-readInt = fmap (fromMaybe 0 . readMaybe . takeWhile isDigit . T.unpack) . readFileUtf8
+readInt = fmap (read . takeWhile isDigit . T.unpack) . readFileUtf8

 readBool :: MonadIO m => FilePath -> m Bool
 readBool = fmap (== (1 :: Int)) . readInt
@ -47,7 +49,7 @@ readBool = fmap (== (1 :: Int)) . readInt
 --------------------------------------------------------------------------------
 -- write

-writeInt :: (MonadIO m, Show a) => FilePath -> a -> m ()
+writeInt :: MonadIO m => (Show a, Integral a) => FilePath -> a -> m ()
 writeInt f = writeFileUtf8 f . T.pack . show

 writeBool :: MonadIO m => FilePath -> Bool -> m ()
@ -60,7 +62,7 @@ writeBool f b = writeInt f ((if b then 1 else 0) :: Int)
 -- value. Assume that the file being read has a min of 0 and an unchanging max
 -- given by a runtime argument, which is scaled linearly to the range 0-100
 -- (percent).
-rawToPercent :: (Integral a, Integral b, RealFrac c) => (a, a) -> b -> c
+rawToPercent :: (Integral a, Integral b, Read b, RealFrac c) => (a, a) -> b -> c
 rawToPercent (lower, upper) raw =
  100 * (fromIntegral raw - fromIntegral lower) / fromIntegral (upper - lower)

--- a/lib/XMonad/Internal/Notify.hs
+++ b/lib/XMonad/Internal/Notify.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Functions for formatting and sending notifications
 --
--- a/lib/XMonad/Internal/Shell.hs
+++ b/lib/XMonad/Internal/Shell.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 -- Functions for formatting and spawning shell commands

 module XMonad.Internal.Shell
@ -83,7 +85,10 @@ spawn :: MonadIO m => T.Text -> m ()
 spawn = X.spawn . T.unpack

 -- | Run 'XMonad.Run.Utils.spawnPipe' with 'Text' input.
-spawnPipe :: MonadUnliftIO m => T.Text -> m Handle
+spawnPipe
+  :: (MonadReader env m, HasLogFunc env, MonadUnliftIO m)
+  => T.Text
+  -> m Handle
 spawnPipe = liftIO . XR.spawnPipe . T.unpack

 -- spawnPipeRW
--- a/lib/XMonad/Internal/Theme.hs
+++ b/lib/XMonad/Internal/Theme.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Theme for XMonad and Xmobar

@ -31,7 +33,6 @@ where

 import Data.Colour
 import Data.Colour.SRGB
-import RIO
 import qualified RIO.Text as T
 import qualified XMonad.Layout.Decoration as D
 import qualified XMonad.Prompt as P
--- a/lib/Xmobar/Plugins/ActiveConnection.hs
+++ b/lib/Xmobar/Plugins/ActiveConnection.hs
@ -1,155 +0,0 @@
--------------------------------------------------------------------------------
-- NetworkManager Connection plugin
--
-- Show active connections of varying types.
--
-- This plugin exclusively monitors the */ActiveConnection/* paths in the
-- NetworkManager DBus path for state changes. It does not pin these to any
-- particular interface but instead looks at all connections equally and filters
-- based on their Type (ethernet, wifi, VPN, etc). For many use cases this will
-- track well enough with either one or a collection of similar interfaces (ie
-- all ethernet or all wifi).
-
-module Xmobar.Plugins.ActiveConnection
-  ( ActiveConnection (..)
-  , devDep
-  , connAlias
-  )
-where
-
-import DBus
-import Data.Internal.DBus
-import Data.Internal.XIO
-import RIO
-import qualified RIO.Map as M
-import qualified RIO.NonEmpty as NE
-import qualified RIO.Text as T
-import XMonad.Internal.Command.Desktop
-import XMonad.Internal.DBus.Common
-import Xmobar
-import Xmobar.Plugins.Common
-
-newtype ActiveConnection
-  = ActiveConnection (NE.NonEmpty T.Text, T.Text, Colors)
-  deriving (Read, Show)
-
-connAlias :: NE.NonEmpty T.Text -> T.Text
-connAlias = T.intercalate "_" . NE.toList
-
-instance Exec ActiveConnection where
-  alias (ActiveConnection (contypes, _, _)) = T.unpack $ connAlias contypes
-  start (ActiveConnection (contypes, text, colors)) cb =
-    withDBusClientConnection cb Nothing (Just "ethernet.log") $ \c -> do
-      let dpy cb' = displayMaybe cb' formatter . Just =<< readState
-      i <- withDIO c $ initialState contypes
-      s <- newMVar i
-      let mapEnv c' = mapRIO (PluginEnv c' s dpy cb)
-      mapEnv c $ addListener mapEnv >> pluginDisplay
-    where
-      formatter names = return $ case names of
-        [] -> colorText colors False text
-        xs -> T.unwords [colorText colors True text, T.intercalate "|" xs]
-      addListener mapEnv = do
-        res <- matchSignalFull nmBus Nothing (Just nmActiveInterface) (Just stateChanged)
-        case res of
-          Nothing -> logError "could not start listener"
-          Just rule ->
-            -- Start a new connection and RIO process since the parent thread
-            -- will have died before these callbacks fire, therefore the logging
-            -- file descriptor will be closed. This makes a new one
-            -- TODO can I recycle the client?
-            void $
-              addMatchCallbackSignal rule $ \sig ->
-                withDBusClientConnection cb Nothing (Just "ethernet-cb.log") $ \c' ->
-                  mapEnv c' $
-                    testActiveType contypes sig
-
-nmBus :: BusName
-nmBus = "org.freedesktop.NetworkManager"
-
-nmPath :: ObjectPath
-nmPath = "/org/freedesktop/NetworkManager"
-
-nmInterface :: InterfaceName
-nmInterface = "org.freedesktop.NetworkManager"
-
-nmObjectTreePath :: ObjectPath
-nmObjectTreePath = "/org/freedesktop"
-
-nmActiveInterface :: InterfaceName
-nmActiveInterface = "org.freedesktop.NetworkManager.Connection.Active"
-
-stateChanged :: MemberName
-stateChanged = "StateChanged"
-
-- semi-random method to test to ensure that NetworkManager is up and on DBus
-devDep :: DBusDependency_ SysClient
-devDep =
-  Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
-    Method_ "GetDeviceByIpIface"
-
-type EthIO = PluginIO EthState SysClient
-
-type EthState = M.Map ObjectPath T.Text
-
-getConnectionProp :: MemberName -> ObjectPath -> EthIO [Variant]
-getConnectionProp prop path = callPropertyGet nmBus path nmActiveInterface prop
-
-getConnectionId :: ObjectPath -> EthIO (Maybe T.Text)
-getConnectionId = fmap fromSingletonVariant . getConnectionProp "Id"
-
-getConnectionType :: ObjectPath -> EthIO (Maybe T.Text)
-getConnectionType = fmap fromSingletonVariant . getConnectionProp "Type"
-
-updateConnected :: NE.NonEmpty T.Text -> ObjectPath -> EthIO ()
-updateConnected contypes path = do
-  typeRes <- getConnectionType path
-  logMaybe "type" getId typeRes
-  where
-    path' = displayBytesUtf8 $ T.encodeUtf8 $ T.pack $ formatObjectPath path
-    logMaybe what = maybe (logError ("could not get " <> what <> " for " <> path'))
-    getId contype = do
-      when (contype `elem` contypes) $ do
-        idRes <- getConnectionId path
-        logMaybe "ID" insertId idRes
-    insertId i = do
-      s <- asks plugState
-      modifyMVar_ s $ return . M.insert path i
-
-updateDisconnected :: ObjectPath -> EthIO ()
-updateDisconnected path = do
-  s <- asks plugState
-  modifyMVar_ s $ return . M.delete path
-
-testActiveType :: NE.NonEmpty T.Text -> Signal -> EthIO ()
-testActiveType contypes sig = do
-  case signalBody sig of
-    [state, _] -> case fromVariant state of
-      Just (2 :: Word32) -> updateConnected contypes path >> pluginDisplay
-      Just 4 -> updateDisconnected path >> pluginDisplay
-      _ -> return ()
-    _ -> return ()
-  where
-    path = signalPath sig
-
-initialState
-  :: ( SafeClient c
-     , MonadUnliftIO m
-     , MonadReader (env c) m
-     , HasClient env
-     , HasLogFunc (env c)
-     )
-  => NE.NonEmpty T.Text
-  -> m EthState
-initialState contypes =
-  M.mapMaybe go <$> callGetManagedObjects nmBus nmObjectTreePath
-  where
-    go = getId <=< M.lookup nmActiveInterface
-    getId m =
-      fromVariant
-        =<< (\t -> if t `elem` contypes then M.lookup "Id" m else Nothing)
-        =<< fromVariant
-        =<< M.lookup "Type" m
-
-readState :: EthIO [T.Text]
-readState = M.elems <$> (readMVar =<< asks plugState)
--- a/lib/Xmobar/Plugins/BacklightCommon.hs
+++ b/lib/Xmobar/Plugins/BacklightCommon.hs
@ -1,10 +1,11 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 -- Common backlight plugin bits
 --
 -- Use the custom DBus interface exported by the XMonad process so I can react
 -- to signals spawned by commands
 module Xmobar.Plugins.BacklightCommon (startBacklight) where

-import DBus
 import Data.Internal.DBus
 import RIO
 import qualified RIO.Text as T
@ -12,15 +13,14 @@ import Xmobar.Plugins.Common

 startBacklight
  :: (MonadUnliftIO m, RealFrac a)
-  => Maybe BusName
-  -> Maybe FilePath
+  => Maybe FilePath
  -> ((Maybe a -> DIO SimpleApp SesClient ()) -> DIO SimpleApp SesClient ())
  -> DIO SimpleApp SesClient (Maybe a)
  -> T.Text
  -> Callback
  -> m ()
-startBacklight n name matchSignal callGetBrightness icon cb = do
-  withDBusClientConnection cb n name $ \c -> withDIO c $ do
+startBacklight name matchSignal callGetBrightness icon cb = do
+  withDBusClientConnection cb name $ \c -> withDIO c $ do
    matchSignal dpy
    dpy =<< callGetBrightness
  where
--- a/lib/Xmobar/Plugins/Bluetooth.hs
+++ b/lib/Xmobar/Plugins/Bluetooth.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Bluetooth plugin
 --
@ -7,18 +9,28 @@
 -- Manager. The adapter is located at path "/org/bluez/hci<X>" where X is
 -- usually 0, and each device is "/org/bluez/hci<X>/<MAC_ADDRESS>".
 --
-- Simple and somewhat crude way to do this is to have two monitors, one
-- watching the powered state of the adaptor and one listening for connection
-- changes. The former is easy since this is just one /org/bluez/hciX. For the
-- latter, each 'Connected' property is embedded in each individual device path
-- on `org.bluez.Device1', so just watch the entire bluez bus for property
-- changes and filter those that correspond to the aforementioned
-- interface/property. Track all this in a state which keeps the powered
-- property and a running list of connected devices.
+-- This plugin will reflect if the adapter is powered and if any device is
+-- connected to it. The rough outline for this procedure:
+-- 1) get the adapter from the object manager
+-- 2) get all devices associated with the adapter using the object interface
+-- 3) determine if the adapter is powered
+-- 4) determine if any devices are connected
+-- 5) format the icon; powered vs not powered controls the color and connected
+--    vs not connected controls the icon (connected bluetooth symbol has two
+--    dots flanking it)
+--
+-- Step 3 can be accomplished using the "org.bluez.Adapter1" interface and
+-- querying the "Powered" property. Step 4 can be done using the
+-- "org.bluez.Device1" interface and the "Connected" property for each device
+-- path. Since these are properties, we can asynchronously read changes to them
+-- via the "PropertiesChanged" signal.
+--
+-- If any devices are added/removed, steps 2-4 will need to be redone and any
+-- listeners will need to be updated. (TODO not sure which signals to use in
+-- determining if a device is added)
 --
 -- TODO also not sure if I need to care about multiple adapters and/or the
-- adapter changing. For now it should just get the first adaptor and only pay
-- attention to devices associated with it.
+-- adapter changing.

 module Xmobar.Plugins.Bluetooth
  ( Bluetooth (..)
@ -35,7 +47,6 @@ import RIO
 import RIO.FilePath
 import RIO.List
 import qualified RIO.Map as M
-import qualified RIO.Set as S
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Common
 import Xmobar
@ -54,28 +65,32 @@ data Bluetooth = Bluetooth Icons Colors deriving (Read, Show)
 instance Exec Bluetooth where
  alias (Bluetooth _ _) = T.unpack btAlias
  start (Bluetooth icons colors) cb =
-    withDBusClientConnection cb Nothing (Just "bluetooth.log") $
-      startAdapter icons colors cb
+    withDBusClientConnection cb (Just "bluetooth.log") $ startAdapter icons colors cb

 startAdapter
  :: Icons
  -> Colors
  -> Callback
-  -> NamedSysConnection
+  -> SysClient
  -> RIO SimpleApp ()
 startAdapter is cs cb cl = do
  state <- newMVar emptyState
-  let dpy cb' = displayIcon cb' (iconFormatter is cs)
-  mapRIO (PluginEnv cl state dpy cb) $ do
+  let dpy = displayIcon cb (iconFormatter is cs)
+  mapRIO (BTEnv cl state dpy) $ do
    ot <- getBtObjectTree
-    case findAdaptor ot of
+    case findAdapter ot of
      Nothing -> logError "could not find bluetooth adapter"
-      Just adaptor -> do
-        initAdapterState adaptor
-        initDevicesState adaptor ot
-        startAdaptorListener adaptor
-        startConnectedListener adaptor
-        pluginDisplay
+      Just adapter -> do
+        -- set up adapter
+        initAdapter adapter
+        void $ addAdaptorListener adapter
+        -- set up devices on the adapter (and listeners for adding/removing devices)
+        let devices = findDevices adapter ot
+        addDeviceAddedListener adapter
+        addDeviceRemovedListener adapter
+        forM_ devices $ \d -> addAndInitDevice d
+        -- after setting things up, show the icon based on the initialized state
+        dpy

 --------------------------------------------------------------------------------
 -- Icon Display
@ -100,18 +115,43 @@ iconFormatter (iconConn, iconDisc) cs powered connected =

 --------------------------------------------------------------------------------
 -- Connection State
+--
+-- The signal handlers all run on separate threads, yet the icon depends on
+-- the state reflected by all these signals. The best (only?) way to do this is
+-- is to track the shared state of the bluetooth adaptor and its devices using
+-- an MVar.

-type BTIO = PluginIO BtState SysClient
+data BTEnv c = BTEnv
+  { btClient :: !c
+  , btState :: !(MVar BtState)
+  , btDisplay :: !(BTIO ())
+  , btEnv :: !SimpleApp
+  }
+
+instance HasClient BTEnv where
+  clientL = lens btClient (\x y -> x {btClient = y})
+
+instance HasLogFunc (BTEnv a) where
+  logFuncL = lens btEnv (\x y -> x {btEnv = y}) . logFuncL
+
+type BTIO = RIO (BTEnv SysClient)
+
+data BTDevice = BTDevice
+  { btDevConnected :: Maybe Bool
+  , btDevSigHandler :: SignalHandler
+  }
+
+type ConnectedDevices = M.Map ObjectPath BTDevice

 data BtState = BtState
-  { btDevices :: S.Set ObjectPath
+  { btDevices :: ConnectedDevices
  , btPowered :: Maybe Bool
  }

 emptyState :: BtState
 emptyState =
  BtState
-    { btDevices = S.empty
+    { btDevices = M.empty
    , btPowered = Nothing
    }

@ -119,33 +159,24 @@ readState :: BTIO (Maybe Bool, Bool)
 readState = do
  p <- readPowered
  c <- readDevices
-  return (p, not $ null c)
+  return (p, anyDevicesConnected c)

 modifyState :: (BtState -> BTIO (BtState, a)) -> BTIO a
 modifyState f = do
-  m <- asks plugState
+  m <- asks btState
  modifyMVar m f

 beforeDisplay :: BTIO () -> BTIO ()
-beforeDisplay f = f >> pluginDisplay
+beforeDisplay f = f >> join (asks btDisplay)

 --------------------------------------------------------------------------------
 -- Object manager

-findAdaptor :: ObjectTree -> Maybe ObjectPath
-findAdaptor = find (("/org/bluez/hci" `isPrefixOf`) . formatObjectPath) . M.keys
+findAdapter :: ObjectTree -> Maybe ObjectPath
+findAdapter = find (("/org/bluez/hci" `isPrefixOf`) . formatObjectPath) . M.keys

-- | Search the object tree for devices which are in a connected state.
-- Return the object path for said devices.
-findConnectedDevices :: ObjectPath -> ObjectTree -> [ObjectPath]
-findConnectedDevices adaptor =
-  filter (adaptorHasDevice adaptor) . M.keys . M.filter isConnectedDev
-  where
-    isConnectedDev m = Just True == lookupState m
-    lookupState =
-      fromVariant
-        <=< M.lookup (memberNameT devConnected)
-        <=< M.lookup devInterface
+findDevices :: ObjectPath -> ObjectTree -> [ObjectPath]
+findDevices adapter = filter (adaptorHasDevice adapter) . M.keys

 adaptorHasDevice :: ObjectPath -> ObjectPath -> Bool
 adaptorHasDevice adaptor device = case splitPathNoRoot device of
@ -168,14 +199,49 @@ getBtObjectTree = callGetManagedObjects btBus btOMPath
 btOMPath :: ObjectPath
 btOMPath = objectPath_ "/"

+addBtOMListener
+  :: ( HasClient env
+     , SafeClient c
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => SignalCallback m
+  -> m ()
+addBtOMListener sc = void $ addInterfaceAddedListener btBus btOMPath sc
+
+addDeviceAddedListener :: ObjectPath -> BTIO ()
+addDeviceAddedListener adapter = addBtOMListener addDevice
+  where
+    addDevice = pathCallback adapter $ \d ->
+      addAndInitDevice d
+
+addDeviceRemovedListener :: ObjectPath -> BTIO ()
+addDeviceRemovedListener adapter =
+  addBtOMListener remDevice
+  where
+    remDevice = pathCallback adapter $ \d -> do
+      old <- removeDevice d
+      cl <- asks btClient
+      forM_ old $ liftIO . removeMatch (toClient cl) . btDevSigHandler
+
+pathCallback :: ObjectPath -> (ObjectPath -> BTIO ()) -> SignalCallback BTIO
+pathCallback adapter f [device, _] = forM_ (fromVariant device) $ \d -> do
+  when (adaptorHasDevice adapter d) $ beforeDisplay $ f d
+pathCallback _ _ _ = return ()
+
 --------------------------------------------------------------------------------
 -- Adapter

-- | Get powered state of adaptor and log the result
-initAdapterState :: ObjectPath -> BTIO ()
-initAdapterState adapter = do
+initAdapter :: ObjectPath -> BTIO ()
+initAdapter adapter = do
  reply <- callGetPowered adapter
+  logInfo $ "initializing adapter at path " <> adapter_
+  -- TODO this could fail if the variant is something weird; the only
+  -- indication I will get is "NA"
  putPowered $ fromSingletonVariant reply
+  where
+    adapter_ = displayWrapQuote $ displayObjectPath adapter

 matchBTProperty
  :: ( SafeClient c
@ -188,23 +254,40 @@ matchBTProperty
  -> m (Maybe MatchRule)
 matchBTProperty p = matchPropertyFull btBus (Just p)

-- | Start a listener that monitors changes to the powered state of an adaptor
-startAdaptorListener :: ObjectPath -> BTIO ()
-startAdaptorListener adaptor = do
-  res <- matchBTProperty adaptor
+withBTPropertyRule
+  :: ( SafeClient c
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , HasClient env
+     , MonadUnliftIO m
+     , IsVariant a
+     )
+  => ObjectPath
+  -> (Maybe a -> m ())
+  -> InterfaceName
+  -> T.Text
+  -> m (Maybe SignalHandler)
+withBTPropertyRule path update iface prop = do
+  res <- matchBTProperty path
  case res of
-    Just rule -> void $ addMatchCallback rule callback
+    Just rule -> Just <$> addMatchCallback rule (signalToUpdate . matchConnected)
    Nothing -> do
      logError $
        "could not add listener for prop "
-          <> displayMemberName adaptorPowered
+          <> prop_
          <> " on path "
-          <> displayObjectPath adaptor
+          <> path_
+      return Nothing
+  where
+    path_ = displayObjectPath path
+    prop_ = Utf8Builder $ encodeUtf8Builder prop
+    signalToUpdate = withSignalMatch update
+    matchConnected = matchPropertyChanged iface prop
+
+addAdaptorListener :: ObjectPath -> BTIO (Maybe SignalHandler)
+addAdaptorListener adaptor =
+  withBTPropertyRule adaptor procMatch adapterInterface adaptorPowered
  where
-    callback sig =
-      withNestedDBusClientConnection Nothing Nothing $
-        withSignalMatch procMatch $
-          matchPropertyChanged adaptorInterface adaptorPowered sig
    procMatch = beforeDisplay . putPowered

 callGetPowered
@ -217,58 +300,88 @@ callGetPowered
  => ObjectPath
  -> m [Variant]
 callGetPowered adapter =
-  callPropertyGet btBus adapter adaptorInterface adaptorPowered
+  callPropertyGet btBus adapter adapterInterface $
+    memberName_ $
+      T.unpack adaptorPowered

 putPowered :: Maybe Bool -> BTIO ()
 putPowered ds = modifyState $ \s -> return (s {btPowered = ds}, ())

 readPowered :: BTIO (Maybe Bool)
-readPowered = fmap btPowered $ readMVar =<< asks plugState
+readPowered = fmap btPowered $ readMVar =<< asks btState

-adaptorInterface :: InterfaceName
-adaptorInterface = interfaceName_ "org.bluez.Adapter1"
+adapterInterface :: InterfaceName
+adapterInterface = interfaceName_ "org.bluez.Adapter1"

-adaptorPowered :: MemberName
+adaptorPowered :: T.Text
 adaptorPowered = "Powered"

 --------------------------------------------------------------------------------
 -- Devices

-initDevicesState :: ObjectPath -> ObjectTree -> BTIO ()
-initDevicesState adaptor ot = do
-  let devices = findConnectedDevices adaptor ot
-  modifyState $ \s -> return (s {btDevices = S.fromList devices}, ())
-
-startConnectedListener :: ObjectPath -> BTIO ()
-startConnectedListener adaptor = do
-  reply <- matchPropertyFull btBus Nothing
-  case reply of
-    Just rule -> do
-      void $ addMatchCallbackSignal rule callback
-      logInfo $ "Started listening for device connections on " <> adaptor_
-    Nothing -> logError "Could not listen for connection changes"
+addAndInitDevice :: ObjectPath -> BTIO ()
+addAndInitDevice device = do
+  res <- addDeviceListener device
+  case res of
+    Just handler -> do
+      logInfo $ "initializing device at path " <> device_
+      initDevice handler device
+    Nothing -> logError $ "could not initialize device at path " <> device_
  where
-    adaptor_ = displayWrapQuote $ displayObjectPath adaptor
-    callback sig =
-      withNestedDBusClientConnection Nothing Nothing $ do
-        let devpath = signalPath sig
-        when (adaptorHasDevice adaptor devpath) $
-          withSignalMatch (update devpath) $
-            matchConnected $
-              signalBody sig
-    matchConnected = matchPropertyChanged devInterface devConnected
-    update _ Nothing = return ()
-    update devpath (Just x) = do
-      let f = if x then S.insert else S.delete
-      beforeDisplay $
-        modifyState $
-          \s -> return (s {btDevices = f devpath $ btDevices s}, ())
+    device_ = displayWrapQuote $ displayObjectPath device

-readDevices :: BTIO (S.Set ObjectPath)
-readDevices = fmap btDevices $ readMVar =<< asks plugState
+initDevice :: SignalHandler -> ObjectPath -> BTIO ()
+initDevice sh device = do
+  reply <- callGetConnected device
+  void $
+    insertDevice device $
+      BTDevice
+        { btDevConnected = fromVariant =<< listToMaybe reply
+        , btDevSigHandler = sh
+        }
+
+addDeviceListener :: ObjectPath -> BTIO (Maybe SignalHandler)
+addDeviceListener device =
+  withBTPropertyRule device procMatch devInterface devConnected
+  where
+    procMatch = beforeDisplay . void . updateDevice device
+
+callGetConnected
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => ObjectPath
+  -> m [Variant]
+callGetConnected p =
+  callPropertyGet btBus p devInterface $
+    memberName_ (T.unpack devConnected)
+
+insertDevice :: ObjectPath -> BTDevice -> BTIO Bool
+insertDevice device dev = modifyState $ \s -> do
+  let new = M.insert device dev $ btDevices s
+  return (s {btDevices = new}, anyDevicesConnected new)
+
+updateDevice :: ObjectPath -> Maybe Bool -> BTIO Bool
+updateDevice device status = modifyState $ \s -> do
+  let new = M.update (\d -> Just d {btDevConnected = status}) device $ btDevices s
+  return (s {btDevices = new}, anyDevicesConnected new)
+
+anyDevicesConnected :: ConnectedDevices -> Bool
+anyDevicesConnected = or . mapMaybe btDevConnected . M.elems
+
+removeDevice :: ObjectPath -> BTIO (Maybe BTDevice)
+removeDevice device = modifyState $ \s -> do
+  let devs = btDevices s
+  return (s {btDevices = M.delete device devs}, M.lookup device devs)
+
+readDevices :: BTIO ConnectedDevices
+readDevices = fmap btDevices $ readMVar =<< asks btState

 devInterface :: InterfaceName
 devInterface = interfaceName_ "org.bluez.Device1"

-devConnected :: MemberName
+devConnected :: T.Text
 devConnected = "Connected"
--- a/lib/Xmobar/Plugins/ClevoKeyboard.hs
+++ b/lib/Xmobar/Plugins/ClevoKeyboard.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Clevo Keyboard plugin
 --
@ -10,7 +12,6 @@ module Xmobar.Plugins.ClevoKeyboard
  )
 where

-import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Brightness.ClevoKeyboard
 import Xmobar
@ -24,9 +25,4 @@ ckAlias = "clevokeyboard"
 instance Exec ClevoKeyboard where
  alias (ClevoKeyboard _) = T.unpack ckAlias
  start (ClevoKeyboard icon) =
-    startBacklight
-      (Just "org.xmobar.clevo")
-      (Just "clevo_kbd.log")
-      matchSignalCK
-      callGetBrightnessCK
-      icon
+    startBacklight (Just "clevo_kbd.log") matchSignalCK callGetBrightnessCK icon
--- a/lib/Xmobar/Plugins/Common.hs
+++ b/lib/Xmobar/Plugins/Common.hs
@ -1,19 +1,17 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module Xmobar.Plugins.Common
  ( colorText
  , startListener
  , procSignalMatch
  , na
  , fromSingletonVariant
-  , withNestedDBusClientConnection
  , withDBusClientConnection
  , Callback
  , Colors (..)
  , displayMaybe
  , displayMaybe'
  , xmobarFGColor
-  , PluginEnv (..)
-  , PluginIO
-  , pluginDisplay
  )
 where

@ -25,28 +23,6 @@ import RIO
 import qualified RIO.Text as T
 import XMonad.Hooks.DynamicLog (xmobarColor)

-data PluginEnv s c = PluginEnv
-  { plugClient :: !(NamedConnection c)
-  , plugState :: !(MVar s)
-  , plugDisplay :: !(Callback -> PluginIO s c ())
-  , plugCallback :: !Callback
-  , plugEnv :: !SimpleApp
-  }
-
-pluginDisplay :: PluginIO s c ()
-pluginDisplay = do
-  cb <- asks plugCallback
-  dpy <- asks plugDisplay
-  dpy cb
-
-type PluginIO s c = RIO (PluginEnv s c)
-
-instance HasClient (PluginEnv s) where
-  clientL = lens plugClient (\x y -> x {plugClient = y})
-
-instance HasLogFunc (PluginEnv s c) where
-  logFuncL = lens plugEnv (\x y -> x {plugEnv = y}) . logFuncL
-
 -- use string here since all the callbacks in xmobar use strings :(
 type Callback = String -> IO ()

@ -57,7 +33,8 @@ data Colors = Colors
  deriving (Eq, Show, Read)

 startListener
-  :: ( HasClient env
+  :: ( HasLogFunc (env c)
+     , HasClient env
     , MonadReader (env c) m
     , MonadUnliftIO m
     , SafeClient c
@ -99,42 +76,14 @@ displayMaybe' cb = maybe (liftIO $ cb $ T.unpack na)
 withDBusClientConnection
  :: (MonadUnliftIO m, SafeClient c)
  => Callback
-  -> Maybe BusName
  -> Maybe FilePath
-  -> (NamedConnection c -> RIO SimpleApp ())
+  -> (c -> RIO SimpleApp ())
  -> m ()
-withDBusClientConnection cb n logfile f =
+withDBusClientConnection cb logfile f =
  maybe (run stderr) (`withLogFile` run) logfile
  where
    run h = do
      logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
      withLogFunc logOpts $ \lf -> do
        env <- mkSimpleApp lf Nothing
-        runRIO env $ displayMaybe' cb f =<< getDBusClient n
-
-- | Run a plugin action with a new DBus client and logfile path. This is
-- necessary for DBus callbacks which run in separate threads, which will
-- usually fire when the parent thread already exited and killed off its DBus
-- connection and closed its logfile. NOTE: unlike 'withDBusClientConnection'
-- this function will open and new logfile and client connection and close both
-- on completion. 'withDBusClientConnection' will only close the log file but
-- keep the client connection active upon termination; this client will only be
-- killed when the entire process is killed. This distinction is important
-- because callbacks only need ephemeral connections, while listeners (started
-- with 'withDBusClientConnection') need long-lasting connections.
-withNestedDBusClientConnection
-  :: (MonadUnliftIO m, SafeClient c, MonadReader (PluginEnv s c) m)
-  => Maybe BusName
-  -> Maybe FilePath
-  -> PluginIO s c ()
-  -> m ()
-withNestedDBusClientConnection n logfile f = do
-  dpy <- asks plugDisplay
-  s <- asks plugState
-  cb <- asks plugCallback
-  let run h = do
-        logOpts <- setLogVerboseFormat True . setLogUseTime True <$> logOptionsHandle h False
-        withLogFunc logOpts $ \lf -> do
-          env <- mkSimpleApp lf Nothing
-          runRIO env $ withDBusClient_ n $ \cl -> mapRIO (PluginEnv cl s dpy cb) f
-  maybe (run stderr) (`withLogFile` run) logfile
+        runRIO env $ displayMaybe' cb f =<< getDBusClient
--- a/lib/Xmobar/Plugins/Device.hs
+++ b/lib/Xmobar/Plugins/Device.hs
@ -0,0 +1,89 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+--------------------------------------------------------------------------------
+-- Device plugin
+--
+-- Display different text depending on whether or not the interface has
+-- connectivity
+
+module Xmobar.Plugins.Device
+  ( Device (..)
+  , devDep
+  )
+where
+
+import DBus
+import Data.Internal.DBus
+import Data.Internal.XIO
+import RIO
+import qualified RIO.Text as T
+import XMonad.Internal.Command.Desktop
+import XMonad.Internal.DBus.Common
+import Xmobar
+import Xmobar.Plugins.Common
+
+newtype Device = Device (T.Text, T.Text, Colors) deriving (Read, Show)
+
+nmPath :: ObjectPath
+nmPath = objectPath_ "/org/freedesktop/NetworkManager"
+
+nmInterface :: InterfaceName
+nmInterface = interfaceName_ "org.freedesktop.NetworkManager"
+
+nmDeviceInterface :: InterfaceName
+nmDeviceInterface = interfaceName_ "org.freedesktop.NetworkManager.Device"
+
+getByIP :: MemberName
+getByIP = memberName_ "GetDeviceByIpIface"
+
+devSignal :: T.Text
+devSignal = "Ip4Connectivity"
+
+devDep :: DBusDependency_ SysClient
+devDep =
+  Endpoint networkManagerPkgs networkManagerBus nmPath nmInterface $
+    Method_ getByIP
+
+getDevice
+  :: (SafeClient c, HasClient env, MonadReader (env c) m, MonadUnliftIO m)
+  => T.Text
+  -> m (Maybe ObjectPath)
+getDevice iface = bodyToMaybe <$> callMethod' mc
+  where
+    mc =
+      (methodCallBus networkManagerBus nmPath nmInterface getByIP)
+        { methodCallBody = [toVariant iface]
+        }
+
+getDeviceConnected
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => ObjectPath
+  -> m [Variant]
+getDeviceConnected path =
+  callPropertyGet networkManagerBus path nmDeviceInterface $
+    memberName_ $
+      T.unpack devSignal
+
+matchStatus :: [Variant] -> SignalMatch Word32
+matchStatus = matchPropertyChanged nmDeviceInterface devSignal
+
+instance Exec Device where
+  alias (Device (iface, _, _)) = T.unpack iface
+  start (Device (iface, text, colors)) cb =
+    withDBusClientConnection cb logName $ \(sys :: SysClient) -> withDIO sys $ do
+      path <- getDevice iface
+      displayMaybe' cb listener path
+    where
+      logName = Just $ T.unpack $ T.concat ["device@", iface, ".log"]
+      listener path = do
+        res <- matchPropertyFull networkManagerBus (Just path)
+        case res of
+          Just rule -> startListener rule (getDeviceConnected path) matchStatus chooseColor' cb
+          Nothing -> logError "could not start listener"
+      chooseColor' = return . (\s -> colorText colors s text) . (> 1)
--- a/lib/Xmobar/Plugins/IntelBacklight.hs
+++ b/lib/Xmobar/Plugins/IntelBacklight.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Intel backlight plugin
 --
@ -10,7 +12,6 @@ module Xmobar.Plugins.IntelBacklight
  )
 where

-import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Brightness.IntelBacklight
 import Xmobar
@ -24,9 +25,4 @@ blAlias = "intelbacklight"
 instance Exec IntelBacklight where
  alias (IntelBacklight _) = T.unpack blAlias
  start (IntelBacklight icon) =
-    startBacklight
-      (Just "org.xmobar.intelbacklight")
-      (Just "intel_backlight.log")
-      matchSignalIB
-      callGetBrightnessIB
-      icon
+    startBacklight (Just "intel_backlight.log") matchSignalIB callGetBrightnessIB icon
--- a/lib/Xmobar/Plugins/Screensaver.hs
+++ b/lib/Xmobar/Plugins/Screensaver.hs
@ -1,3 +1,5 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 --------------------------------------------------------------------------------
 -- Screensaver plugin
 --
@ -11,7 +13,6 @@ module Xmobar.Plugins.Screensaver
 where

 import Data.Internal.DBus
-import RIO
 import qualified RIO.Text as T
 import XMonad.Internal.DBus.Screensaver
 import Xmobar
@ -25,11 +26,7 @@ ssAlias = "screensaver"
 instance Exec Screensaver where
  alias (Screensaver _) = T.unpack ssAlias
  start (Screensaver (text, colors)) cb =
-    withDBusClientConnection
-      cb
-      (Just "org.xmobar.screensaver")
-      (Just "screensaver.log")
-      $ \cl -> withDIO cl $ do
+    withDBusClientConnection cb (Just "screensaver.log") $ \cl -> withDIO cl $ do
      matchSignal dpy
      dpy =<< callQuery
    where
--- a/lib/Xmobar/Plugins/VPN.hs
+++ b/lib/Xmobar/Plugins/VPN.hs
@ -0,0 +1,173 @@
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
+
+--------------------------------------------------------------------------------
+-- VPN plugin
+--
+-- Use the networkmanager to detect when a VPN interface is added or removed.
+-- Specifically, monitor the object tree to detect paths with the interface
+-- "org.freedesktop.NetworkManager.Device.Tun".
+
+module Xmobar.Plugins.VPN
+  ( VPN (..)
+  , vpnAlias
+  , vpnDep
+  )
+where
+
+import DBus
+import Data.Internal.DBus
+import Data.Internal.XIO
+import RIO
+import qualified RIO.Map as M
+import qualified RIO.Set as S
+import qualified RIO.Text as T
+import XMonad.Internal.Command.Desktop
+import XMonad.Internal.DBus.Common
+import Xmobar
+import Xmobar.Plugins.Common
+
+newtype VPN = VPN (T.Text, Colors) deriving (Read, Show)
+
+instance Exec VPN where
+  alias (VPN _) = T.unpack vpnAlias
+  start (VPN (text, colors)) cb =
+    withDBusClientConnection cb (Just "vpn.log") $ \c -> do
+      let dpy = displayMaybe cb iconFormatter . Just =<< readState
+      s <- newEmptyMVar
+      mapRIO (VEnv c s dpy) $ do
+        initState
+        vpnAddedListener addedCallback
+        vpnRemovedListener removedCallback
+        dpy
+    where
+      iconFormatter b = return $ colorText colors b text
+
+--------------------------------------------------------------------------------
+-- VPN State
+--
+-- Maintain a set of paths which are the currently active VPNs. Most of the time
+-- this will be a null or singleton set, but this setup could handle the edge
+-- case of multiple VPNs being active at once without puking.
+
+data VEnv c = VEnv
+  { vClient :: !c
+  , vState :: !(MVar VPNState)
+  , vDisplay :: !(VIO ())
+  , vEnv :: !SimpleApp
+  }
+
+instance SafeClient c => HasLogFunc (VEnv c) where
+  logFuncL = lens vEnv (\x y -> x {vEnv = y}) . logFuncL
+
+instance HasClient VEnv where
+  clientL = lens vClient (\x y -> x {vClient = y})
+
+type VIO = RIO (VEnv SysClient)
+
+type VPNState = S.Set ObjectPath
+
+initState :: VIO ()
+initState = do
+  ot <- getVPNObjectTree
+  s <- asks vState
+  putMVar s $ findTunnels ot
+
+readState :: VIO Bool
+readState = fmap (not . null) . readMVar =<< asks vState
+
+updateState :: (ObjectPath -> VPNState -> VPNState) -> ObjectPath -> VIO ()
+updateState f op = do
+  s <- asks vState
+  modifyMVar_ s $ return . f op
+
+beforeDisplay :: VIO () -> VIO ()
+beforeDisplay f = f >> join (asks vDisplay)
+
+--------------------------------------------------------------------------------
+-- Tunnel Device Detection
+
+getVPNObjectTree
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => m ObjectTree
+getVPNObjectTree = callGetManagedObjects vpnBus vpnPath
+
+findTunnels :: ObjectTree -> VPNState
+findTunnels = S.fromList . M.keys . M.filter (elem vpnDeviceTun . M.keys)
+
+vpnAddedListener
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => SignalCallback m
+  -> m ()
+vpnAddedListener cb = void $ addInterfaceAddedListener vpnBus vpnPath cb
+
+vpnRemovedListener
+  :: ( SafeClient c
+     , HasClient env
+     , MonadReader (env c) m
+     , HasLogFunc (env c)
+     , MonadUnliftIO m
+     )
+  => SignalCallback m
+  -> m ()
+vpnRemovedListener cb = void $ addInterfaceRemovedListener vpnBus vpnPath cb
+
+addedCallback :: SignalCallback VIO
+addedCallback [device, added] =
+  beforeDisplay $
+    updateDevice S.insert device $
+      M.keys $
+        fromMaybe M.empty added'
+  where
+    added' = fromVariant added :: Maybe (M.Map T.Text (M.Map T.Text Variant))
+addedCallback _ = return ()
+
+removedCallback :: SignalCallback VIO
+removedCallback [device, interfaces] =
+  beforeDisplay $
+    updateDevice S.delete device $
+      fromMaybe [] $
+        fromVariant interfaces
+removedCallback _ = return ()
+
+updateDevice
+  :: (ObjectPath -> VPNState -> VPNState)
+  -> Variant
+  -> [T.Text]
+  -> VIO ()
+updateDevice f device interfaces =
+  when (vpnDeviceTun `elem` interfaces) $
+    forM_ d $
+      updateState f
+  where
+    d = fromVariant device :: Maybe ObjectPath
+
+--------------------------------------------------------------------------------
+-- DBus Interface
+
+vpnBus :: BusName
+vpnBus = busName_ "org.freedesktop.NetworkManager"
+
+vpnPath :: ObjectPath
+vpnPath = objectPath_ "/org/freedesktop"
+
+vpnDeviceTun :: T.Text
+vpnDeviceTun = "org.freedesktop.NetworkManager.Device.Tun"
+
+vpnAlias :: T.Text
+vpnAlias = "vpn"
+
+vpnDep :: DBusDependency_ SysClient
+vpnDep =
+  Endpoint networkManagerPkgs networkManagerBus vpnPath omInterface $
+    Method_ getManagedObjects
--- a/package.yaml
+++ b/package.yaml
@ -9,47 +9,9 @@ extra-source-files:
 - README.md
 - fourmolu.yaml
 - make_pkgs
- runtime_pkgs
- assets/icons/*
- assets/sound/*
+- icons/*
 - scripts/*
-
-default-extensions:
-  - OverloadedStrings
-  - FlexibleContexts
-  - FlexibleInstances
-  - InstanceSigs
-  - MultiParamTypeClasses
-  - EmptyCase
-  - LambdaCase
-  - MultiWayIf
-  - NamedFieldPuns
-  - TupleSections
-  - DeriveFoldable
-  - DeriveFunctor
-  - DeriveGeneric
-  - DeriveLift
-  - DeriveTraversable
-  - DerivingStrategies
-  - DeriveDataTypeable
-  - EmptyDataDecls
-  - PartialTypeSignatures
-  - GeneralizedNewtypeDeriving
-  - StandaloneDeriving
-  - BangPatterns
-  - TypeOperators
-  - ScopedTypeVariables
-  - TypeApplications
-  - ConstraintKinds
-  - RankNTypes
-  - GADTs
-  - DefaultSignatures
-  - NoImplicitPrelude
-  - FunctionalDependencies
-  - DataKinds
-  - TypeFamilies
-  - BinaryLiterals
-  - ViewPatterns
+- sound/*

 dependencies:
  - rio >= 0.1.21.0
@ -75,19 +37,13 @@ dependencies:
  - unliftio >= 0.2.21.0
  - optparse-applicative >= 0.16.1.0

-ghc-options:
- -Wall
- -Wcompat
- -Widentities
- -Wincomplete-record-updates
- -Wincomplete-uni-patterns
- -Wredundant-constraints
- -Wpartial-fields
- -Werror
- -O2
-
 library:
  source-dirs: lib/
+  ghc-options:
+    - -Wall
+    - -Werror
+    - -Wpartial-fields
+    - -O2

 executables:
  xmobar: &bin
@ -97,15 +53,21 @@ executables:
     - xmonad-config
    ghc-options:
      - -threaded
+      - -Wall
+      - -Werror
+      - -Wpartial-fields
+      - -O2
  xmonad: 
    <<: *bin
    main:                xmonad.hs
    ghc-options:
      - -threaded
+      - -Wall
+      - -Werror
+      - -Wpartial-fields
+      - -O2
      # this is needed to avoid writing super complex layout types
      - -fno-warn-missing-signatures
  vbox-start:
    <<: *bin
    main:                vbox-start.hs
-    ghc-options:
-      - -threaded
--- a/scripts/runtime_pkgs
+++ b/scripts/runtime_pkgs
--- a/scripts/screencap
+++ b/scripts/screencap
@ -1,22 +0,0 @@
-#! /bin/bash
-
-## capture a screenshot using scrot
-
-SS_DIR="$XDG_CACHE_HOME/screenshots"
-
-while getopts ":sw" opt; do
-	case ${opt} in
-		s)
-			scrot "$SS_DIR/desktop/%Y-%m-%d-%H:%M:%S_desktop.png"
-			notify-send "Screen captured"
-			;;
-		w)
-			scrot -u "$SS_DIR/window/%Y-%m-%d-%H:%M:%S-\$wx\$h.png"
-			notify-send "Window captured"
-			;;
-		\?)
-			echo "invalid option, read the code"
-			;;
-	esac
-done
-
--- a/scripts/screenlock
+++ b/scripts/screenlock
@ -1,61 +0,0 @@
-#! /bin/bash
-
-## lock the screen using i3lock (and maybe suspend)
-
-## usage: screenlock [SUSPEND]
-
-# WORKAROUND make the date show up in the right place on 2+ monitor setups
-# I want it to only show up on the primary screen, so use xrandr to get the
-# dimensions and position of the primary monitor and calculate the date position
-# from that
-geometry=$(xrandr | sed -n 's/^.*primary \([0-9]*\)x[0-9]*+\([0-9]\)*+[0-9]* .*/\1 \2/p')
-width=$(echo "$geometry" | cut -f1 -d" ")
-xpos=$(echo "$geometry" | cut -f2 -d" ")
-xoffset=$(("$xpos" + "$width" / 2))
-datepos="$xoffset:600"
-
-# lock and fork so we can suspend with the screen locked
-i3lock --color=000000 \
-       --pass-media-keys \
-       --nofork \
-       --ignore-empty-password \
-       --screen=0 \
-       --indicator \
-       --inside-color=00000055 \
-       --insidever-color=00000055 \
-       --insidewrong-color=00000055 \
-       --ring-color=555555ff \
-       --ringwrong-color=ff3333ff \
-       --ringver-color=99ceffff \
-       --keyhl-color=99ceffff \
-       --bshl-color=9523ffff \
-       --line-color=00000000 \
-       --separator-color=00000000 \
-       --clock \
-       --verif-color=99ceffff \
-       --wrong-color=ff8282ff \
-       --time-color=ffffffff \
-       --time-size=72 \
-       --time-str="%H:%M" \
-       --date-color=ffffffff \
-       --date-size=42 \
-       --date-str="%b %d, %Y" \
-       --date-align 0 \
-       --date-pos="$datepos" \
-       --wrong-size=72 \
-       --verif-size=72 \
-       --radius=300 \
-       --ring-width=25 &
-
-# suspend if we want, and if this machine is currently using a battery
-batpath=/sys/class/power_supply/BAT0/status
-
-if [ -f "$batpath" ] && \
-       [ "$(cat $batpath)" == "Discharging" ] && \
-       [ "$1" == "true" ]; then
-    systemctl suspend
-fi
-
-# block until the screen is unlocked (since xss-lock expects the locker to exit
-# only when unlocked)
-wait
--- a/assets/sound/smb_fireball.wav
+++ b/assets/sound/smb_fireball.wav
--- a/assets/sound/smb_pipe.wav
+++ b/assets/sound/smb_pipe.wav
--- a/assets/sound/smb_powerup.wav
+++ b/assets/sound/smb_powerup.wav
--- a/stack.yaml
+++ b/stack.yaml
@ -17,8 +17,8 @@
 #
 # resolver: ./custom-snapshot.yaml
 # resolver: https://example.com/snapshots/2018-01-01.yaml
-resolver: lts-19.33
-#resolver: nightly-2022-03-03
+#resolver: lts-17.4
+resolver: nightly-2022-03-03

 # User packages to be built.
 # Various formats can be used as shown in the example below.