rofi-extras/app/rofi-evpn.hs

147 lines
4.6 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 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
2023-02-22 23:02:04 -05:00
import Rofi.IO
2023-02-22 22:44:44 -05:00
import UnliftIO.Environment
2021-12-15 00:25:42 -05:00
main :: IO ()
2023-02-22 22:44:44 -05:00
main = runSimpleApp $ getArgs >>= runPrompt
2021-12-15 00:25:42 -05:00
2023-02-22 22:44:44 -05:00
runPrompt :: [String] -> RIO SimpleApp ()
2021-12-15 00:25:42 -05:00
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
2023-02-22 22:44:44 -05:00
getServers :: MonadIO m => m (Maybe VPNStatus)
2021-12-15 00:25:42 -05:00
getServers = do
running <- daemonIsRunning
if running
then Just <$> getStatus
2023-02-22 23:02:04 -05:00
else notifyEVPN IconError "ExpressVPN daemon not running" >> return Nothing
2021-12-15 00:25:42 -05:00
2023-02-22 22:44:44 -05:00
getStatus :: MonadIO m => m VPNStatus
2021-12-15 00:25:42 -05:00
getStatus = do
connected <- getConnectedServer
VPNStatus connected <$> getAvailableServers
2023-02-22 22:44:44 -05:00
getConnectedServer :: MonadIO m => m (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
2023-02-22 22:44:44 -05:00
getAvailableServers :: MonadIO m => m [VPNServer]
2021-12-15 00:25:42 -05:00
getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] ""
where
2023-02-13 22:19:49 -05:00
procOut Nothing = do
2023-02-22 23:02:04 -05:00
notifyEVPN IconError "failed to get list of servers"
2021-12-15 00:25:42 -05:00
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
2023-02-22 22:44:44 -05:00
daemonIsRunning :: MonadIO m => m Bool
2021-12-15 00:25:42 -05:00
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"
2023-02-22 22:44:44 -05:00
connect :: MonadIO m => VPNServer -> m ()
2021-12-15 00:25:42 -05:00
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-22 22:44:44 -05:00
disconnect :: MonadIO m => T.Text -> m 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-22 22:44:44 -05:00
readCmdSuccess' :: MonadIO m => T.Text -> [T.Text] -> m Bool
2021-12-15 00:25:42 -05:00
readCmdSuccess' cmd args = isJust <$> readCmdSuccess cmd args ""
2023-02-22 22:44:44 -05:00
notifyIf :: MonadIO m => Bool -> T.Text -> T.Text -> m ()
2023-02-22 23:02:04 -05:00
notifyIf True s _ = notifyEVPN IconInfo s
notifyIf False _ s = notifyEVPN IconError s
2021-12-15 00:25:42 -05:00
2023-02-22 23:02:04 -05:00
notifyEVPN :: MonadIO m => NotifyIcon -> T.Text -> m ()
notifyEVPN icon = notify icon "ExpressVPN" . Just