ndwarshuis
/
rofi-extras
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

REF use text everywhere

This commit is contained in:
Nathan Dwarshuis 2023-02-13 23:31:50 -05:00
parent 4265a5947c
commit 09ce10a942
9 changed files with 261 additions and 259 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
app/pinentry-rofi.hs
View File

@ -23,7 +23,7 @@ main = do
TI.putStrLn "OK Pleased to meet you" TI.putStrLn "OK Pleased to meet you"
pinentryLoop =<< readPinConf pinentryLoop =<< readPinConf
newtype PinConf = PinConf {pcBwName :: String} deriving (Eq, Show) newtype PinConf = PinConf {pcBwName :: T.Text} deriving (Eq, Show)
instance FromJSON PinConf where instance FromJSON PinConf where
parseJSON (Object o) = PinConf <$> o .:? "bitwarden-name" .!= "gnupg" parseJSON (Object o) = PinConf <$> o .:? "bitwarden-name" .!= "gnupg"
@ -72,7 +72,7 @@ unknownCommand c = TI.putStrLn $ T.append "ERR 275 Unknown command " c
getPin :: PinConf -> IO () getPin :: PinConf -> IO ()
getPin p = do getPin p = do
its <- getItems its <- getItems
let w = (fmap T.pack . password . login) =<< L.find (\i -> pcBwName p == name i) its let w = (password . login) =<< L.find (\i -> pcBwName p == name i) its
maybe err send w maybe err send w
where where
err = TI.putStrLn "ERR 83886179 Operation canceled <rofi>" err = TI.putStrLn "ERR 83886179 Operation canceled <rofi>"

20
app/rofi-autorandr.hs
View File

@ -30,14 +30,14 @@ checkExe cmd = do
TI.putStrLn $ T.append "Could not find executable: " $ T.pack cmd TI.putStrLn $ T.append "Could not find executable: " $ T.pack cmd
exitWith $ ExitFailure 1 exitWith $ ExitFailure 1
newtype ARClientConf = ARClientConf [String] newtype ARClientConf = ARClientConf [T.Text]
instance RofiConf ARClientConf where instance RofiConf ARClientConf where
defArgs (ARClientConf a) = a defArgs (ARClientConf a) = a
runPrompt :: [String] -> IO () runPrompt :: [String] -> IO ()
runPrompt a = do runPrompt a = do
let c = ARClientConf a let c = ARClientConf $ fmap T.pack a
staticProfs <- getAutoRandrProfiles staticProfs <- getAutoRandrProfiles
runRofiIO c $ runRofiIO c $
selectAction $ selectAction $
@ -49,19 +49,19 @@ runPrompt a = do
mkGroup header = mkGroup header =
titledGroup header titledGroup header
. toRofiActions . toRofiActions
. fmap (\s -> (" " ++ s, selectProfile $ T.pack s)) . fmap (\s -> (T.append " " s, selectProfile s))
virtProfs :: [String] virtProfs :: [T.Text]
virtProfs = ["off", "common", "clone-largest", "horizontal", "vertical"] virtProfs = ["off", "common", "clone-largest", "horizontal", "vertical"]
-- TODO filter profiles based on which xrandr outputs are actually connected -- TODO filter profiles based on which xrandr outputs are actually connected
getAutoRandrProfiles :: IO [String] getAutoRandrProfiles :: IO [T.Text]
getAutoRandrProfiles = do getAutoRandrProfiles = do
dir <- getAutoRandrDir dir <- getAutoRandrDir
contents <- listDirectory dir contents <- listDirectory dir
filterM (doesDirectoryExist . (dir </>)) contents (fmap T.pack) <$> filterM (doesDirectoryExist . (dir </>)) contents
getAutoRandrDir :: IO String getAutoRandrDir :: IO FilePath
getAutoRandrDir = do getAutoRandrDir = do
c <- getXdgDirectory XdgConfig "autorandr" c <- getXdgDirectory XdgConfig "autorandr"
e <- doesDirectoryExist c e <- doesDirectoryExist c
@ -70,6 +70,6 @@ getAutoRandrDir = do
appendToHome p = (</> p) <$> getHomeDirectory appendToHome p = (</> p) <$> getHomeDirectory
selectProfile :: T.Text -> RofiIO ARClientConf () selectProfile :: T.Text -> RofiIO ARClientConf ()
selectProfile name = do selectProfile name = liftIO $ do
io $ TI.putStrLn name TI.putStrLn name
io $ void $ spawnProcess "autorandr" ["--change", T.unpack name] void $ spawnProcess "autorandr" ["--change", T.unpack name]

29
app/rofi-bt.hs
View File

