xmonad-config/lib/Password.hs

-- 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