{-# LANGUAGE LambdaCase #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Prompt.Pass
-- Description :  A prompt for interacting with @pass(1)@.
-- Copyright   :  (c) 2014 Igor Babuschkin, Antoine R. Dumont
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Antoine R. Dumont <eniotna.t@gmail.com>
-- Stability   :  unstable
-- Portability :  unportable
--
-- A thin wrapper around the standard @pass(1)@ UNIX utility.
--
-- This module provides several prompts to ease password manipulation
-- (generate, read, edit, remove); all of them benefit from the
-- completion system provided by "XMonad.Prompt".  Specifically, we
-- provide
--
-- - various functions to lookup passwords in the password-store:
--
--     + 'passPrompt' copies the password directly to the clipboard.
--
--     + 'passOTPPrompt' copies a one-time-password to the clipboard
--        (this uses <https://github.com/tadfisher/pass-otp pass-otp>).
--
--     + 'passTypePrompt' and 'passOTPTypePrompt' work like the above,
--       respectively, but use @xdotool@ to type out the password.
--
-- - 'passGeneratePrompt' generates a password for a given password
--   label that the user inputs.
--
-- - 'passEditPrompt' edits a password for a given password label that
--   the user inputs.
--
-- - 'passRemovePrompt' deletes a stored password for a given password
--   label that the user inputs.
--
-- The password store is setup through an environment variable
-- @$PASSWORD_STORE_DIR@, or @$HOME\/.password-store@ if it is unset.
-- The editor is determined from the environment variable @$EDITOR@.
--
-- Source:
--
-- - The <https://www.passwordstore.org/ password store>
--   implementation is <http://git.zx2c4.com/password-store here>.
--
-- - Inspired by <http://babushk.in/posts/combining-xmonad-and-pass.html>
--
-----------------------------------------------------------------------------

module XMonad.Prompt.Pass
    ( -- * Usage
      -- $usage

      -- * Retrieving passwords
      passPrompt
    , passPrompt'
    , passTypePrompt

      -- * Editing passwords
    , passEditPrompt
    , passEditPrompt'
    , passRemovePrompt
    , passRemovePrompt'
    , passGeneratePrompt
    , passGeneratePrompt'
    , passGenerateAndCopyPrompt
    , passGenerateAndCopyPrompt'

      -- * One-time-passwords
    , 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)

-- $usage
-- You can use this module with the following in your @xmonad.hs@:
--
-- > import XMonad.Prompt.Pass
--
-- Then add a keybinding for 'passPrompt', 'passGeneratePrompt',
-- 'passRemovePrompt', 'passEditPrompt' or 'passTypePrompt':
--
-- >   , ((modMask , xK_p)                              , passPrompt def)
-- >   , ((modMask .|. controlMask, xK_p)               , passGeneratePrompt def)
-- >   , ((modMask .|. shiftMask, xK_p)                 , passEditPrompt def)
-- >   , ((modMask .|. controlMask  .|. shiftMask, xK_p), passRemovePrompt def)
--
-- You can also use the versions that let you specify a custom prompt:
--
-- >   , ((modMask , xK_p)                              , passPrompt' "Ask 'pass' for" def)
--
-- Note that, by default, we do not use fuzzy matching in this module.
-- To enable this feature, import the "XMonad.Prompt.FuzzyMatch" module
-- and add the relevant functions to your prompt configuration:
--
-- > myXPConfig :: XPConfig
-- > myXPConfig = def
-- >   { searchPredicate = fuzzyMatch
-- >   , sorter          = fuzzySort
-- >   }
-- >
-- > , ((modMask , xK_p), passPrompt myXPConfig)
--
-- For detailed instructions on:
--
-- - editing your key bindings, see <https://xmonad.org/TUTORIAL.html#customizing-xmonad the tutorial>.
--
-- - how to setup the password store, see <http://git.zx2c4.com/password-store/about/>
--   or @man 1 pass@.
--

---------------------------------------------------------------------------------
-- Prompt

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

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

-- | The same as 'passPrompt' but with a user-specified prompt.
passPrompt' :: String -> XPConfig -> X ()
passPrompt' :: String -> XPConfig -> X ()
passPrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
selectPassword

-- | A prompt to retrieve a OTP from a given entry.  Note that you will
-- need to use the <https://github.com/tadfisher/pass-otp pass-otp>
-- extension for this to work.
--
passOTPPrompt :: XPConfig -> X ()
passOTPPrompt :: XPConfig -> X ()
passOTPPrompt = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
"Select OTP" String -> X ()
selectOTP

-- | A prompt to retrieve a OTP from a given entry.  Note that you will
-- need to use the <https://github.com/tadfisher/pass-otp pass-otp>
-- extension for this to work.
--
passOTPTypePrompt :: XPConfig -> X ()
passOTPTypePrompt :: XPConfig -> X ()
passOTPTypePrompt = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
"Select OTP" String -> X ()
selectOTPType

-- | 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 :: XPConfig -> X ()
passGeneratePrompt = String -> XPConfig -> X ()
passGeneratePrompt' String
"Generate password"

-- | The same as 'passGeneratePrompt' but with a user-specified prompt.
passGeneratePrompt' :: String -> XPConfig -> X ()
passGeneratePrompt' :: String -> XPConfig -> X ()
passGeneratePrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
generatePassword

-- | A prompt to generate a password for a given entry and immediately copy it
-- to the clipboard.  This can be used to override an already stored entry.
-- (Beware that no confirmation is asked)
--
passGenerateAndCopyPrompt :: XPConfig -> X ()
passGenerateAndCopyPrompt :: XPConfig -> X ()
passGenerateAndCopyPrompt = String -> XPConfig -> X ()
passGenerateAndCopyPrompt' String
"Generate and copy password"

-- | The same as 'passGenerateAndCopyPrompt' but with a user-specified prompt.
passGenerateAndCopyPrompt' :: String -> XPConfig -> X ()
passGenerateAndCopyPrompt' :: String -> XPConfig -> X ()
passGenerateAndCopyPrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
generateAndCopyPassword

-- | A prompt to remove a password for a given entry.
-- (Beware that no confirmation is asked)
--
passRemovePrompt :: XPConfig -> X ()
passRemovePrompt :: XPConfig -> X ()
passRemovePrompt = String -> XPConfig -> X ()
passRemovePrompt' String
"Remove password"

-- | The same as 'passRemovePrompt' but with a user-specified prompt.
passRemovePrompt' :: String -> XPConfig -> X ()
passRemovePrompt' :: String -> XPConfig -> X ()
passRemovePrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
removePassword

-- | A prompt to type in a password for a given entry.
-- This doesn't touch the clipboard.
--
passTypePrompt :: XPConfig -> X ()
passTypePrompt :: XPConfig -> X ()
passTypePrompt = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
"Type password" String -> X ()
typePassword

-- | A prompt to edit a given entry.
-- This doesn't touch the clipboard.
--
passEditPrompt :: XPConfig -> X ()
passEditPrompt :: XPConfig -> X ()
passEditPrompt = String -> XPConfig -> X ()
passEditPrompt' String
"Edit password"

-- | The same as 'passEditPrompt' but with a user-specified prompt.
passEditPrompt' :: String -> XPConfig -> X ()
passEditPrompt' :: String -> XPConfig -> X ()
passEditPrompt' String
s = String -> (String -> X ()) -> XPConfig -> X ()
mkPassPrompt String
s String -> X ()
editPassword

-- | A pass prompt factory.
--
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

  -- Compute the password store's location. Use the @$PASSWORD_STORE_DIR@
  -- environment variable to set the password store. If empty, return the
  -- password store located in user's home.
  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
    -- Default password store folder in @$HOME/.password-store@.
    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

  -- Retrieve the list of passwords from the password store @passwordStoreDir@.
  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", -- Traverse symlinks
      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

---------------------------------------------------------------------------------
-- Selecting a password

-- | Select a password.
--
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"

-- | Select a one-time-password and copy it to the clipboard.
--
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"

-- | Select a one-time-password and type it out.
--
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"

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

-- | Generate a 30 characters password for a given entry.
-- If the entry already exists, it is updated with a new password.
-- After generating the password, it is copied to the clipboard.
--
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"

-- | Remove a password stored for a given entry.
--
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"

-- | Edit a password stored for a given entry.
--
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"

-- | Type a password stored for a given entry using xdotool.
--
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
""

-- | Type the given string with @xdotool@.
--
-- >>> typeString (pass "" "arXiv")
-- "pass  \"arXiv\" | head -n1 | tr -d '\n' | xdotool type --clearmodifiers --file -"
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 -"

-- | Generate a pass prompt.
--
-- >>> pass "otp" "\\n'git'\"hub\""
-- "pass otp \"\\\\n'git'\\\"hub\\\"\""
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]