@ -6,7 +6,6 @@ module Main (main) where
import DBus import DBus
import DBus.Client import DBus.Client
import Data.List.Split
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe import Data.Maybe
import qualified Data.Text.IO as TI import qualified Data.Text.IO as TI
@ -19,7 +18,7 @@ import System.Environment
main :: IO () main :: IO ()
main = getArgs >>= runPrompt main = getArgs >>= runPrompt
data RofiBTConf = RofiBTConf [String] ObjectPath data RofiBTConf = RofiBTConf [T.Text] ObjectPath
instance RofiConf RofiBTConf where instance RofiConf RofiBTConf where
defArgs (RofiBTConf as _) = as defArgs (RofiBTConf as _) = as
@ -37,7 +36,7 @@ runPrompt args = do
getAdapter paths getAdapter paths
actions client paths adapter = do actions client paths adapter = do
ras <- getRofiActions client paths ras <- getRofiActions client paths
runRofiIO (RofiBTConf args adapter) $ runRofiIO (RofiBTConf (fmap T.pack args) adapter) $
selectAction $ selectAction $
emptyMenu emptyMenu
{ groups = [untitledGroup $ toRofiActions ras] { groups = [untitledGroup $ toRofiActions ras]
@ -78,8 +77,8 @@ powerAdapterMaybe client = do
-- the 'Set' method -- the 'Set' method
value = toVariant $ toVariant True value = toVariant $ toVariant True
formatDeviceEntry :: Bool -> String -> String formatDeviceEntry :: Bool -> T.Text -> T.Text
formatDeviceEntry connected name = unwords [prefix connected, name] formatDeviceEntry connected name = T.unwords [prefix connected, name]
where where
prefix True = "#" prefix True = "#"
prefix False = " " prefix False = " "
@ -90,7 +89,7 @@ getAdapter = L.find pathIsAdaptor
getDevices :: Client -> [ObjectPath] -> IO [ObjectPath] getDevices :: Client -> [ObjectPath] -> IO [ObjectPath]
getDevices client = filterM (getDevicePaired client) . filter pathIsDevice getDevices client = filterM (getDevicePaired client) . filter pathIsDevice
type ObjectTree = M.Map ObjectPath (M.Map String (M.Map String Variant)) type ObjectTree = M.Map ObjectPath (M.Map T.Text (M.Map T.Text Variant))
getObjectTree :: Client -> IO ObjectTree getObjectTree :: Client -> IO ObjectTree
getObjectTree client = getObjectTree client =
@ -104,7 +103,7 @@ getObjectTree client =
getDeviceConnected :: Client -> ObjectPath -> IO (Maybe Bool) getDeviceConnected :: Client -> ObjectPath -> IO (Maybe Bool)
getDeviceConnected = getDevProperty "Connected" getDeviceConnected = getDevProperty "Connected"
getDeviceName :: Client -> ObjectPath -> IO (Maybe String) getDeviceName :: Client -> ObjectPath -> IO (Maybe T.Text)
getDeviceName = getDevProperty "Name" getDeviceName = getDevProperty "Name"
getDevicePaired :: Client -> ObjectPath -> IO Bool getDevicePaired :: Client -> ObjectPath -> IO Bool
@ -126,24 +125,24 @@ pathIsDevice o = case splitPath o of
[a, b, c, _] -> pathIsAdaptorPrefix a b c [a, b, c, _] -> pathIsAdaptorPrefix a b c
_ -> False _ -> False
pathIsAdaptorPrefix :: String -> String -> String -> Bool pathIsAdaptorPrefix :: T.Text -> T.Text -> T.Text -> Bool
pathIsAdaptorPrefix a b c = a == "org" && b == "bluez" && "hci" `L.isPrefixOf` c pathIsAdaptorPrefix a b c = a == "org" && b == "bluez" && "hci" `T.isPrefixOf` c
splitPath :: ObjectPath -> [String] splitPath :: ObjectPath -> [T.Text]
splitPath = splitOn "/" . dropWhile (== '/') . formatObjectPath splitPath = T.split (== '/') . T.dropWhile (== '/') . T.pack . formatObjectPath
getClient :: IO (Maybe Client) getClient :: IO (Maybe Client)
getClient = either warn (return . Just) =<< try connectSystem getClient = either warn (return . Just) =<< try connectSystem
where where
warn e = TI.putStrLn (T.pack $ clientErrorMessage e) >> return Nothing warn e = TI.putStrLn (T.pack $ clientErrorMessage e) >> return Nothing
callDevMethod :: String -> Client -> ObjectPath -> IO () callDevMethod :: T.Text -> Client -> ObjectPath -> IO ()
callDevMethod mem client dev = callDevMethod mem client dev =
void $ callBTMethod client dev btDevInterface $ memberName_ mem void $ callBTMethod client dev btDevInterface $ memberName_ $ T.unpack mem
getDevProperty :: IsVariant a => String -> Client -> ObjectPath -> IO (Maybe a) getDevProperty :: IsVariant a => T.Text -> Client -> ObjectPath -> IO (Maybe a)
getDevProperty mem client dev = getDevProperty mem client dev =
getBTProperty client dev btDevInterface $ memberName_ mem getBTProperty client dev btDevInterface $ memberName_ $ T.unpack mem
callBTMethod callBTMethod
:: Client :: Client

3
app/rofi-bw.hs
View File

@ -30,13 +30,12 @@ main = runChecks >> getArgs >>= parse
-- TODO check if daemon is running when running client -- TODO check if daemon is running when running client
parse :: [String] -> IO () parse :: [String] -> IO ()
parse ["-d", t] = case readMaybe t of Just t' -> runDaemon t'; _ -> usage parse ["-d", t] = case readMaybe t of Just t' -> runDaemon t'; _ -> usage
parse ("-c" : args) = runClient args parse ("-c" : args) = runClient $ fmap T.pack args
parse _ = usage parse _ = usage
usage :: IO () usage :: IO ()
usage = usage =
TI.putStrLn $ TI.putStrLn $
T.pack $
joinNewline joinNewline
[ "daemon mode: rofi-bw -d TIMEOUT" [ "daemon mode: rofi-bw -d TIMEOUT"
, "client mode: rofi-bw -c [ROFI-ARGS]" , "client mode: rofi-bw -c [ROFI-ARGS]"

221
app/rofi-dev.hs
View File

@ -11,7 +11,6 @@
module Main (main) where module Main (main) where
import Bitwarden.Internal import Bitwarden.Internal
import Data.List.Split (splitOn)
import qualified Data.Text.IO as TI import qualified Data.Text.IO as TI
import Data.Typeable import Data.Typeable
import Dhall hiding (maybe, sequence, void) import Dhall hiding (maybe, sequence, void)
@ -29,14 +28,13 @@ import System.Environment
import System.FilePath.Posix import System.FilePath.Posix
import System.Posix.User (getEffectiveUserName) import System.Posix.User (getEffectiveUserName)
import System.Process import System.Process
import Text.Printf
main :: IO () main :: IO ()
main = getArgs >>= parse main = getArgs >>= parse
parse :: [String] -> IO () parse :: [String] -> IO ()
parse args = case getOpt Permute options args of parse args = case getOpt Permute options args of
(o, n, []) -> runMounts $ L.foldl (flip id) (defaultOpts n) o (o, n, []) -> runMounts $ L.foldl (flip id) (defaultOpts (fmap T.pack n)) o
(_, _, errs) -> TI.putStrLn $ T.pack $ concat errs ++ usageInfo h options (_, _, errs) -> TI.putStrLn $ T.pack $ concat errs ++ usageInfo h options
where where
h = "Usage: rofi-dev [OPTIONS] [-- ROFI-OPTIONS]" h = "Usage: rofi-dev [OPTIONS] [-- ROFI-OPTIONS]"
@ -58,7 +56,7 @@ options =
, Option , Option
['m'] ['m']
["mount"] ["mount"]
(ReqArg (\s m -> m {optsAlias = Just s}) "ALIAS") (ReqArg (\s m -> m {optsAlias = Just $ T.pack s}) "ALIAS")
"Mount the device specified by ALIAS directly" "Mount the device specified by ALIAS directly"
, Option , Option
['u'] ['u']
@ -69,9 +67,9 @@ options =
data Opts = Opts data Opts = Opts
{ optsConfig :: Maybe FilePath { optsConfig :: Maybe FilePath
, optsAlias :: Maybe String , optsAlias :: Maybe T.Text
, optsUnmount :: Bool , optsUnmount :: Bool
, optsRofiArgs :: [String] , optsRofiArgs :: [T.Text]
} }
deriving (Show) deriving (Show)
@ -163,31 +161,31 @@ dismountAll = do
umount :: Mountable a => [a] -> RofiMountIO () umount :: Mountable a => [a] -> RofiMountIO ()
umount = mapM_ (`mountMaybe` True) umount = mapM_ (`mountMaybe` True)
mountByAlias :: Bool -> String -> RofiMountIO () mountByAlias :: Bool -> T.Text -> RofiMountIO ()
mountByAlias unmountFlag alias = do mountByAlias unmountFlag alias = do
static <- asks mountconfStaticDevs static <- asks mountconfStaticDevs
mapM_ (`mountMaybe` unmountFlag) $ configToTree static <$> M.lookup alias static mapM_ (`mountMaybe` unmountFlag) $ configToTree static <$> M.lookup alias static
mkGroup :: [(Header, ProtoAction [String])] -> Maybe (RofiGroup MountConf) mkGroup :: [(Header, ProtoAction [T.Text])] -> Maybe (RofiGroup MountConf)
mkGroup [] = Nothing mkGroup [] = Nothing
mkGroup as = mkGroup as =
let ((h, _) : _) = as let ((h, _) : _) = as
in Just $ titledGroup (show h) $ toRofiActions $ alignEntries $ fmap snd as in Just $ titledGroup (T.pack $ show h) $ toRofiActions $ alignEntries $ fmap snd as
alignSep :: String alignSep :: T.Text
alignSep = " | " alignSep = " | "
alignEntries :: [ProtoAction [String]] -> [(String, RofiMountIO ())] alignEntries :: [ProtoAction [T.Text]] -> [(T.Text, RofiMountIO ())]
alignEntries ps = zip (align es) as alignEntries ps = zip (align es) as
where where
(es, as) = L.unzip $ fmap (\(ProtoAction e a) -> (e, a)) ps (es, as) = L.unzip $ fmap (\(ProtoAction e a) -> (e, a)) ps
align = align =
fmap (L.intercalate alignSep) fmap (T.intercalate alignSep)
. L.transpose . L.transpose
. mapToLast pad . mapToLast pad
. L.transpose . L.transpose
pad xs = let m = getMax xs in fmap (\x -> take m (x ++ L.repeat ' ')) xs pad xs = let m = getMax xs in fmap (\x -> T.append x (T.replicate (m - T.length x) " ")) xs
getMax = LP.maximum . fmap length getMax = LP.maximum . fmap T.length
mapToLast _ [] = [] mapToLast _ [] = []
mapToLast _ [x] = [x] mapToLast _ [x] = [x]
mapToLast f (x : xs) = f x : mapToLast f xs mapToLast f (x : xs) = f x : mapToLast f xs
@ -197,8 +195,8 @@ alignEntries ps = zip (align es) as
data MountConf = MountConf data MountConf = MountConf
{ mountconfVolatilePath :: FilePath { mountconfVolatilePath :: FilePath
, mountconfRofiArgs :: [String] , mountconfRofiArgs :: [T.Text]
, mountconfStaticDevs :: M.Map String TreeConfig , mountconfStaticDevs :: M.Map T.Text TreeConfig
, mountconfVerbose :: Bool , mountconfVerbose :: Bool
} }
deriving (Show) deriving (Show)
@ -229,13 +227,13 @@ class Mountable a where
then (io . notifyMountResult mounted (getLabel dev)) =<< mount dev mountFlag then (io . notifyMountResult mounted (getLabel dev)) =<< mount dev mountFlag
else when verbose notify' else when verbose notify'
where where
notify' = io $ notify IconInfo (getLabel dev ++ " already mounted") Nothing notify' = io $ notify IconInfo (T.append (getLabel dev) " already mounted") Nothing
-- | Check if the mounting utilities are present -- | Check if the mounting utilities are present
allInstalled :: a -> RofiMountIO Bool allInstalled :: a -> RofiMountIO Bool
-- | Return a string representing the label of the device -- | Return a string representing the label of the device
getLabel :: a -> String getLabel :: a -> T.Text
-- | Determine if the given type is mounted or not -- | Determine if the given type is mounted or not
isMounted :: a -> RofiMountIO Bool isMounted :: a -> RofiMountIO Bool
@ -254,21 +252,21 @@ class Mountable a where
class Mountable a => Actionable a where class Mountable a => Actionable a where
-- | Return a string to go in the Rofi menu for the given type -- | Return a string to go in the Rofi menu for the given type
fmtEntry :: a -> [String] fmtEntry :: a -> [T.Text]
fmtEntry d = [getLabel d] fmtEntry d = [getLabel d]
groupHeader :: a -> Header groupHeader :: a -> Header
-- | Given a mountable type, return a rofi action (string to go in the -- | Given a mountable type, return a rofi action (string to go in the
-- Rofi prompt and an action to perform when it is selected) -- Rofi prompt and an action to perform when it is selected)
mkAction :: a -> RofiMountIO (Header, ProtoAction [String]) mkAction :: a -> RofiMountIO (Header, ProtoAction [T.Text])
mkAction dev = do mkAction dev = do
m <- mountState dev m <- mountState dev
i <- allInstalled dev i <- allInstalled dev
let h = groupHeader dev let h = groupHeader dev
let action = when i $ mountMaybe dev $ mountedState m let action = when i $ mountMaybe dev $ mountedState m
let entry = case fmtEntry dev of let entry = case fmtEntry dev of
(e : es) -> (mountedPrefix m i ++ e) : es (e : es) -> (T.append (mountedPrefix m i) e) : es
_ -> [] _ -> []
return (h, ProtoAction entry action) return (h, ProtoAction entry action)
where where
@ -280,7 +278,7 @@ class Mountable a => Actionable a where
mountableToAction mountableToAction
:: Actionable a :: Actionable a
=> RofiMountIO [a] => RofiMountIO [a]
-> RofiMountIO [(Header, ProtoAction [String])] -> RofiMountIO [(Header, ProtoAction [T.Text])]
mountableToAction ms = mapM mkAction =<< ms mountableToAction ms = mapM mkAction =<< ms
type RofiMountIO a = RofiIO MountConf a type RofiMountIO a = RofiIO MountConf a
@ -314,18 +312,18 @@ data ProtoAction a = ProtoAction a (RofiMountIO ())
data MountConfig = MountConfig data MountConfig = MountConfig
{ mpPath :: FilePath { mpPath :: FilePath
, mpLabel :: Maybe String , mpLabel :: Maybe T.Text
} }
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
data BitwardenConfig = BitwardenConfig data BitwardenConfig = BitwardenConfig
{ bwKey :: String { bwKey :: T.Text
, bwTries :: Integer , bwTries :: Integer
} }
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
newtype SecretConfig = SecretConfig newtype SecretConfig = SecretConfig
{secretAttributes :: M.Map String String} {secretAttributes :: M.Map T.Text T.Text}
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
newtype PromptConfig = PromptConfig newtype PromptConfig = PromptConfig
@ -339,11 +337,11 @@ data PasswordConfig
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
data CIFSOpts = CIFSOpts data CIFSOpts = CIFSOpts
{ cifsoptsUsername :: Maybe String { cifsoptsUsername :: Maybe T.Text
, cifsoptsWorkgroup :: Maybe String , cifsoptsWorkgroup :: Maybe T.Text
, cifsoptsUID :: Maybe Integer , cifsoptsUID :: Maybe Integer
, cifsoptsGID :: Maybe Integer , cifsoptsGID :: Maybe Integer
, cifsoptsIocharset :: Maybe String , cifsoptsIocharset :: Maybe T.Text
} }
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
@ -354,19 +352,19 @@ data DataConfig
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
data VeracryptData = VeracryptData data VeracryptData = VeracryptData
{ vcVolume :: String { vcVolume :: T.Text
, vcPassword :: Maybe PasswordConfig , vcPassword :: Maybe PasswordConfig
} }
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
data SSHFSData = SSHFSData data SSHFSData = SSHFSData
{ sshfsRemote :: String { sshfsRemote :: T.Text
, sshfsPassword :: Maybe PasswordConfig , sshfsPassword :: Maybe PasswordConfig
} }
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
data CIFSData = CIFSData data CIFSData = CIFSData
{ cifsRemote :: String { cifsRemote :: T.Text
, cifsSudo :: Bool , cifsSudo :: Bool
, cifsPassword :: Maybe PasswordConfig , cifsPassword :: Maybe PasswordConfig
, cifsOpts :: Maybe CIFSOpts , cifsOpts :: Maybe CIFSOpts
@ -381,14 +379,14 @@ data DeviceConfig = DeviceConfig
data TreeConfig = TreeConfig data TreeConfig = TreeConfig
{ tcParent :: DeviceConfig { tcParent :: DeviceConfig
, tcChildren :: V.Vector String , tcChildren :: V.Vector T.Text
} }
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
data StaticConfig = StaticConfig data StaticConfig = StaticConfig
{ scTmpPath :: Maybe String { scTmpPath :: Maybe FilePath
, scVerbose :: Maybe Bool , scVerbose :: Maybe Bool
, scDevices :: M.Map String TreeConfig , scDevices :: M.Map T.Text TreeConfig
} }
deriving (Show, Generic, FromDhall) deriving (Show, Generic, FromDhall)
@ -430,10 +428,10 @@ instance Actionable (Tree DeviceConfig) where
SSHFSConfig {} -> SSHFSHeader SSHFSConfig {} -> SSHFSHeader
VeracryptConfig {} -> VeracryptHeader VeracryptConfig {} -> VeracryptHeader
configToTree' :: M.Map String TreeConfig -> [StaticConfigTree] configToTree' :: M.Map T.Text TreeConfig -> [StaticConfigTree]
configToTree' devMap = configToTree devMap <$> M.elems devMap configToTree' devMap = configToTree devMap <$> M.elems devMap
configToTree :: M.Map String TreeConfig -> TreeConfig -> StaticConfigTree configToTree :: M.Map T.Text TreeConfig -> TreeConfig -> StaticConfigTree
configToTree devMap TreeConfig {tcParent = p, tcChildren = c} = configToTree devMap TreeConfig {tcParent = p, tcChildren = c} =
Tree p $ fmap go V.toList c Tree p $ fmap go V.toList c
where where
@ -476,9 +474,9 @@ instance Mountable DeviceConfig where
mount DeviceConfig {deviceMount = m, deviceData = d} True = do mount DeviceConfig {deviceMount = m, deviceData = d} True = do
m' <- getAbsMountpoint m m' <- getAbsMountpoint m
runAndRemoveDir m' $ io $ case d of runAndRemoveDir m' $ io $ case d of
CIFSConfig (CIFSData {cifsSudo = s}) -> runMountSudoMaybe s "umount" [m'] CIFSConfig (CIFSData {cifsSudo = s}) -> runMountSudoMaybe s "umount" [T.pack m']
VeracryptConfig _ -> runVeraCrypt ["-d", m'] "" VeracryptConfig _ -> runVeraCrypt ["-d", T.pack m'] ""
_ -> runMount "umount" [m'] "" _ -> runMount "umount" [T.pack m'] ""
allInstalled DeviceConfig {deviceData = devData} = allInstalled DeviceConfig {deviceData = devData} =
io $ io $
@ -500,17 +498,17 @@ instance Mountable DeviceConfig where
getLabel getLabel
DeviceConfig DeviceConfig
{ deviceMount = MountConfig {mpPath = p, mpLabel = l} { deviceMount = MountConfig {mpPath = p, mpLabel = l}
} = fromMaybe (takeFileName p) l } = fromMaybe (T.pack $ takeFileName p) l
mountSSHFS :: FilePath -> Maybe PasswordConfig -> String -> IO MountResult mountSSHFS :: FilePath -> Maybe PasswordConfig -> T.Text -> IO MountResult
mountSSHFS mountpoint pwdConfig remote = mountSSHFS mountpoint pwdConfig remote =
withPasswordGetter pwdConfig (run ["-o", "password_stdin"]) $ run [] "" withPasswordGetter pwdConfig (run ["-o", "password_stdin"]) $ run [] ""
where where
run other = runMount "sshfs" (other ++ [remote, mountpoint]) run other = runMount "sshfs" (other ++ [remote, T.pack mountpoint])
mountCIFS mountCIFS
:: Bool :: Bool
-> String -> T.Text
-> FilePath -> FilePath
-> Maybe CIFSOpts -> Maybe CIFSOpts
-> Maybe PasswordConfig -> Maybe PasswordConfig
@ -520,30 +518,30 @@ mountCIFS useSudo remote mountpoint opts pwdConfig =
where where
run = runMountSudoMaybe useSudo "mount.cifs" args run = runMountSudoMaybe useSudo "mount.cifs" args
runPwd p = runMountSudoMaybe' useSudo "mount.cifs" args [("PASSWD", p)] runPwd p = runMountSudoMaybe' useSudo "mount.cifs" args [("PASSWD", p)]
args = [remote, mountpoint] ++ maybe [] (\o -> ["-o", fromCIFSOpts o]) opts args = [remote, T.pack mountpoint] ++ maybe [] (\o -> ["-o", fromCIFSOpts o]) opts
fromCIFSOpts :: CIFSOpts -> String fromCIFSOpts :: CIFSOpts -> T.Text
fromCIFSOpts o = L.intercalate "," $ mapMaybe concatMaybe fs fromCIFSOpts o = T.intercalate "," $ mapMaybe concatMaybe fs
where where
fs = fs =
[ ("username", cifsoptsUsername) [ ("username", cifsoptsUsername)
, ("workgroup", cifsoptsWorkgroup) , ("workgroup", cifsoptsWorkgroup)
, ("uid", fmap show . cifsoptsUID) , ("uid", fmap (T.pack . show) . cifsoptsUID)
, ("gid", fmap show . cifsoptsGID) , ("gid", fmap (T.pack . show) . cifsoptsGID)
, ("iocharset", cifsoptsIocharset) , ("iocharset", cifsoptsIocharset)
] ]
concatMaybe (k, f) = (\v -> k ++ "=" ++ v) <$> f o concatMaybe (k, f) = (\v -> T.concat [k, "=", v]) <$> f o
mountVeracrypt :: FilePath -> Maybe PasswordConfig -> String -> IO MountResult mountVeracrypt :: FilePath -> Maybe PasswordConfig -> T.Text -> IO MountResult
mountVeracrypt mountpoint pwdConfig volume = mountVeracrypt mountpoint pwdConfig volume =
withPasswordGetter pwdConfig (runVeraCrypt (args ++ ["--stdin"])) $ withPasswordGetter pwdConfig (runVeraCrypt (args ++ ["--stdin"])) $
runVeraCrypt args "" runVeraCrypt args ""
where where
args = [volume, mountpoint] args = [volume, T.pack mountpoint]
-- NOTE: the user is assumed to have added themselves to the sudoers file so -- NOTE: the user is assumed to have added themselves to the sudoers file so
-- that this command will work -- that this command will work
runVeraCrypt :: [String] -> String -> IO MountResult runVeraCrypt :: [T.Text] -> T.Text -> IO MountResult
runVeraCrypt args = runMount "sudo" (defaultArgs ++ args) runVeraCrypt args = runMount "sudo" (defaultArgs ++ args)
where where
defaultArgs = ["/usr/bin/veracrypt", "--text", "--non-interactive"] defaultArgs = ["/usr/bin/veracrypt", "--text", "--non-interactive"]
@ -560,29 +558,29 @@ veracryptMountState mc = do
where where
-- TODO don't hardcode the tmp directory -- TODO don't hardcode the tmp directory
auxPath = fmap (\i -> "/tmp/.veracrypt_aux_mnt" ++ [i]) . vcIndex auxPath = fmap (\i -> "/tmp/.veracrypt_aux_mnt" ++ [i]) . vcIndex
vcIndex spec = case reverse spec of vcIndex spec = case T.uncons $ T.reverse spec of
-- TODO what if I have more than one digit? -- TODO what if I have more than one digit?
(i : _) -> if i `elem` ['0' .. '9'] then Just i else Nothing Just (i, _) -> if i `elem` ['0' .. '9'] then Just i else Nothing
_ -> Nothing _ -> Nothing
getAbsMountpoint :: MountConfig -> RofiMountIO FilePath getAbsMountpoint :: MountConfig -> RofiMountIO FilePath
getAbsMountpoint MountConfig {mpPath = m} = getAbsMountpoint MountConfig {mpPath = m} =
asks $ flip appendRoot m . mountconfVolatilePath asks $ flip appendRoot m . mountconfVolatilePath
getStaticActions :: RofiMountIO [(Header, ProtoAction [String])] getStaticActions :: RofiMountIO [(Header, ProtoAction [T.Text])]
getStaticActions = mountableToAction $ asks $ configToTree' . mountconfStaticDevs getStaticActions = mountableToAction $ asks $ configToTree' . mountconfStaticDevs
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Password-getting functions for static devices -- Password-getting functions for static devices
type PasswordGetter = IO (Maybe String) type PasswordGetter = IO (Maybe T.Text)
runSecret :: M.Map String String -> PasswordGetter runSecret :: M.Map T.Text T.Text -> PasswordGetter
runSecret kvs = readCmdSuccess "secret-tool" ("lookup" : kvs') "" runSecret kvs = readCmdSuccess "secret-tool" ("lookup" : kvs') ""
where where
kvs' = concatMap (\(k, v) -> [k, v]) $ M.toList kvs kvs' = concatMap (\(k, v) -> [k, v]) $ M.toList kvs
runBitwarden :: String -> PasswordGetter runBitwarden :: T.Text -> PasswordGetter
runBitwarden pname = runBitwarden pname =
((password . login) <=< L.find (\i -> name i == pname)) ((password . login) <=< L.find (\i -> name i == pname))
<$> getItems <$> getItems
@ -617,7 +615,7 @@ configToPwd (PwdPr p) = flip runPromptLoop readPassword $ promptTries p
withPasswordGetter withPasswordGetter
:: Maybe PasswordConfig :: Maybe PasswordConfig
-> (String -> IO MountResult) -> (T.Text -> IO MountResult)
-> IO MountResult -> IO MountResult
-> IO MountResult -> IO MountResult
withPasswordGetter (Just pwdConfig) runPwd _ = withPasswordGetter (Just pwdConfig) runPwd _ =
@ -633,8 +631,8 @@ withPasswordGetter Nothing _ run = run
-- addresses (eg in /dev) and labels. -- addresses (eg in /dev) and labels.
data Removable = Removable data Removable = Removable
{ removablePath :: String { removablePath :: T.Text
, removableLabel :: String , removableLabel :: T.Text
} }
deriving (Eq, Show) deriving (Eq, Show)
@ -664,42 +662,42 @@ instance Actionable Removable where
-- the device -- the device
getRemovableDevices :: RofiIO c [Removable] getRemovableDevices :: RofiIO c [Removable]
getRemovableDevices = getRemovableDevices =
fromLines toDev . lines fromLines toDev . T.lines . T.pack
<$> io (readProcess "lsblk" ["-n", "-r", "-o", columns] "") <$> io (readProcess "lsblk" ["-n", "-r", "-o", columns] "")
where where
columns = "FSTYPE,HOTPLUG,PATH,LABEL,SIZE" columns = "FSTYPE,HOTPLUG,PATH,LABEL,SIZE"
-- can't use 'words' here since it will drop spaces in the front -- can't use 'words' here since it will drop spaces in the front
toDev line = case splitBy ' ' line of toDev line = case T.split (== ' ') line of
("" : _) -> Nothing ("" : _) -> Nothing
[_, "1", d, "", s] -> mk d $ s ++ " Volume" [_, "1", d, "", s] -> mk d $ T.append s " Volume"
[_, "1", d, l, _] -> mk d l [_, "1", d, l, _] -> mk d l
_ -> Nothing _ -> Nothing
mk d l = Just $ Removable {removablePath = d, removableLabel = l} mk d l = Just $ Removable {removablePath = d, removableLabel = l}
getRemovableActions :: RofiMountIO [(Header, ProtoAction [String])] getRemovableActions :: RofiMountIO [(Header, ProtoAction [T.Text])]
getRemovableActions = mountableToAction getRemovableDevices getRemovableActions = mountableToAction getRemovableDevices
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- MTP devices -- MTP devices
mtpExe :: String mtpExe :: FilePath
mtpExe = "jmtpfs" mtpExe = "jmtpfs"
data MTPFS = MTPFS data MTPFS = MTPFS
{ mtpfsBus :: String { mtpfsBus :: T.Text
, mtpfsDevice :: String , mtpfsDevice :: T.Text
, mtpfsMountpoint :: FilePath , mtpfsMountpoint :: FilePath
, mtpfsDescription :: String , mtpfsDescription :: T.Text
} }
deriving (Eq, Show) deriving (Eq, Show)
instance Mountable MTPFS where instance Mountable MTPFS where
mount MTPFS {mtpfsBus = b, mtpfsDevice = n, mtpfsMountpoint = m} False = do mount MTPFS {mtpfsBus = b, mtpfsDevice = n, mtpfsMountpoint = m} False = do
-- TODO add autodismount to options -- TODO add autodismount to options
let dev = "-device=" ++ b ++ "," ++ n let dev = T.concat ["-device=", b, ",", n]
withTmpMountDir m $ io $ runMount mtpExe [dev, m] "" withTmpMountDir m $ io $ runMount (T.pack mtpExe) [dev, T.pack m] ""
mount MTPFS {mtpfsMountpoint = m} True = mount MTPFS {mtpfsMountpoint = m} True =
runAndRemoveDir m $ io $ runMount "umount" [m] "" runAndRemoveDir m $ io $ runMount "umount" [T.pack m] ""
-- \| return True always since the list won't even show without jmtpfs -- \| return True always since the list won't even show without jmtpfs
allInstalled _ = return True allInstalled _ = return True
@ -719,30 +717,30 @@ getMTPDevices = do
go = do go = do
dir <- asks mountconfVolatilePath dir <- asks mountconfVolatilePath
res <- io $ readProcess mtpExe ["-l"] "" res <- io $ readProcess mtpExe ["-l"] ""
return $ fromLines (toDev dir) $ toDevList res return $ fromLines (toDev dir) $ toDevList $ T.pack res
toDevList = toDevList =
reverse reverse
. takeWhile (not . L.isPrefixOf "Available devices") . L.takeWhile (not . T.isPrefixOf "Available devices")
. reverse . L.reverse
. lines . T.lines
toDev dir s = case splitOn ", " s of toDev dir s = case L.filter (== " ") $ T.split (== ',') s of
[busNum, devNum, _, _, desc, vendor] -> [busNum, devNum, _, _, desc, vendor] ->
let d = unwords [vendor, desc] let d = T.unwords [vendor, desc]
in Just $ in Just $
MTPFS MTPFS
{ mtpfsBus = busNum { mtpfsBus = busNum
, mtpfsDevice = devNum , mtpfsDevice = devNum
, mtpfsMountpoint = dir </> canonicalize d , mtpfsMountpoint = dir </> canonicalize (T.unpack d)
, mtpfsDescription = d , mtpfsDescription = d
} }
_ -> Nothing _ -> Nothing
canonicalize = mapMaybe repl canonicalize = mapMaybe repl
repl c repl c
| c `elem` ("\"*/:<>?\\|" :: String) = Nothing | c `elem` ("\"*/:<>?\\|" :: [Char]) = Nothing
| c == ' ' = Just '-' | c == ' ' = Just '-'
| otherwise = Just c | otherwise = Just c
getMTPActions :: RofiMountIO [(Header, ProtoAction [String])] getMTPActions :: RofiMountIO [(Header, ProtoAction [T.Text])]
getMTPActions = mountableToAction getMTPDevices getMTPActions = mountableToAction getMTPDevices
mtpExeInstalled :: IO Bool mtpExeInstalled :: IO Bool
@ -762,39 +760,40 @@ instance Show NotifyIcon where
show IconError = "dialog-error-symbolic" show IconError = "dialog-error-symbolic"
show IconInfo = "dialog-information-symbolic" show IconInfo = "dialog-information-symbolic"
notifyMountResult :: Bool -> String -> MountResult -> IO () notifyMountResult :: Bool -> T.Text -> MountResult -> IO ()
notifyMountResult mounted label result = case result of notifyMountResult mounted label result = case result of
MountError e -> notify IconError (printf "Failed to %s %s" verb label) $ Just e MountError e -> notify IconError (T.unwords ["Failed", "to", verb, label]) $ Just e
MountSuccess -> notify IconInfo (printf "Successfully %sed %s" verb label) Nothing MountSuccess -> notify IconInfo (T.concat ["Successfully ", verb, "ed ", label]) Nothing
where where
verb = if mounted then "unmount" else "mount" :: String verb = if mounted then "unmount" else "mount" :: T.Text
notify :: NotifyIcon -> String -> Maybe String -> IO () notify :: NotifyIcon -> T.Text -> Maybe T.Text -> IO ()
notify icon summary body = notify icon summary body =
void $ void $
spawnProcess "notify-send" $ spawnProcess "notify-send" $
maybe args (\b -> args ++ [b]) body maybe args (\b -> args ++ [b]) $
fmap T.unpack body
where where
args = ["-i", show icon, summary] args = ["-i", show icon, T.unpack summary]
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Mount commands -- Mount commands
data MountResult = MountSuccess | MountError String deriving (Show, Eq) data MountResult = MountSuccess | MountError T.Text deriving (Show, Eq)
runMount :: String -> [String] -> String -> IO MountResult runMount :: T.Text -> [T.Text] -> T.Text -> IO MountResult
runMount cmd args stdin_ = eitherToMountResult <$> readCmdEither cmd args stdin_ runMount cmd args stdin_ = eitherToMountResult <$> readCmdEither cmd args stdin_
runMount' :: String -> [String] -> String -> [(String, String)] -> IO MountResult runMount' :: T.Text -> [T.Text] -> T.Text -> [(T.Text, T.Text)] -> IO MountResult
runMount' cmd args stdin_ environ = runMount' cmd args stdin_ environ =
eitherToMountResult eitherToMountResult
<$> readCmdEither' cmd args stdin_ environ <$> readCmdEither' cmd args stdin_ environ
runMountSudoMaybe :: Bool -> String -> [String] -> IO MountResult runMountSudoMaybe :: Bool -> T.Text -> [T.Text] -> IO MountResult
runMountSudoMaybe useSudo cmd args = runMountSudoMaybe useSudo cmd args =
runMountSudoMaybe' useSudo cmd args [] runMountSudoMaybe' useSudo cmd args []
runMountSudoMaybe' :: Bool -> String -> [String] -> [(String, String)] -> IO MountResult runMountSudoMaybe' :: Bool -> T.Text -> [T.Text] -> [(T.Text, T.Text)] -> IO MountResult
runMountSudoMaybe' useSudo cmd args environ = runMountSudoMaybe' useSudo cmd args environ =
maybe maybe
(runMount' cmd args "" environ) (runMount' cmd args "" environ)
@ -802,38 +801,38 @@ runMountSudoMaybe' useSudo cmd args environ =
=<< if useSudo then readPassword' "Sudo Password" else return Nothing =<< if useSudo then readPassword' "Sudo Password" else return Nothing
-- TODO untested -- TODO untested
-- runSudoMount :: String -> String -> [String] -> String -> IO MountResult -- runSudoMount :: T.Text -> T.Text -> [T.Text] -> T.Text -> IO MountResult
-- runSudoMount rootpass cmd args stdin = runSudoMount' rootpass cmd args stdin [] -- runSudoMount rootpass cmd args stdin = runSudoMount' rootpass cmd args stdin []
runSudoMount' :: String -> String -> [String] -> [(String, String)] -> IO MountResult runSudoMount' :: T.Text -> T.Text -> [T.Text] -> [(T.Text, T.Text)] -> IO MountResult
runSudoMount' rootpass cmd args environ = runMount "sudo" args' rootpass runSudoMount' rootpass cmd args environ = runMount "sudo" args' rootpass
where where
args' = ["-S"] ++ environ' ++ [cmd] ++ args args' = ["-S"] ++ environ' ++ [cmd] ++ args
environ' = fmap (\(k, v) -> k ++ "=" ++ v) environ environ' = fmap (\(k, v) -> T.concat [k, "=", v]) environ
eitherToMountResult :: Either (Int, String, String) String -> MountResult eitherToMountResult :: Either (Int, T.Text, T.Text) T.Text -> MountResult
eitherToMountResult (Right _) = MountSuccess eitherToMountResult (Right _) = MountSuccess
eitherToMountResult (Left (_, _, e)) = MountError e eitherToMountResult (Left (_, _, e)) = MountError e
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Low-level mount functions -- Low-level mount functions
mountMap :: IO (M.Map FilePath String) mountMap :: IO (M.Map FilePath T.Text)
mountMap = do mountMap = do
parseFile <$> readFileUtf8 "/proc/mounts" parseFile <$> readFileUtf8 "/proc/mounts"
where where
parseFile = M.fromList . mapMaybe (parseLine . T.words) . T.lines parseFile = M.fromList . mapMaybe (parseLine . T.words) . T.lines
-- none of these should fail since this file format will never change -- none of these should fail since this file format will never change
parseLine [spec, mountpoint, _, _, _, _] = Just (T.unpack mountpoint, T.unpack spec) parseLine [spec, mountpoint, _, _, _, _] = Just (T.unpack mountpoint, spec)
parseLine _ = Nothing parseLine _ = Nothing
curDeviceSpecs :: IO [String] curDeviceSpecs :: IO [T.Text]
curDeviceSpecs = M.elems <$> mountMap curDeviceSpecs = M.elems <$> mountMap
curMountpoints :: IO [String] curMountpoints :: IO [FilePath]
curMountpoints = M.keys <$> mountMap curMountpoints = M.keys <$> mountMap
lookupSpec :: FilePath -> IO (Maybe String) lookupSpec :: FilePath -> IO (Maybe T.Text)
lookupSpec mountpoint = M.lookup mountpoint <$> mountMap lookupSpec mountpoint = M.lookup mountpoint <$> mountMap
-- ASSUME the base mount path will always be created because -- ASSUME the base mount path will always be created because
@ -859,7 +858,7 @@ withTmpMountDir m =
-- | Run an unmount command and remove the mountpoint if no errors occur -- | Run an unmount command and remove the mountpoint if no errors occur
runAndRemoveDir :: FilePath -> RofiMountIO MountResult -> RofiMountIO MountResult runAndRemoveDir :: FilePath -> RofiMountIO MountResult -> RofiMountIO MountResult
runAndRemoveDir m f = do runAndRemoveDir m f = do
res <- catch f (return . MountError . (displayException :: SomeException -> String)) res <- catch f (return . MountError . (T.pack . displayException :: SomeException -> T.Text))
when (res == MountSuccess) $ rmDirMaybe m when (res == MountSuccess) $ rmDirMaybe m
return res return res
@ -892,17 +891,17 @@ isDirMounted fp = elem fp <$> curMountpoints
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
-- Other functions -- Other functions
fromLines :: (String -> Maybe a) -> [String] -> [a] fromLines :: (T.Text -> Maybe a) -> [T.Text] -> [a]
fromLines f = mapMaybe (f . stripWS) fromLines f = mapMaybe (f . stripWS)
-- TODO this exists somewhere... -- TODO this exists somewhere...
splitBy :: Char -> String -> [String] -- splitBy :: Char -> T.Text -> [T.Text]
splitBy delimiter = foldr f [[]] -- splitBy delimiter = T.foldr f [[]]
where -- where
f _ [] = [] -- f _ [] = []
f c l@(x : xs) -- f c l@(x : xs)
| c == delimiter = [] : l -- | c == delimiter = [] : l
| otherwise = (c : x) : xs -- | otherwise = (c : x) : xs
appendRoot :: FilePath -> FilePath -> FilePath appendRoot :: FilePath -> FilePath -> FilePath
appendRoot root path = if isRelative path then root </> path else path appendRoot root path = if isRelative path then root </> path else path

59
app/rofi-evpn.hs
View File

@ -4,10 +4,9 @@
module Main (main) where module Main (main) where
import Data.List (isPrefixOf)
import Data.List.Split
import Data.Maybe import Data.Maybe
import RIO import RIO
import qualified RIO.Text as T
import Rofi.Command import Rofi.Command
import System.Environment import System.Environment
import System.Process import System.Process
@ -23,7 +22,7 @@ runPrompt args = do
run (VPNStatus connected servers) = do run (VPNStatus connected servers) = do
let d = getDisconnectAction <$> connected let d = getDisconnectAction <$> connected
let cs = fmap (getConnectAction connected) servers let cs = fmap (getConnectAction connected) servers
runRofiIO (RofiVPNConf args) $ runRofiIO (RofiVPNConf $ fmap T.pack args) $
selectAction $ selectAction $
emptyMenu emptyMenu
{ groups = { groups =
@ -33,16 +32,16 @@ runPrompt args = do
, prompt = Just "Select Action" , prompt = Just "Select Action"
} }
newtype RofiVPNConf = RofiVPNConf [String] newtype RofiVPNConf = RofiVPNConf [T.Text]
instance RofiConf RofiVPNConf where instance RofiConf RofiVPNConf where
defArgs (RofiVPNConf as) = as defArgs (RofiVPNConf as) = as
type VPNAction = RofiAction RofiVPNConf type VPNAction = RofiAction RofiVPNConf
type VPNServer = (String, String) type VPNServer = (T.Text, T.Text)
data VPNStatus = VPNStatus (Maybe String) [VPNServer] deriving (Show) data VPNStatus = VPNStatus (Maybe T.Text) [VPNServer] deriving (Show)
getServers :: IO (Maybe VPNStatus) getServers :: IO (Maybe VPNStatus)
getServers = do getServers = do
@ -56,13 +55,13 @@ getStatus = do
connected <- getConnectedServer connected <- getConnectedServer
VPNStatus connected <$> getAvailableServers VPNStatus connected <$> getAvailableServers
getConnectedServer :: IO (Maybe String) getConnectedServer :: IO (Maybe T.Text)
getConnectedServer = (procStatus =<<) <$> readCmdSuccess eVPN ["status"] "" getConnectedServer = (procStatus =<<) <$> readCmdSuccess eVPN ["status"] ""
where where
procStatus = listToMaybe . mapMaybe procLine . lines procStatus = listToMaybe . mapMaybe procLine . T.lines
procLine l = case words l of procLine l = case T.words l of
-- the output is green... -- the output is green...
("\ESC[1;32;49mConnected" : "to" : server) -> Just $ unwords server ("\ESC[1;32;49mConnected" : "to" : server) -> Just $ T.unwords server
_ -> Nothing _ -> Nothing
getAvailableServers :: IO [VPNServer] getAvailableServers :: IO [VPNServer]
@ -76,13 +75,13 @@ getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] ""
-- by a blank line, after which there is more stuff I don't care about -- by a blank line, after which there is more stuff I don't care about
procOut (Just ls) = procOut (Just ls) =
return $ return $
mapMaybe (matchLine . splitOn "\t") $ mapMaybe (matchLine . T.split (== '\t')) $
takeWhile (/= "") $ takeWhile (/= "") $
drop 1 drop 1
-- super lame way of matching lines that start with "-----" -- super lame way of matching lines that start with "-----"
$ $
dropWhile (not . isPrefixOf "-----") $ dropWhile (not . T.isPrefixOf "-----") $
lines ls T.lines ls
-- The output of this command is very strange; it is delimited (kinda) by -- 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 -- 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 -- whatever case, splitting by tabs leads to variable length lists, and the
@ -96,11 +95,11 @@ getAvailableServers = procOut =<< readCmdSuccess eVPN ["ls"] ""
daemonIsRunning :: IO Bool daemonIsRunning :: IO Bool
daemonIsRunning = isJust <$> readCmdSuccess "pgrep" [eVPND] "" daemonIsRunning = isJust <$> readCmdSuccess "pgrep" [eVPND] ""
getDisconnectAction :: String -> VPNAction getDisconnectAction :: T.Text -> VPNAction
getDisconnectAction server = getDisconnectAction server =
("Disconnect from " ++ server, io $ void $ disconnect server) (T.append "Disconnect from " server, io $ void $ disconnect server)
getConnectAction :: Maybe String -> VPNServer -> VPNAction getConnectAction :: Maybe T.Text -> VPNServer -> VPNAction
getConnectAction connected server = getConnectAction connected server =
(formatServerLine server, io $ go connected) (formatServerLine server, io $ go connected)
where where
@ -110,15 +109,15 @@ getConnectAction connected server =
go _ = con go _ = con
con = connect server con = connect server
formatServerLine :: VPNServer -> String formatServerLine :: VPNServer -> T.Text
formatServerLine (sid, sname) = pad sid ++ " | " ++ sname formatServerLine (sid, sname) = T.concat [pad sid, " | ", sname]
where where
pad s = s ++ replicate (10 - length s) ' ' pad s = T.append s $ T.replicate (10 - T.length s) " "
eVPN :: String eVPN :: T.Text
eVPN = "expressvpn" eVPN = "expressvpn"
eVPND :: String eVPND :: T.Text
eVPND = "expressvpnd" eVPND = "expressvpnd"
connect :: VPNServer -> IO () connect :: VPNServer -> IO ()
@ -126,19 +125,19 @@ connect (sid, sname) = do
res <- readCmdSuccess' eVPN ["connect", sid] res <- readCmdSuccess' eVPN ["connect", sid]
notifyIf notifyIf
res res
("connected to " ++ sname) (T.append "connected to " sname)
("failed to connect to " ++ sname) (T.append "failed to connect to " sname)
disconnect :: String -> IO Bool disconnect :: T.Text -> IO Bool
disconnect server = do disconnect server = do
res <- readCmdSuccess' eVPN ["disconnect"] res <- readCmdSuccess' eVPN ["disconnect"]
notifyIf notifyIf
res res
("disconnected from " ++ server) (T.append "disconnected from " server)
("failed to disconnect from " ++ server) (T.append "failed to disconnect from " server)
return res return res
readCmdSuccess' :: String -> [String] -> IO Bool readCmdSuccess' :: T.Text -> [T.Text] -> IO Bool
readCmdSuccess' cmd args = isJust <$> readCmdSuccess cmd args "" readCmdSuccess' cmd args = isJust <$> readCmdSuccess cmd args ""
-- TODO not DRY -- TODO not DRY
@ -148,12 +147,12 @@ instance Show NotifyIcon where
show IconError = "dialog-error-symbolic" show IconError = "dialog-error-symbolic"
show IconInfo = "dialog-information-symbolic" show IconInfo = "dialog-information-symbolic"
notifyIf :: Bool -> String -> String -> IO () notifyIf :: Bool -> T.Text -> T.Text -> IO ()
notifyIf True s _ = notify IconInfo s notifyIf True s _ = notify IconInfo s
notifyIf False _ s = notify IconError s notifyIf False _ s = notify IconError s
notify :: NotifyIcon -> String -> IO () notify :: NotifyIcon -> T.Text -> IO ()
notify icon body = void $ spawnProcess "notify-send" $ args ++ [body] notify icon body = void $ spawnProcess "notify-send" $ args ++ [T.unpack body]
where where
args = ["-i", show icon, summary] args = ["-i", show icon, summary]
summary = "ExpressVPN" summary = "ExpressVPN"

14
app/rofi.hs
View File

@ -23,12 +23,12 @@
module Main (main) where module Main (main) where
import Data.Maybe
import Graphics.X11.Types import Graphics.X11.Types
import Graphics.X11.Xlib import Graphics.X11.Xlib
import Graphics.X11.Xlib.Extras import Graphics.X11.Xlib.Extras
import Graphics.X11.Xrandr import Graphics.X11.Xrandr
import RIO hiding (Display) import RIO hiding (Display)
import qualified RIO.Text as T
import System.Environment import System.Environment
import System.Process import System.Process
@ -37,11 +37,11 @@ main = do
r <- getMonitorName r <- getMonitorName
let pre = maybe [] (\n -> ["-m", n]) r let pre = maybe [] (\n -> ["-m", n]) r
args <- getArgs args <- getArgs
callProcess "/usr/bin/rofi" $ pre ++ args callProcess "/usr/bin/rofi" $ (fmap T.unpack pre) ++ args
data Coord = Coord Int Int deriving (Eq, Show) data Coord = Coord Int Int deriving (Eq, Show)
getMonitorName :: IO (Maybe String) getMonitorName :: IO (Maybe T.Text)
getMonitorName = do getMonitorName = do
dpy <- openDisplay "" dpy <- openDisplay ""
root <- rootWindow dpy $ defaultScreen dpy root <- rootWindow dpy $ defaultScreen dpy
@ -62,7 +62,7 @@ getDesktopViewports dpy root =
pairs' acc (x1 : x2 : xs) = pairs' (Coord x1 x2 : acc) xs pairs' acc (x1 : x2 : xs) = pairs' (Coord x1 x2 : acc) xs
pairs' acc _ = acc pairs' acc _ = acc
getOutputs :: Display -> Window -> IO [(Coord, String)] getOutputs :: Display -> Window -> IO [(Coord, T.Text)]
getOutputs dpy root = getOutputs dpy root =
xrrGetScreenResourcesCurrent dpy root xrrGetScreenResourcesCurrent dpy root
>>= maybe (return []) resourcesToCells >>= maybe (return []) resourcesToCells
@ -79,7 +79,7 @@ getOutputs dpy root =
, xrr_oi_crtc = c , xrr_oi_crtc = c
} }
) = do ) = do
fmap (\i -> (toCoord i, n)) <$> xrrGetCrtcInfo dpy r c fmap (\i -> (toCoord i, T.pack n)) <$> xrrGetCrtcInfo dpy r c
infoToCell _ _ = return Nothing infoToCell _ _ = return Nothing
toCoord c = Coord (fromIntegral $ xrr_ci_x c) (fromIntegral $ xrr_ci_y c) toCoord c = Coord (fromIntegral $ xrr_ci_x c) (fromIntegral $ xrr_ci_y c)
@ -90,8 +90,8 @@ infix 9 !!?
| i < 0 = Nothing | i < 0 = Nothing
| otherwise = listToMaybe $ drop i xs | otherwise = listToMaybe $ drop i xs
getAtom32 :: Display -> Window -> String -> IO [Int] getAtom32 :: Display -> Window -> T.Text -> IO [Int]
getAtom32 dpy root str = do getAtom32 dpy root str = do
a <- internAtom dpy str False a <- internAtom dpy (T.unpack str) False
p <- getWindowProperty32 dpy a root p <- getWindowProperty32 dpy a root
return $ maybe [] (fmap fromIntegral) p return $ maybe [] (fmap fromIntegral) p

52
lib/Bitwarden/Internal.hs
View File

@ -12,7 +12,6 @@ where
import DBus import DBus
import DBus.Client import DBus.Client
import Data.Aeson import Data.Aeson
import Data.String
import qualified Data.Text.IO as TI import qualified Data.Text.IO as TI
import Data.UnixTime import Data.UnixTime
import GHC.Generics import GHC.Generics
@ -39,7 +38,7 @@ newtype BWServerConf = BWServerConf
-- TODO add a cache so the browse list will load faster -- TODO add a cache so the browse list will load faster
data CurrentSession = CurrentSession data CurrentSession = CurrentSession
{ timestamp :: UnixTime { timestamp :: UnixTime
, hash :: String , hash :: T.Text
} }
type Session = MVar (Maybe CurrentSession) type Session = MVar (Maybe CurrentSession)
@ -62,7 +61,7 @@ syncSession conf ses = notify =<< fmap join . mapM cmd =<< getSession' conf ses
let j = isJust res let j = isJust res
in notifyStatus j $ if j then "sync succeeded" else "sync failed" in notifyStatus j $ if j then "sync succeeded" else "sync failed"
getSession' :: BWServerConf -> Session -> IO (Maybe String) getSession' :: BWServerConf -> Session -> IO (Maybe T.Text)
getSession' BWServerConf {timeout = t} ses = do getSession' BWServerConf {timeout = t} ses = do
ut <- getUnixTime ut <- getUnixTime
modifyMVar ses $ \s -> case s of modifyMVar ses $ \s -> case s of
@ -78,15 +77,15 @@ getSession' BWServerConf {timeout = t} ses = do
ut <- getUnixTime ut <- getUnixTime
return CurrentSession {timestamp = ut, hash = h} return CurrentSession {timestamp = ut, hash = h}
getSession :: BWServerConf -> Session -> IO String getSession :: BWServerConf -> Session -> IO T.Text
getSession conf ses = fromMaybe "" <$> getSession' conf ses getSession conf ses = fromMaybe "" <$> getSession' conf ses
readSession :: String -> IO (Maybe String) readSession :: T.Text -> IO (Maybe T.Text)
readSession pwd = readCmdSuccess "bw" ["unlock", pwd, "--raw"] "" readSession pwd = readCmdSuccess "bw" ["unlock", pwd, "--raw"] ""
notifyStatus :: Bool -> String -> IO () notifyStatus :: Bool -> T.Text -> IO ()
notifyStatus succeeded msg = notifyStatus succeeded msg =
void $ spawnProcess "notify-send" ["-i", i, msg] void $ spawnProcess "notify-send" ["-i", i, T.unpack msg]
where where
i = i =
if succeeded if succeeded
@ -109,12 +108,12 @@ notifyStatus succeeded msg =
-- - username (if applicable) -> copy to clipboard -- - username (if applicable) -> copy to clipboard
-- - password (if applicable) -> copy to clipboard -- - password (if applicable) -> copy to clipboard
-- - anything else (notes and such) -> copy to clipboard -- - anything else (notes and such) -> copy to clipboard
newtype BWClientConf = BWClientConf [String] newtype BWClientConf = BWClientConf [T.Text]
instance RofiConf BWClientConf where instance RofiConf BWClientConf where
defArgs (BWClientConf a) = a defArgs (BWClientConf a) = a
runClient :: [String] -> IO () runClient :: [T.Text] -> IO ()
runClient a = do runClient a = do
let c = BWClientConf a let c = BWClientConf a
runRofiIO c $ runRofiIO c $
@ -136,9 +135,9 @@ browseLogins = io getItems >>= selectItem
getItems :: IO [Item] getItems :: IO [Item]
getItems = maybe (return []) getItems' =<< callGetSession getItems = maybe (return []) getItems' =<< callGetSession
getItems' :: String -> IO [Item] getItems' :: T.Text -> IO [Item]
getItems' session = do getItems' session = do
items <- io $ readProcess "bw" ["list", "items", "--session", session] "" items <- io $ readProcess "bw" ["list", "items", "--session", T.unpack session] ""
return $ filter notEmpty $ fromMaybe [] $ decode $ fromString items return $ filter notEmpty $ fromMaybe [] $ decode $ fromString items
where where
notEmpty Item {login = Login {username = Nothing, password = Nothing}} = notEmpty Item {login = Login {username = Nothing, password = Nothing}} =
@ -146,7 +145,7 @@ getItems' session = do
notEmpty _ = True notEmpty _ = True
data Item = Item data Item = Item
{ name :: String { name :: T.Text
, login :: Login , login :: Login
} }
deriving (Show) deriving (Show)
@ -159,8 +158,8 @@ instance FromJSON Item where
parseJSON _ = mzero parseJSON _ = mzero
data Login = Login data Login = Login
{ username :: Maybe String { username :: Maybe T.Text
, password :: Maybe String , password :: Maybe T.Text
} }
deriving (Show, Generic) deriving (Show, Generic)
@ -188,7 +187,7 @@ selectCopy l =
, hotkeys = [copyHotkey, backHotkey] , hotkeys = [copyHotkey, backHotkey]
} }
where where
copy = io . setClipboardString copy = io . setClipboardString . T.unpack
copyRepeat s = copy s >> selectCopy l copyRepeat s = copy s >> selectCopy l
copyHotkey = copyHotkey =
Hotkey Hotkey
@ -207,22 +206,27 @@ selectCopy l =
keyActions = loginToRofiActions l (const browseLogins) keyActions = loginToRofiActions l (const browseLogins)
} }
loginToRofiActions :: Login -> (String -> RofiIO c ()) -> RofiActions c loginToRofiActions :: Login -> (T.Text -> RofiIO c ()) -> RofiActions c
loginToRofiActions Login {username = u, password = p} a = loginToRofiActions Login {username = u, password = p} a =
toRofiActions $ catMaybes [user, pwd] toRofiActions $ catMaybes [user, pwd]
where where
copyIfJust f = fmap $ liftM2 (,) f a copyIfJust f = fmap $ liftM2 (,) f a
fmtUsername s = "Username (" ++ s ++ ")" fmtUsername s = T.concat ["Username (", s, ")"]
fmtPassword s = "Password (" ++ take 32 (replicate (length s) '*') ++ ")" fmtPassword s = T.concat ["Password (", T.take 32 (T.replicate (T.length s) "*"), ")"]
user = copyIfJust fmtUsername u user = copyIfJust fmtUsername u
pwd = copyIfJust fmtPassword p pwd = copyIfJust fmtPassword p
getItemPassword' :: BWServerConf -> Session -> String -> IO (Maybe String) getItemPassword' :: BWServerConf -> Session -> T.Text -> IO (Maybe T.Text)
getItemPassword' conf session item = mapM getPwd =<< getSession' conf session getItemPassword' conf session item = mapM getPwd =<< getSession' conf session
where where
getPwd s = readProcess "bw" ["get", "password", item, "--session", s] "" getPwd s =
T.pack
<$> readProcess
"bw"
["get", "password", T.unpack item, "--session", T.unpack s]
""
getItemPassword :: BWServerConf -> Session -> String -> IO String getItemPassword :: BWServerConf -> Session -> T.Text -> IO T.Text
getItemPassword conf session item = getItemPassword conf session item =
fromMaybe "" fromMaybe ""
<$> getItemPassword' conf session item <$> getItemPassword' conf session item
@ -283,13 +287,13 @@ callLockSession = void $ callMember memLockSession
callSyncSession :: IO () callSyncSession :: IO ()
callSyncSession = void $ callMember memSyncSession callSyncSession = void $ callMember memSyncSession
callGetSession :: IO (Maybe String) callGetSession :: IO (Maybe T.Text)
callGetSession = getBodyString <$> callMember memGetSession callGetSession = getBodyString <$> callMember memGetSession
-- TODO maybe will need to add a caller for getItemPassword -- TODO maybe will need to add a caller for getItemPassword
getBodyString :: [Variant] -> Maybe String getBodyString :: [Variant] -> Maybe T.Text
getBodyString [b] = case fromVariant b :: Maybe String of getBodyString [b] = case fromVariant b :: Maybe T.Text of
Just "" -> Nothing Just "" -> Nothing
s -> s s -> s
getBodyString _ = Nothing getBodyString _ = Nothing

