diff --git a/app/rofi-evpn.hs b/app/rofi-evpn.hs new file mode 100644 index 0000000..61b22cc --- /dev/null +++ b/app/rofi-evpn.hs @@ -0,0 +1,150 @@ +-------------------------------------------------------------------------------- +-- | rofi-evpn - a prompt to dicsonnect/connect with express VPN +-- + +module Main (main) where + +import Control.Monad + +import Data.List.Split +import Data.Maybe + +import Rofi.Command + +import System.Environment +import System.Process + +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 + runRofiIO (RofiVPNConf args) $ selectAction $ emptyMenu + { groups = + [ untitledGroup $ toRofiActions $ maybeToList d + , untitledGroup $ toRofiActions cs + ] + , prompt = Just "Select Action" + } + +newtype RofiVPNConf = RofiVPNConf [String] + +instance RofiConf RofiVPNConf where + defArgs (RofiVPNConf as) = as + +type VPNAction = RofiAction RofiVPNConf + +type VPNServer = (String, String) + +data VPNStatus = VPNStatus (Maybe String) [VPNServer] deriving (Show) + +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 + +getConnectedServer :: IO (Maybe String) +getConnectedServer = (procStatus =<<) <$> readCmdSuccess eVPN ["status"] "" + where + procStatus s = case words <$> lines s of + -- the output is green... + (("\ESC[1;32;49mConnected":"to":server):_) -> Just $ unwords server + _ -> Nothing + +getAvailableServers :: IO [VPNServer] +getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] "" + where + procOut Nothing = do + notify IconError "failed to get list of servers" + return [] + -- ASSUME the output has a header that has three lines, followed by the + -- stuff we care about, which is followed by a blank line (after which there + -- is other stuff that doesn't matter based on the way I'm parsing below) + procOut (Just ls) = return + $ mapMaybe (matchLine . splitOn "\t") + $ drop 3 + $ takeWhile (/= "") + $ lines ls + -- 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. + matchLine [i, _, l] = Just (i, l) + matchLine [i, _, _, l] = Just (i, l) + matchLine [i, _, _, _, l] = Just (i, l) + matchLine _ = Nothing + +daemonIsRunning :: IO Bool +daemonIsRunning = isJust <$> readCmdSuccess "pgrep" [eVPND] "" + +getDisconnectAction :: String -> VPNAction +getDisconnectAction server = + ("Disconnect from " ++ server, io $ void $ disconnect server) + +getConnectAction :: Maybe String -> VPNServer -> VPNAction +getConnectAction connected server = + (formatServerLine server, io $ go connected) + where + go (Just c) = do + success <- disconnect c + when success con + go _ = con + con = connect server + +formatServerLine :: VPNServer -> String +formatServerLine (sid, sname) = pad sid ++ " | " ++ sname + where + pad s = s ++ replicate (10 - length s) ' ' + +eVPN :: String +eVPN = "expressvpn" + +eVPND :: String +eVPND = "expressvpnd" + +connect :: VPNServer -> IO () +connect (sid, sname) = do + res <- readCmdSuccess' eVPN ["connect", sid] + notifyIf res ("connected to " ++ sname) + ("failed to connect to " ++ sname) + +disconnect :: String -> IO Bool +disconnect server = do + res <- readCmdSuccess' eVPN ["disconnect"] + notifyIf res ("disconnected from " ++ server) + ("failed to disconnect from " ++ server) + return res + +readCmdSuccess' :: String -> [String] -> IO Bool +readCmdSuccess' cmd args = isJust <$> readCmdSuccess cmd args "" + +-- TODO not DRY +data NotifyIcon = IconError | IconInfo + +instance Show NotifyIcon where + show IconError = "dialog-error-symbolic" + show IconInfo = "dialog-information-symbolic" + +notifyIf :: Bool -> String -> String -> IO () +notifyIf True s _ = notify IconInfo s +notifyIf False _ s = notify IconError s + +notify :: NotifyIcon -> String -> IO () +notify icon body = void $ spawnProcess "notify-send" $ args ++ [body] + where + args = ["-i", show icon, summary] + summary = "ExpressVPN" diff --git a/package.yaml b/package.yaml index b647285..541dad0 100644 --- a/package.yaml +++ b/package.yaml @@ -101,6 +101,16 @@ executables: dependencies: - rofi-extras + rofi-evpn: + main: rofi-evpn.hs + source-dirs: app + ghc-options: + - -Wall + - -Werror + - -threaded + dependencies: + - rofi-extras + current-output: main: current-output.hs source-dirs: app