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
|
|
|
|
|
2020-04-01 20:17:47 -04:00
|
|
|
module Xmobar.Plugins.VPN (VPN(..)) 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
|
2020-03-22 01:10:02 -04:00
|
|
|
deriving (Read, Show)
|
2020-03-21 18:37:26 -04:00
|
|
|
|
2020-03-22 01:10:02 -04:00
|
|
|
callConnectionType :: Client -> IO (Either MethodError Variant)
|
|
|
|
callConnectionType client =
|
|
|
|
getProperty client (methodCall "/org/freedesktop/NetworkManager"
|
|
|
|
"org.freedesktop.NetworkManager" "PrimaryConnectionType")
|
|
|
|
{ methodCallDestination = Just "org.freedesktop.NetworkManager" }
|
2020-03-21 18:37:26 -04:00
|
|
|
|
2020-03-22 17:17:57 -04:00
|
|
|
instance Exec VPN where
|
|
|
|
alias (VPN _ _) = "vpn"
|
|
|
|
rate (VPN _ r) = r
|
|
|
|
run (VPN (text, colorOn, colorOff) _) = do
|
2020-03-21 18:37:26 -04:00
|
|
|
client <- connectSystem
|
2020-03-22 01:10:02 -04:00
|
|
|
reply <- callConnectionType client
|
|
|
|
disconnect client
|
|
|
|
return $ fmtState $ procReply reply
|
2020-03-21 18:37:26 -04:00
|
|
|
where
|
2020-03-22 01:10:02 -04:00
|
|
|
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"
|