ADD rofi menu for expressVPN

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"

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