rofi-extras/app/rofi-evpn.hs

158 lines
4.7 KiB
Haskell
Raw Normal View History

2021-12-15 00:25:42 -05:00
--------------------------------------------------------------------------------
2023-02-13 22:19:49 -05:00
-- rofi-evpn - a prompt to dicsonnect/connect with express VPN
2021-12-15 00:25:42 -05:00
--
module Main (main) where
2023-02-13 22:19:49 -05:00
import Data.Maybe
import RIO
2023-02-13 23:31:50 -05:00
import qualified RIO.Text as T
2023-02-13 22:19:49 -05:00
import Rofi.Command
import System.Environment
import System.Process
2021-12-15 00:25:42 -05:00
main :: IO ()
main = getArgs >>= runPrompt
runPrompt :: [String] -> IO ()
runPrompt args = do
servers <- getServers
maybe (return ()) run servers
where
run (VPNStatus connected servers) = do
let d = getDisconnectAction <$> connected
let cs = fmap (getConnectAction connected) servers
2023-02-14 22:28:26 -05:00
runRofi (RofiVPNConf $ fmap T.pack args) $
emptyMenu
{ groups =
[ untitledGroup $ toRofiActions $ maybeToList d
, untitledGroup $ toRofiActions cs
]
, prompt = Just "Select Action"
}
2021-12-15 00:25:42 -05:00
2023-02-13 23:31:50 -05:00
newtype RofiVPNConf = RofiVPNConf [T.Text]
2021-12-15 00:25:42 -05:00
2023-02-14 22:28:26 -05:00
instance HasRofiConf RofiVPNConf where
2021-12-15 00:25:42 -05:00
defArgs (RofiVPNConf as) = as
type VPNAction = RofiAction RofiVPNConf
2023-02-13 23:31:50 -05:00
type VPNServer = (T.Text, T.Text)
2021-12-15 00:25:42 -05:00
2023-02-13 23:31:50 -05:00
data VPNStatus = VPNStatus (Maybe T.Text) [VPNServer] deriving (Show)
2021-12-15 00:25:42 -05:00
getServers :: IO (Maybe VPNStatus)
getServers = do
running <- daemonIsRunning
if running
then Just <$> getStatus
else notify IconError "ExpressVPN daemon not running" >> return Nothing
getStatus :: IO VPNStatus
getStatus = do
connected <- getConnectedServer
VPNStatus connected <$> getAvailableServers
2023-02-13 23:31:50 -05:00
getConnectedServer :: IO (Maybe T.Text)
2021-12-15 00:25:42 -05:00
getConnectedServer = (procStatus =<<) <$> readCmdSuccess eVPN ["status"] ""
where
2023-02-13 23:31:50 -05:00
procStatus = listToMaybe . mapMaybe procLine . T.lines
procLine l = case T.words l of
2021-12-15 00:25:42 -05:00
-- the output is green...
2023-02-13 23:31:50 -05:00
("\ESC[1;32;49mConnected" : "to" : server) -> Just $ T.unwords server
2023-02-13 22:19:49 -05:00
_ -> Nothing
2021-12-15 00:25:42 -05:00
getAvailableServers :: IO [VPNServer]
getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] ""
where
2023-02-13 22:19:49 -05:00
procOut Nothing = do
2021-12-15 00:25:42 -05:00
notify IconError "failed to get list of servers"
return []
-- ASSUME the output has a useless header that ends in a line that starts
-- with "-----", after which is the stuff we care about, which is followed
-- by a blank line, after which there is more stuff I don't care about
2023-02-13 22:19:49 -05:00
procOut (Just ls) =
return $
2023-02-13 23:31:50 -05:00
mapMaybe (matchLine . T.split (== '\t')) $
2023-02-13 22:19:49 -05:00
takeWhile (/= "") $
drop 1
-- super lame way of matching lines that start with "-----"
$
2023-02-13 23:31:50 -05:00
dropWhile (not . T.isPrefixOf "-----") $
T.lines ls
2021-12-15 00:25:42 -05:00
-- The output of this command is very strange; it is delimited (kinda) by
-- tabs but some lines are long enough that they don't have a tab. In
-- whatever case, splitting by tabs leads to variable length lists, and the
-- id is always at the front and the location is always at the end. These
-- should handle all cases.
2023-02-13 22:19:49 -05:00
matchLine [i, _, l] = Just (i, l)
matchLine [i, _, _, l] = Just (i, l)
2021-12-15 00:25:42 -05:00
matchLine [i, _, _, _, l] = Just (i, l)
2023-02-13 22:19:49 -05:00
matchLine _ = Nothing
2021-12-15 00:25:42 -05:00
daemonIsRunning :: IO Bool
daemonIsRunning = isJust <$> readCmdSuccess "pgrep" [eVPND] ""
2023-02-13 23:31:50 -05:00
getDisconnectAction :: T.Text -> VPNAction
2021-12-15 00:25:42 -05:00
getDisconnectAction server =
2023-02-13 23:31:50 -05:00
(T.append "Disconnect from " server, io $ void $ disconnect server)
2021-12-15 00:25:42 -05:00
2023-02-13 23:31:50 -05:00
getConnectAction :: Maybe T.Text -> VPNServer -> VPNAction
2021-12-15 00:25:42 -05:00
getConnectAction connected server =
(formatServerLine server, io $ go connected)
where
go (Just c) = do
success <- disconnect c
when success con
go _ = con
con = connect server
2023-02-13 23:31:50 -05:00
formatServerLine :: VPNServer -> T.Text
formatServerLine (sid, sname) = T.concat [pad sid, " | ", sname]
2021-12-15 00:25:42 -05:00
where
2023-02-13 23:31:50 -05:00
pad s = T.append s $ T.replicate (10 - T.length s) " "
2021-12-15 00:25:42 -05:00
2023-02-13 23:31:50 -05:00
eVPN :: T.Text
2021-12-15 00:25:42 -05:00
eVPN = "expressvpn"
2023-02-13 23:31:50 -05:00
eVPND :: T.Text
2021-12-15 00:25:42 -05:00
eVPND = "expressvpnd"
connect :: VPNServer -> IO ()
connect (sid, sname) = do
res <- readCmdSuccess' eVPN ["connect", sid]
2023-02-13 22:19:49 -05:00
notifyIf
res
2023-02-13 23:31:50 -05:00
(T.append "connected to " sname)
(T.append "failed to connect to " sname)
2021-12-15 00:25:42 -05:00
2023-02-13 23:31:50 -05:00
disconnect :: T.Text -> IO Bool
2021-12-15 00:25:42 -05:00
disconnect server = do
res <- readCmdSuccess' eVPN ["disconnect"]
2023-02-13 22:19:49 -05:00
notifyIf
res
2023-02-13 23:31:50 -05:00
(T.append "disconnected from " server)
(T.append "failed to disconnect from " server)
2021-12-15 00:25:42 -05:00
return res
2023-02-13 23:31:50 -05:00
readCmdSuccess' :: T.Text -> [T.Text] -> IO Bool
2021-12-15 00:25:42 -05:00
readCmdSuccess' cmd args = isJust <$> readCmdSuccess cmd args ""
-- TODO not DRY
data NotifyIcon = IconError | IconInfo
instance Show NotifyIcon where
show IconError = "dialog-error-symbolic"
2023-02-13 22:19:49 -05:00
show IconInfo = "dialog-information-symbolic"
2021-12-15 00:25:42 -05:00
2023-02-13 23:31:50 -05:00
notifyIf :: Bool -> T.Text -> T.Text -> IO ()
2023-02-13 22:19:49 -05:00
notifyIf True s _ = notify IconInfo s
2021-12-15 00:25:42 -05:00
notifyIf False _ s = notify IconError s
2023-02-13 23:31:50 -05:00
notify :: NotifyIcon -> T.Text -> IO ()
notify icon body = void $ spawnProcess "notify-send" $ args ++ [T.unpack body]
2021-12-15 00:25:42 -05:00
where
args = ["-i", show icon, summary]
summary = "ExpressVPN"