xmonad-config/lib/Xmobar/Plugins/VPN.hs

55 lines
1.4 KiB
Haskell
Raw Normal View History

2020-03-21 18:37:26 -04:00
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
2020-04-01 22:06:00 -04:00
--------------------------------------------------------------------------------
-- | VPN plugin
--
-- Use the NetworkManger interface on DBus to check status
module Xmobar.Plugins.VPN
( VPN(..)
, vpnAlias
, vpnBus
, vpnPath
) where
2020-03-21 18:37:26 -04:00
2020-03-25 18:55:52 -04:00
import DBus
import DBus.Client
2020-03-21 18:37:26 -04:00
2020-04-01 20:17:47 -04:00
import XMonad.Hooks.DynamicLog (xmobarColor)
2021-06-19 00:54:01 -04:00
import Xmobar
2020-03-21 18:37:26 -04:00
2020-03-22 17:17:57 -04:00
data VPN = VPN (String, String, String) Int
deriving (Read, Show)
2020-03-21 18:37:26 -04:00
callConnectionType :: Client -> IO (Either MethodError Variant)
callConnectionType client =
getProperty client (methodCall vpnPath
"org.freedesktop.NetworkManager" "PrimaryConnectionType")
{ methodCallDestination = Just vpnBus }
vpnBus :: BusName
vpnBus = "org.freedesktop.NetworkManager"
vpnPath :: ObjectPath
vpnPath = "/org/freedesktop/NetworkManager"
vpnAlias :: String
vpnAlias = "vpn"
2020-03-21 18:37:26 -04:00
2020-03-22 17:17:57 -04:00
instance Exec VPN where
alias (VPN _ _) = vpnAlias
2020-03-22 17:17:57 -04:00
rate (VPN _ r) = r
run (VPN (text, colorOn, colorOff) _) = do
2020-03-21 18:37:26 -04:00
client <- connectSystem
reply <- callConnectionType client
disconnect client
return $ fmtState $ procReply reply
2020-03-21 18:37:26 -04:00
where
procReply = \case
Right r -> (fromVariant r :: Maybe String)
Left _ -> Nothing
2020-03-21 18:37:26 -04:00
fmtState = \case
2020-04-01 20:17:47 -04:00
Just s -> xmobarColor (if s == "vpn" then colorOn else colorOff) "" text
2020-03-21 18:37:26 -04:00
Nothing -> "N/A"