xmonad-config/lib/Password.hs
EEva (JPotier) 1d3c55f3e9 Fix pass
2021-05-06 17:23:07 +03:00

68 lines
2.5 KiB
Haskell

-- Initially from
-- https://github.com/MasseR/xmonad-masser/blob/master/src/XMonad/Password.hs
module Password (passGeneratePrompt, passPrompt) where
import Control.Monad.Trans (liftIO)
import Data.Function (on)
import Data.List (foldl', scanl', sort, sortBy)
import System.Directory (getHomeDirectory)
import System.FilePath.Posix (dropExtension, takeExtension, (</>))
import System.Posix.Env (getEnv)
import XMonad.Core
import XMonad.Prompt
import XMonad.Util.Run (runProcessWithInput)
newtype Pass = Pass { passLabel :: String }
-- Rosetta code levenshtein
levenshtein :: String -> String -> Int
levenshtein s1 s2 = last $ foldl' transform [0..length s1] s2
where
transform [] _ = []
transform ns@(n:ns1) c = scanl' calc (n+1) $ zip3 s1 ns ns1
where
calc z (c1, x, y) = minimum [y+1, z+1, x + (fromEnum (c1 /= c) * 2)]
instance XPrompt Pass where
showXPrompt p = passLabel p <> ": "
commandToComplete _ = id
nextCompletion _ = getNextCompletion
passGeneratePrompt :: XPConfig -> X ()
passGeneratePrompt _ = return () -- Not implemented
passPrompt :: XPConfig -> X ()
passPrompt = mkPassPrompt "Select password" selectPassword
mkPassPrompt :: String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt label f conf = do
-- I'm just sorting here, but could use some kind of fuzzy matching instead,
-- but it requires a bit more effort
passwords <- sort <$> liftIO getPasswords
mkXPrompt (Pass label) conf (passComplFun passwords) f
where
getPasswords = do
passwordStoreDir <- (</> "pass") <$> getHomeDirectory
files <- runProcessWithInput "find"
[ passwordStoreDir, "-type", "f", "-name", "*.gpg", "-printf"
, "%p\n"] []
return . lines $ files
-- | Find all entries (`allPasses`) matching `input`
passComplFun :: [String] -> String -> IO [String]
passComplFun allPasses input = pure $
sortBy (compare `on` levenshtein input)
. take 5
. filter (consumes input)
$ allPasses
where
consumes [] _ = True -- everything consumed
consumes (_:_) [] = False -- all not consumed
consumes (a:xs) (a':ys) | a == a' = consumes xs ys
| otherwise = consumes (a:xs) ys
selectPassword :: String -> X ()
selectPassword pass = spawn $ "gpg --decrypt " ++ pass ++ " | copy"
-- “copy” comes with the xmonad module in the nix configuration