path: root/lib/Pass.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Pass
-- Copyright   :  (c) 2014 Igor Babuschkin, Antoine R. Dumont, Alexander Sulfrian
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Antoine R. Dumont <eniotna.t@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- This module provides 3 <XMonad.Prompt> to ease passwords manipulation (generate, read):
--
-- - one to lookup passwords in the password-storage (located on user's home @$HOME\/.password-store@).
--
-- - one to generate a password for a given password label that the user inputs.
--
-- - one to delete a stored password for a given password label that the user inputs.
--
-- All those prompts benefit from the completion system provided by the module <XMonad.Prompt>.
--
--
-- Source:
--
-- - The password storage implementation is <http://git.zx2c4.com/password-store the password-store cli>.
--
-- - Inspired from <http://babushk.in/posts/combining-xmonad-and-pass.html>
--
-----------------------------------------------------------------------------

module Pass ( -- * Usages
              -- $usages
              passPrompt
            , passGeneratePrompt
            ) where

import XMonad (X, io, xfork)
import XMonad.Prompt ( XPrompt
                     , showXPrompt
                     , commandToComplete
                     , nextCompletion
                     , getNextCompletion
                     , XPConfig
                     , mkXPrompt
                     , mkComplFunFromList)
import XMonad.Util.Run (safeSpawn, runProcessWithInput)
import System.Directory (getHomeDirectory)
import Data.List (isSuffixOf)

-- $usages
-- You can use this module with the following in your @~\/.xmonad\/xmonad.hs@:
--
-- > import XMonad.Prompt.Pass
--
-- Then add a keybinding for 'passPrompt' or 'passGeneratePrompt':
--
-- >   , ((modMask x , xK_p)                              , passPrompt xpconfig)
-- >   , ((modMask x .|. controlMask, xK_p)               , passGeneratePrompt xpconfig)
--
-- For detailed instructions on:
--
-- - editing your key bindings, see "XMonad.Doc.Extending#Editing_key_bindings".
--
-- - how to setup the password storage, see <http://git.zx2c4.com/password-store/about/>
--

type PromptLabel = String

data Pass = Pass PromptLabel

instance XPrompt Pass where
  showXPrompt       (Pass prompt) = prompt ++ ": "
  commandToComplete _ c           = c
  nextCompletion      _           = getNextCompletion

-- | A pass prompt factory.
--
mkPassPrompt :: PromptLabel -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt promptLabel passwordFunction xpconfig =
  io getPasswords >>=
  \ passwords -> mkXPrompt (Pass promptLabel) xpconfig (mkComplFunFromList passwords) passwordFunction

-- | A prompt to retrieve a password from a given entry.
--
passPrompt :: XPConfig -> X ()
passPrompt = mkPassPrompt "Select password" selectPassword

-- | A prompt to generate a password for a given entry.
-- This can be used to override an already stored entry.
-- (Beware that no confirmation is asked)
--
passGeneratePrompt :: XPConfig -> X ()
passGeneratePrompt = mkPassPrompt "Generate password" generatePassword

-- | Select a password.
--
selectPassword :: String -> X ()
selectPassword passLabel = io $ do
  xfork $ typePassword passLabel
  return ()

typePassword :: String -> IO ()
typePassword passLabel = do
  pass <- runProcessWithInput "pass" ["show", passLabel] []
  runProcessWithInput "xdotool" ["-"] $ getTypeCommand pass
  runProcessWithInput "dzen2"
    ["-p", "1", "-fn", ":Bold",
     "-w", "280", "-h", "50",
     "-y", "900", "-x", "700",
     "-bg", "darkred", "-fg", "white"]
    "Done\n"
  return ()

getTypeCommand :: String -> String
getTypeCommand content = "type --clearmodifiers '" ++ getPass content ++ "'"
  where
    getPass = escapeString . head . lines
    escapeString = concat . map escapeChar
    escapeChar c
      | (c == '\'') = "'\n\"'\"\n'"
      | otherwise = [c]

-- | Generate a 30 characters password for a given entry.
-- If the entry already exists, it is updated with a new password.
--
generatePassword :: String -> X ()
generatePassword passLabel = safeSpawn "pass" ["generate", "--force", passLabel, "30"]

-- | Retrieve the list of passwords from the default password storage in $HOME/.password-store
--
getPasswords :: IO [String]
getPasswords = do
  home <- getHomeDirectory
  files <- runProcessWithInput "find" [
    home ++ "/.password-store",
    "-type", "f",
    "-name", "*.gpg",
    "-printf", "%P\n"] []
  return $ map removeGpgExtension $ lines files

removeGpgExtension :: String -> String
removeGpgExtension file =
  if isSuffixOf ".gpg" file then
    reverse $ drop 4 $ reverse file
  else
    file