{-# LANGUAGE LambdaCase #-}
module XMonad.Prompt.Pass
(
passPrompt
, passPrompt'
, passTypePrompt
, passEditPrompt
, passEditPrompt'
, passRemovePrompt
, passRemovePrompt'
, passGeneratePrompt
, passGeneratePrompt'
, passGenerateAndCopyPrompt
, passGenerateAndCopyPrompt'
, passOTPPrompt
, passOTPTypePrompt
) where
import System.Directory (getHomeDirectory)
import System.FilePath (dropExtension, (</>))
import System.Posix.Env (getEnv)
import XMonad
import XMonad.Prelude
import XMonad.Prompt
( XPConfig,
XPrompt,
commandToComplete,
getNextCompletion,
mkXPrompt,
nextCompletion,
searchPredicate,
showXPrompt,
)
import XMonad.Util.Run (runProcessWithInput)
type PromptLabel = String
newtype Pass = Pass PromptLabel
instance XPrompt Pass where
showXPrompt :: Pass -> String
showXPrompt (Pass String
prompt) = String
prompt forall a. [a] -> [a] -> [a]
++ String
": "
commandToComplete :: Pass -> String -> String
commandToComplete Pass
_ String
c = String
c
nextCompletion :: Pass -> String -> [String] -> String
nextCompletion Pass
_ = String -> [String] -> String
getNextCompletion
passPrompt :: XPConfig -> X ()
passPrompt :: XPConfig -> X ()
passPrompt = String -> XPConfig -> X ()
passPrompt' String
"Select password"
passPrompt' :: String -> XPConfig -> X ()
passPrompt' :: String -> XPConfig -> X ()
passPrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
selectPassword
passOTPPrompt :: XPConfig -> X ()
passOTPPrompt :: XPConfig -> X ()
passOTPPrompt = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
"Select OTP" String -> X ()
selectOTP
passOTPTypePrompt :: XPConfig -> X ()
passOTPTypePrompt :: XPConfig -> X ()
passOTPTypePrompt = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
"Select OTP" String -> X ()
selectOTPType
passGeneratePrompt :: XPConfig -> X ()
passGeneratePrompt :: XPConfig -> X ()
passGeneratePrompt = String -> XPConfig -> X ()
passGeneratePrompt' String
"Generate password"
passGeneratePrompt' :: String -> XPConfig -> X ()
passGeneratePrompt' :: String -> XPConfig -> X ()
passGeneratePrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
generatePassword
passGenerateAndCopyPrompt :: XPConfig -> X ()
passGenerateAndCopyPrompt :: XPConfig -> X ()
passGenerateAndCopyPrompt = String -> XPConfig -> X ()
passGenerateAndCopyPrompt' String
"Generate and copy password"
passGenerateAndCopyPrompt' :: String -> XPConfig -> X ()
passGenerateAndCopyPrompt' :: String -> XPConfig -> X ()
passGenerateAndCopyPrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
generateAndCopyPassword
passRemovePrompt :: XPConfig -> X ()
passRemovePrompt :: XPConfig -> X ()
passRemovePrompt = String -> XPConfig -> X ()
passRemovePrompt' String
"Remove password"
passRemovePrompt' :: String -> XPConfig -> X ()
passRemovePrompt' :: String -> XPConfig -> X ()
passRemovePrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
removePassword
passTypePrompt :: XPConfig -> X ()
passTypePrompt :: XPConfig -> X ()
passTypePrompt = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
"Type password" String -> X ()
typePassword
passEditPrompt :: XPConfig -> X ()
passEditPrompt :: XPConfig -> X ()
passEditPrompt = String -> XPConfig -> X ()
passEditPrompt' String
"Edit password"
passEditPrompt' :: String -> XPConfig -> X ()
passEditPrompt' :: String -> XPConfig -> X ()
passEditPrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
editPassword
mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt :: String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
promptLabel String -> X ()
passwordFunction XPConfig
xpconfig = do
[String]
passwords <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (IO String
passwordStoreFolder forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ComplFunction
getPasswords)
forall p.
XPrompt p =>
p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
mkXPrompt (String -> Pass
Pass String
promptLabel)
XPConfig
xpconfig
([String] -> (String -> String -> Bool) -> ComplFunction
getPassCompl [String]
passwords forall a b. (a -> b) -> a -> b
$ XPConfig -> String -> String -> Bool
searchPredicate XPConfig
xpconfig)
String -> X ()
passwordFunction
where
getPassCompl :: [String] -> (String -> String -> Bool) -> String -> IO [String]
getPassCompl :: [String] -> (String -> String -> Bool) -> ComplFunction
getPassCompl [String]
compls String -> String -> Bool
p String
s = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
p String
s) [String]
compls
passwordStoreFolder :: IO String
passwordStoreFolder :: IO String
passwordStoreFolder =
String -> IO (Maybe String)
getEnv String
"PASSWORD_STORE_DIR" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Maybe String -> IO String
computePasswordStoreDir
where
computePasswordStoreDir :: Maybe String -> IO String
computePasswordStoreDir :: Maybe String -> IO String
computePasswordStoreDir = \case
Maybe String
Nothing -> IO String
getHomeDirectory forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> String -> String
</> String
".password-store")
Just String
storeDir -> forall (m :: * -> *) a. Monad m => a -> m a
return String
storeDir
getPasswords :: FilePath -> IO [String]
getPasswords :: ComplFunction
getPasswords String
passwordStoreDir = do
String
files <- forall (m :: * -> *).
MonadIO m =>
String -> [String] -> String -> m String
runProcessWithInput String
"find" [
String
"-L",
String
passwordStoreDir,
String
"-type", String
"f",
String
"-name", String
"*.gpg",
String
"-printf", String
"%P\n"] []
forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map String -> String
dropExtension forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
files
selectPassword :: String -> X ()
selectPassword :: String -> X ()
selectPassword = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
pass String
"--clip"
selectOTP :: String -> X ()
selectOTP :: String -> X ()
selectOTP = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
pass String
"otp --clip"
selectOTPType :: String -> X ()
selectOTPType :: String -> X ()
selectOTPType = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
typeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
pass String
"otp"
generatePassword :: String -> X ()
generatePassword :: String -> X ()
generatePassword String
passLabel = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall a b. (a -> b) -> a -> b
$ String -> String -> String
pass String
"generate --force" String
passLabel forall a. [a] -> [a] -> [a]
++ String
" 30"
generateAndCopyPassword :: String -> X ()
generateAndCopyPassword :: String -> X ()
generateAndCopyPassword String
passLabel = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall a b. (a -> b) -> a -> b
$ String -> String -> String
pass String
"generate --force -c" String
passLabel forall a. [a] -> [a] -> [a]
++ String
" 30"
removePassword :: String -> X ()
removePassword :: String -> X ()
removePassword = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
pass String
"rm --force"
editPassword :: String -> X ()
editPassword :: String -> X ()
editPassword = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
pass String
"edit"
typePassword :: String -> X ()
typePassword :: String -> X ()
typePassword = forall (m :: * -> *). MonadIO m => String -> m ()
spawn forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
typeString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> String
pass String
""
typeString :: String -> String
typeString :: String -> String
typeString String
cmd = String
cmd forall a. [a] -> [a] -> [a]
++ String
" | head -n1 | tr -d '\n' | xdotool type --clearmodifiers --file -"
pass :: String -> String -> String
pass :: String -> String -> String
pass String
cmd String
label = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String
"pass ", String
cmd, String
" \"", forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Char -> String
escape String
label, String
"\""]
where
escape :: Char -> String
escape :: Char -> String
escape Char
'"' = String
"\\\""
escape Char
'\\' = String
"\\\\"
escape Char
x = [Char
x]