110
lib/Rofi/Command.hs
View File

@ -25,60 +25,58 @@ module Rofi.Command
) )
where where
import Control.Monad.IO.Unlift
import Control.Monad.Reader
import Data.Char import Data.Char
import qualified Data.Map.Ordered as M import qualified Data.Map.Ordered as M
import Data.Maybe
import RIO import RIO
import qualified RIO.List as L import qualified RIO.List as L
import qualified RIO.Text as T
import System.Process import System.Process
class RofiConf c where class RofiConf c where
defArgs :: c -> [String] defArgs :: c -> [T.Text]
type RofiAction c = (String, RofiIO c ()) type RofiAction c = (T.Text, RofiIO c ())
type RofiActions c = M.OMap String (RofiIO c ()) type RofiActions c = M.OMap T.Text (RofiIO c ())
data RofiGroup c = RofiGroup data RofiGroup c = RofiGroup
{ actions :: RofiActions c { actions :: RofiActions c
, title :: Maybe String , title :: Maybe T.Text
} }
untitledGroup :: RofiActions c -> RofiGroup c untitledGroup :: RofiActions c -> RofiGroup c
untitledGroup a = RofiGroup {actions = a, title = Nothing} untitledGroup a = RofiGroup {actions = a, title = Nothing}
titledGroup :: String -> RofiActions c -> RofiGroup c titledGroup :: T.Text -> RofiActions c -> RofiGroup c
titledGroup t a = (untitledGroup a) {title = Just t} titledGroup t a = (untitledGroup a) {title = Just t}
data Hotkey c = Hotkey data Hotkey c = Hotkey
{ keyCombo :: String { keyCombo :: !T.Text
, -- only 1-10 are valid , -- only 1-10 are valid
keyIndex :: Int keyIndex :: !Int
, keyDescription :: String , keyDescription :: !T.Text
, keyActions :: RofiActions c , keyActions :: RofiActions c
} }
hotkeyBinding :: Hotkey c -> [String] hotkeyBinding :: Hotkey c -> [T.Text]
hotkeyBinding Hotkey {keyIndex = e, keyCombo = c} = [k, c] hotkeyBinding Hotkey {keyIndex = e, keyCombo = c} = [k, c]
where where
k = "-kb-custom-" ++ show e k = T.append "-kb-custom-" $ T.pack $ show e
hotkeyMsg1 :: Hotkey c -> String hotkeyMsg1 :: Hotkey c -> T.Text
hotkeyMsg1 Hotkey {keyCombo = c, keyDescription = d} = hotkeyMsg1 Hotkey {keyCombo = c, keyDescription = d} =
c ++ ": <i>" ++ d ++ "</i>" T.concat [c, ": <i>", d, "</i>"]
hotkeyMsg :: [Hotkey c] -> [String] hotkeyMsg :: [Hotkey c] -> [T.Text]
hotkeyMsg [] = [] hotkeyMsg [] = []
hotkeyMsg hs = ["-mesg", L.intercalate " | " $ fmap hotkeyMsg1 hs] hotkeyMsg hs = ["-mesg", T.intercalate " | " $ fmap hotkeyMsg1 hs]
hotkeyArgs :: [Hotkey c] -> [String] hotkeyArgs :: [Hotkey c] -> [T.Text]
hotkeyArgs hks = hotkeyMsg hks ++ concatMap hotkeyBinding hks hotkeyArgs hks = hotkeyMsg hks ++ concatMap hotkeyBinding hks
data RofiMenu c = RofiMenu data RofiMenu c = RofiMenu
{ groups :: [RofiGroup c] { groups :: [RofiGroup c]
, prompt :: Maybe String , prompt :: Maybe T.Text
, hotkeys :: [Hotkey c] , hotkeys :: [Hotkey c]
} }
@ -99,27 +97,27 @@ io = liftIO
runRofiIO :: c -> RofiIO c a -> IO a runRofiIO :: c -> RofiIO c a -> IO a
runRofiIO c (RofiIO r) = runReaderT r c runRofiIO c (RofiIO r) = runReaderT r c
toRofiActions :: [(String, RofiIO c ())] -> RofiActions c toRofiActions :: [(T.Text, RofiIO c ())] -> RofiActions c
toRofiActions = M.fromList toRofiActions = M.fromList
rofiActionKeys :: RofiActions c -> String rofiActionKeys :: RofiActions c -> T.Text
rofiActionKeys = joinNewline . map fst . M.assocs rofiActionKeys = joinNewline . map fst . M.assocs
lookupRofiAction :: String -> RofiActions c -> RofiIO c () lookupRofiAction :: T.Text -> RofiActions c -> RofiIO c ()
lookupRofiAction key ras = fromMaybe (return ()) $ M.lookup key ras lookupRofiAction key ras = fromMaybe (return ()) $ M.lookup key ras
groupEntries :: RofiGroup c -> String groupEntries :: RofiGroup c -> T.Text
groupEntries RofiGroup {actions = a, title = t} groupEntries RofiGroup {actions = a, title = t}
| null a = "" | null a = ""
| otherwise = title' ++ rofiActionKeys a | otherwise = T.append title' $ rofiActionKeys a
where where
title' = maybe "" (++ "\n") t title' = maybe "" (`T.append` "\n") t
menuActions :: RofiMenu c -> RofiActions c menuActions :: RofiMenu c -> RofiActions c
menuActions = L.foldr (M.<>|) M.empty . fmap actions . groups menuActions = L.foldr (M.<>|) M.empty . fmap actions . groups
menuEntries :: RofiMenu c -> String menuEntries :: RofiMenu c -> T.Text
menuEntries = L.intercalate "\n\n" . filter (not . null) . fmap groupEntries . groups menuEntries = T.intercalate "\n\n" . filter (not . T.null) . fmap groupEntries . groups
selectAction :: RofiConf c => RofiMenu c -> RofiIO c () selectAction :: RofiConf c => RofiMenu c -> RofiIO c ()
selectAction rm = do selectAction rm = do
@ -133,63 +131,67 @@ selectAction rm = do
L.find ((==) n . (+ 9) . keyIndex) $ L.find ((==) n . (+ 9) . keyIndex) $
hotkeys rm hotkeys rm
maybeOption :: String -> Maybe String -> [String] maybeOption :: T.Text -> Maybe T.Text -> [T.Text]
maybeOption switch = maybe [] (\o -> [switch, o]) maybeOption switch = maybe [] (\o -> [switch, o])
dmenuArgs :: [String] dmenuArgs :: [T.Text]
dmenuArgs = ["-dmenu"] dmenuArgs = ["-dmenu"]
readRofi readRofi
:: RofiConf c :: RofiConf c
=> [String] => [T.Text]
-> String -> T.Text
-> RofiIO c (Either (Int, String, String) String) -> RofiIO c (Either (Int, T.Text, T.Text) T.Text)
readRofi uargs input = do readRofi uargs input = do
dargs <- asks defArgs dargs <- asks defArgs
io $ readCmdEither "rofi" (dmenuArgs ++ dargs ++ uargs) input io $ readCmdEither "rofi" (dmenuArgs ++ dargs ++ uargs) input
readCmdSuccess :: String -> [String] -> String -> IO (Maybe String) readCmdSuccess :: T.Text -> [T.Text] -> T.Text -> IO (Maybe T.Text)
readCmdSuccess cmd args input = readCmdSuccess cmd args input =
either (const Nothing) Just either (const Nothing) Just
<$> readCmdEither cmd args input <$> readCmdEither cmd args input
readCmdEither readCmdEither
:: String :: T.Text
-> [String] -> [T.Text]
-> String -> T.Text
-> IO (Either (Int, String, String) String) -> IO (Either (Int, T.Text, T.Text) T.Text)
readCmdEither cmd args input = readCmdEither cmd args input =
resultToEither resultToEither
<$> readProcessWithExitCode cmd args input <$> readProcessWithExitCode (T.unpack cmd) (fmap T.unpack args) (T.unpack input)
readCmdEither' readCmdEither'
:: String :: T.Text
-> [String] -> [T.Text]
-> String -> T.Text
-> [(String, String)] -> [(T.Text, T.Text)]
-> IO (Either (Int, String, String) String) -> IO (Either (Int, T.Text, T.Text) T.Text)
readCmdEither' cmd args input environ = readCmdEither' cmd args input environ =
resultToEither resultToEither
<$> readCreateProcessWithExitCode p input <$> readCreateProcessWithExitCode p (T.unpack input)
where where
p = (proc cmd args) {env = Just environ} p =
(proc (T.unpack cmd) (fmap T.unpack args))
{ env = Just $ fmap (bimap T.unpack T.unpack) environ
}
resultToEither resultToEither
:: (ExitCode, String, String) :: (ExitCode, String, String)
-> Either (Int, String, String) String -> Either (Int, T.Text, T.Text) T.Text
resultToEither (ExitSuccess, out, _) = Right $ stripWS out resultToEither (ExitSuccess, out, _) = Right $ stripWS $ T.pack out
resultToEither (ExitFailure n, out, err) = Left (n, stripWS out, stripWS err) resultToEither (ExitFailure n, out, err) =
Left (n, stripWS $ T.pack out, stripWS $ T.pack err)
stripWS :: String -> String stripWS :: T.Text -> T.Text
stripWS = reverse . dropWhile isSpace . reverse stripWS = T.reverse . T.dropWhile isSpace . T.reverse
joinNewline :: [String] -> String joinNewline :: [T.Text] -> T.Text
joinNewline = L.intercalate "\n" joinNewline = T.intercalate "\n"
readPassword :: IO (Maybe String) readPassword :: IO (Maybe T.Text)
readPassword = readPassword' "Password" readPassword = readPassword' "Password"
readPassword' :: String -> IO (Maybe String) readPassword' :: T.Text -> IO (Maybe T.Text)
readPassword' p = readCmdSuccess "rofi" args "" readPassword' p = readCmdSuccess "rofi" args ""
where where
args = dmenuArgs ++ ["-p", p, "-password"] args = dmenuArgs ++ ["-p", p, "-password"]